From 4558bad2ac815cfa9def179a225ad1b5723d1184 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Fri, 26 Sep 2014 21:27:38 -0700 Subject: [PATCH 001/246] Initial commit --- csp/LICENSE | 505 ++++++++++++++++++++++++++++++++++++++++++++++++++ csp/README.md | 2 + 2 files changed, 507 insertions(+) create mode 100644 csp/LICENSE create mode 100644 csp/README.md diff --git a/csp/LICENSE b/csp/LICENSE new file mode 100644 index 00000000..40c8ae62 --- /dev/null +++ b/csp/LICENSE @@ -0,0 +1,505 @@ +GNU LESSER GENERAL PUBLIC LICENSE + Version 2.1, February 1999 + + Copyright (C) 1991, 1999 Free Software Foundation, Inc. + 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA + Everyone is permitted to copy and distribute verbatim copies + of this license document, but changing it is not allowed. + +(This is the first released version of the Lesser GPL. It also counts + as the successor of the GNU Library Public License, version 2, hence + the version number 2.1.) + + Preamble + + The licenses for most software are designed to take away your +freedom to share and change it. By contrast, the GNU General Public +Licenses are intended to guarantee your freedom to share and change +free software--to make sure the software is free for all its users. + + This license, the Lesser General Public License, applies to some +specially designated software packages--typically libraries--of the +Free Software Foundation and other authors who decide to use it. You +can use it too, but we suggest you first think carefully about whether +this license or the ordinary General Public License is the better +strategy to use in any particular case, based on the explanations below. + + When we speak of free software, we are referring to freedom of use, +not price. Our General Public Licenses are designed to make sure that +you have the freedom to distribute copies of free software (and charge +for this service if you wish); that you receive source code or can get +it if you want it; that you can change the software and use pieces of +it in new free programs; and that you are informed that you can do +these things. + + To protect your rights, we need to make restrictions that forbid +distributors to deny you these rights or to ask you to surrender these +rights. These restrictions translate to certain responsibilities for +you if you distribute copies of the library or if you modify it. + + For example, if you distribute copies of the library, whether gratis +or for a fee, you must give the recipients all the rights that we gave +you. You must make sure that they, too, receive or can get the source +code. If you link other code with the library, you must provide +complete object files to the recipients, so that they can relink them +with the library after making changes to the library and recompiling +it. And you must show them these terms so they know their rights. + + We protect your rights with a two-step method: (1) we copyright the +library, and (2) we offer you this license, which gives you legal +permission to copy, distribute and/or modify the library. + + To protect each distributor, we want to make it very clear that +there is no warranty for the free library. Also, if the library is +modified by someone else and passed on, the recipients should know +that what they have is not the original version, so that the original +author's reputation will not be affected by problems that might be +introduced by others. + + Finally, software patents pose a constant threat to the existence of +any free program. We wish to make sure that a company cannot +effectively restrict the users of a free program by obtaining a +restrictive license from a patent holder. Therefore, we insist that +any patent license obtained for a version of the library must be +consistent with the full freedom of use specified in this license. + + Most GNU software, including some libraries, is covered by the +ordinary GNU General Public License. This license, the GNU Lesser +General Public License, applies to certain designated libraries, and +is quite different from the ordinary General Public License. We use +this license for certain libraries in order to permit linking those +libraries into non-free programs. + + When a program is linked with a library, whether statically or using +a shared library, the combination of the two is legally speaking a +combined work, a derivative of the original library. The ordinary +General Public License therefore permits such linking only if the +entire combination fits its criteria of freedom. The Lesser General +Public License permits more lax criteria for linking other code with +the library. + + We call this license the "Lesser" General Public License because it +does Less to protect the user's freedom than the ordinary General +Public License. It also provides other free software developers Less +of an advantage over competing non-free programs. These disadvantages +are the reason we use the ordinary General Public License for many +libraries. However, the Lesser license provides advantages in certain +special circumstances. + + For example, on rare occasions, there may be a special need to +encourage the widest possible use of a certain library, so that it becomes +a de-facto standard. To achieve this, non-free programs must be +allowed to use the library. A more frequent case is that a free +library does the same job as widely used non-free libraries. In this +case, there is little to gain by limiting the free library to free +software only, so we use the Lesser General Public License. + + In other cases, permission to use a particular library in non-free +programs enables a greater number of people to use a large body of +free software. For example, permission to use the GNU C Library in +non-free programs enables many more people to use the whole GNU +operating system, as well as its variant, the GNU/Linux operating +system. + + Although the Lesser General Public License is Less protective of the +users' freedom, it does ensure that the user of a program that is +linked with the Library has the freedom and the wherewithal to run +that program using a modified version of the Library. + + The precise terms and conditions for copying, distribution and +modification follow. Pay close attention to the difference between a +"work based on the library" and a "work that uses the library". The +former contains code derived from the library, whereas the latter must +be combined with the library in order to run. + + GNU LESSER GENERAL PUBLIC LICENSE + TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION + + 0. This License Agreement applies to any software library or other +program which contains a notice placed by the copyright holder or +other authorized party saying it may be distributed under the terms of +this Lesser General Public License (also called "this License"). +Each licensee is addressed as "you". + + A "library" means a collection of software functions and/or data +prepared so as to be conveniently linked with application programs +(which use some of those functions and data) to form executables. + + The "Library", below, refers to any such software library or work +which has been distributed under these terms. A "work based on the +Library" means either the Library or any derivative work under +copyright law: that is to say, a work containing the Library or a +portion of it, either verbatim or with modifications and/or translated +straightforwardly into another language. (Hereinafter, translation is +included without limitation in the term "modification".) + + "Source code" for a work means the preferred form of the work for +making modifications to it. For a library, complete source code means +all the source code for all modules it contains, plus any associated +interface definition files, plus the scripts used to control compilation +and installation of the library. + + Activities other than copying, distribution and modification are not +covered by this License; they are outside its scope. The act of +running a program using the Library is not restricted, and output from +such a program is covered only if its contents constitute a work based +on the Library (independent of the use of the Library in a tool for +writing it). Whether that is true depends on what the Library does +and what the program that uses the Library does. + + 1. You may copy and distribute verbatim copies of the Library's +complete source code as you receive it, in any medium, provided that +you conspicuously and appropriately publish on each copy an +appropriate copyright notice and disclaimer of warranty; keep intact +all the notices that refer to this License and to the absence of any +warranty; and distribute a copy of this License along with the +Library. + + You may charge a fee for the physical act of transferring a copy, +and you may at your option offer warranty protection in exchange for a +fee. + + 2. You may modify your copy or copies of the Library or any portion +of it, thus forming a work based on the Library, and copy and +distribute such modifications or work under the terms of Section 1 +above, provided that you also meet all of these conditions: + + a) The modified work must itself be a software library. + + b) You must cause the files modified to carry prominent notices + stating that you changed the files and the date of any change. + + c) You must cause the whole of the work to be licensed at no + charge to all third parties under the terms of this License. + + d) If a facility in the modified Library refers to a function or a + table of data to be supplied by an application program that uses + the facility, other than as an argument passed when the facility + is invoked, then you must make a good faith effort to ensure that, + in the event an application does not supply such function or + table, the facility still operates, and performs whatever part of + its purpose remains meaningful. + + (For example, a function in a library to compute square roots has + a purpose that is entirely well-defined independent of the + application. Therefore, Subsection 2d requires that any + application-supplied function or table used by this function must + be optional: if the application does not supply it, the square + root function must still compute square roots.) + +These requirements apply to the modified work as a whole. If +identifiable sections of that work are not derived from the Library, +and can be reasonably considered independent and separate works in +themselves, then this License, and its terms, do not apply to those +sections when you distribute them as separate works. But when you +distribute the same sections as part of a whole which is a work based +on the Library, the distribution of the whole must be on the terms of +this License, whose permissions for other licensees extend to the +entire whole, and thus to each and every part regardless of who wrote +it. + +Thus, it is not the intent of this section to claim rights or contest +your rights to work written entirely by you; rather, the intent is to +exercise the right to control the distribution of derivative or +collective works based on the Library. + +In addition, mere aggregation of another work not based on the Library +with the Library (or with a work based on the Library) on a volume of +a storage or distribution medium does not bring the other work under +the scope of this License. + + 3. You may opt to apply the terms of the ordinary GNU General Public +License instead of this License to a given copy of the Library. To do +this, you must alter all the notices that refer to this License, so +that they refer to the ordinary GNU General Public License, version 2, +instead of to this License. (If a newer version than version 2 of the +ordinary GNU General Public License has appeared, then you can specify +that version instead if you wish.) Do not make any other change in +these notices. + + Once this change is made in a given copy, it is irreversible for +that copy, so the ordinary GNU General Public License applies to all +subsequent copies and derivative works made from that copy. + + This option is useful when you wish to copy part of the code of +the Library into a program that is not a library. + + 4. You may copy and distribute the Library (or a portion or +derivative of it, under Section 2) in object code or executable form +under the terms of Sections 1 and 2 above provided that you accompany +it with the complete corresponding machine-readable source code, which +must be distributed under the terms of Sections 1 and 2 above on a +medium customarily used for software interchange. + + If distribution of object code is made by offering access to copy +from a designated place, then offering equivalent access to copy the +source code from the same place satisfies the requirement to +distribute the source code, even though third parties are not +compelled to copy the source along with the object code. + + 5. A program that contains no derivative of any portion of the +Library, but is designed to work with the Library by being compiled or +linked with it, is called a "work that uses the Library". Such a +work, in isolation, is not a derivative work of the Library, and +therefore falls outside the scope of this License. + + However, linking a "work that uses the Library" with the Library +creates an executable that is a derivative of the Library (because it +contains portions of the Library), rather than a "work that uses the +library". The executable is therefore covered by this License. +Section 6 states terms for distribution of such executables. + + When a "work that uses the Library" uses material from a header file +that is part of the Library, the object code for the work may be a +derivative work of the Library even though the source code is not. +Whether this is true is especially significant if the work can be +linked without the Library, or if the work is itself a library. The +threshold for this to be true is not precisely defined by law. + + If such an object file uses only numerical parameters, data +structure layouts and accessors, and small macros and small inline +functions (ten lines or less in length), then the use of the object +file is unrestricted, regardless of whether it is legally a derivative +work. (Executables containing this object code plus portions of the +Library will still fall under Section 6.) + + Otherwise, if the work is a derivative of the Library, you may +distribute the object code for the work under the terms of Section 6. +Any executables containing that work also fall under Section 6, +whether or not they are linked directly with the Library itself. + + 6. As an exception to the Sections above, you may also combine or +link a "work that uses the Library" with the Library to produce a +work containing portions of the Library, and distribute that work +under terms of your choice, provided that the terms permit +modification of the work for the customer's own use and reverse +engineering for debugging such modifications. + + You must give prominent notice with each copy of the work that the +Library is used in it and that the Library and its use are covered by +this License. You must supply a copy of this License. If the work +during execution displays copyright notices, you must include the +copyright notice for the Library among them, as well as a reference +directing the user to the copy of this License. Also, you must do one +of these things: + + a) Accompany the work with the complete corresponding + machine-readable source code for the Library including whatever + changes were used in the work (which must be distributed under + Sections 1 and 2 above); and, if the work is an executable linked + with the Library, with the complete machine-readable "work that + uses the Library", as object code and/or source code, so that the + user can modify the Library and then relink to produce a modified + executable containing the modified Library. (It is understood + that the user who changes the contents of definitions files in the + Library will not necessarily be able to recompile the application + to use the modified definitions.) + + b) Use a suitable shared library mechanism for linking with the + Library. A suitable mechanism is one that (1) uses at run time a + copy of the library already present on the user's computer system, + rather than copying library functions into the executable, and (2) + will operate properly with a modified version of the library, if + the user installs one, as long as the modified version is + interface-compatible with the version that the work was made with. + + c) Accompany the work with a written offer, valid for at + least three years, to give the same user the materials + specified in Subsection 6a, above, for a charge no more + than the cost of performing this distribution. + + d) If distribution of the work is made by offering access to copy + from a designated place, offer equivalent access to copy the above + specified materials from the same place. + + e) Verify that the user has already received a copy of these + materials or that you have already sent this user a copy. + + For an executable, the required form of the "work that uses the +Library" must include any data and utility programs needed for +reproducing the executable from it. However, as a special exception, +the materials to be distributed need not include anything that is +normally distributed (in either source or binary form) with the major +components (compiler, kernel, and so on) of the operating system on +which the executable runs, unless that component itself accompanies +the executable. + + It may happen that this requirement contradicts the license +restrictions of other proprietary libraries that do not normally +accompany the operating system. Such a contradiction means you cannot +use both them and the Library together in an executable that you +distribute. + + 7. You may place library facilities that are a work based on the +Library side-by-side in a single library together with other library +facilities not covered by this License, and distribute such a combined +library, provided that the separate distribution of the work based on +the Library and of the other library facilities is otherwise +permitted, and provided that you do these two things: + + a) Accompany the combined library with a copy of the same work + based on the Library, uncombined with any other library + facilities. This must be distributed under the terms of the + Sections above. + + b) Give prominent notice with the combined library of the fact + that part of it is a work based on the Library, and explaining + where to find the accompanying uncombined form of the same work. + + 8. You may not copy, modify, sublicense, link with, or distribute +the Library except as expressly provided under this License. Any +attempt otherwise to copy, modify, sublicense, link with, or +distribute the Library is void, and will automatically terminate your +rights under this License. However, parties who have received copies, +or rights, from you under this License will not have their licenses +terminated so long as such parties remain in full compliance. + + 9. You are not required to accept this License, since you have not +signed it. However, nothing else grants you permission to modify or +distribute the Library or its derivative works. These actions are +prohibited by law if you do not accept this License. Therefore, by +modifying or distributing the Library (or any work based on the +Library), you indicate your acceptance of this License to do so, and +all its terms and conditions for copying, distributing or modifying +the Library or works based on it. + + 10. Each time you redistribute the Library (or any work based on the +Library), the recipient automatically receives a license from the +original licensor to copy, distribute, link with or modify the Library +subject to these terms and conditions. You may not impose any further +restrictions on the recipients' exercise of the rights granted herein. +You are not responsible for enforcing compliance by third parties with +this License. + + 11. If, as a consequence of a court judgment or allegation of patent +infringement or for any other reason (not limited to patent issues), +conditions are imposed on you (whether by court order, agreement or +otherwise) that contradict the conditions of this License, they do not +excuse you from the conditions of this License. If you cannot +distribute so as to satisfy simultaneously your obligations under this +License and any other pertinent obligations, then as a consequence you +may not distribute the Library at all. For example, if a patent +license would not permit royalty-free redistribution of the Library by +all those who receive copies directly or indirectly through you, then +the only way you could satisfy both it and this License would be to +refrain entirely from distribution of the Library. + +If any portion of this section is held invalid or unenforceable under any +particular circumstance, the balance of the section is intended to apply, +and the section as a whole is intended to apply in other circumstances. + +It is not the purpose of this section to induce you to infringe any +patents or other property right claims or to contest validity of any +such claims; this section has the sole purpose of protecting the +integrity of the free software distribution system which is +implemented by public license practices. Many people have made +generous contributions to the wide range of software distributed +through that system in reliance on consistent application of that +system; it is up to the author/donor to decide if he or she is willing +to distribute software through any other system and a licensee cannot +impose that choice. + +This section is intended to make thoroughly clear what is believed to +be a consequence of the rest of this License. + + 12. If the distribution and/or use of the Library is restricted in +certain countries either by patents or by copyrighted interfaces, the +original copyright holder who places the Library under this License may add +an explicit geographical distribution limitation excluding those countries, +so that distribution is permitted only in or among countries not thus +excluded. In such case, this License incorporates the limitation as if +written in the body of this License. + + 13. The Free Software Foundation may publish revised and/or new +versions of the Lesser 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 Library +specifies a version number of this License which applies to it and +"any later version", you have the option of following the terms and +conditions either of that version or of any later version published by +the Free Software Foundation. If the Library does not specify a +license version number, you may choose any version ever published by +the Free Software Foundation. + + 14. If you wish to incorporate parts of the Library into other free +programs whose distribution conditions are incompatible with these, +write to the author to ask for permission. For software which is +copyrighted by the Free Software Foundation, write to the Free +Software Foundation; we sometimes make exceptions for this. Our +decision will be guided by the two goals of preserving the free status +of all derivatives of our free software and of promoting the sharing +and reuse of software generally. + + NO WARRANTY + + 15. BECAUSE THE LIBRARY IS LICENSED FREE OF CHARGE, THERE IS NO +WARRANTY FOR THE LIBRARY, TO THE EXTENT PERMITTED BY APPLICABLE LAW. +EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR +OTHER PARTIES PROVIDE THE LIBRARY "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 +LIBRARY IS WITH YOU. SHOULD THE LIBRARY PROVE DEFECTIVE, YOU ASSUME +THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. + + 16. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN +WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY +AND/OR REDISTRIBUTE THE LIBRARY 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 +LIBRARY (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 LIBRARY TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF +SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH +DAMAGES. + + END OF TERMS AND CONDITIONS + + How to Apply These Terms to Your New Libraries + + If you develop a new library, and you want it to be of the greatest +possible use to the public, we recommend making it free software that +everyone can redistribute and change. You can do so by permitting +redistribution under these terms (or, alternatively, under the terms of the +ordinary General Public License). + + To apply these terms, attach the following notices to the library. It is +safest to attach them to the start of each source file to most effectively +convey the exclusion of warranty; and each file should have at least the +"copyright" line and a pointer to where the full notice is found. + + {description} + Copyright (C) {year} {fullname} + + This library is free software; you can redistribute it and/or + modify it under the terms of the GNU Lesser General Public + License as published by the Free Software Foundation; either + version 2.1 of the License, or (at your option) any later version. + + This library 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 + Lesser General Public License for more details. + + You should have received a copy of the GNU Lesser General Public + License along with this library; if not, write to the Free Software + Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 + USA + +Also add information on how to contact you by electronic and paper mail. + +You should also get your employer (if you work as a programmer) or your +school, if any, to sign a "copyright disclaimer" for the library, if +necessary. Here is a sample; alter the names: + + Yoyodyne, Inc., hereby disclaims all copyright interest in the + library `Frob' (a library for tweaking knobs) written by James Random + Hacker. + + {signature of Ty Coon}, 1 April 1990 + Ty Coon, President of Vice + +That's all there is to it! + diff --git a/csp/README.md b/csp/README.md new file mode 100644 index 00000000..d609aaef --- /dev/null +++ b/csp/README.md @@ -0,0 +1,2 @@ +csp +=== From 09f7f9ed3de4b4b633dc594da9a6240183e2b766 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Fri, 26 Sep 2014 21:32:16 -0700 Subject: [PATCH 002/246] update gitignore --- csp/.gitignore | 17 +++++++++++++++++ 1 file changed, 17 insertions(+) create mode 100644 csp/.gitignore diff --git a/csp/.gitignore b/csp/.gitignore new file mode 100644 index 00000000..1a57f7de --- /dev/null +++ b/csp/.gitignore @@ -0,0 +1,17 @@ +*.pyc + +# for Racket +compiled/ + +# for Mac OS X +.DS_Store +.AppleDouble +.LSOverride +Icon + +# Thumbnails +._* + +# Files that might appear on external disk +.Spotlight-V100 +.Trashes From e079ae5ad2e5fb49ff15a2406d1786fcd5ad57fb Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Fri, 26 Sep 2014 21:32:22 -0700 Subject: [PATCH 003/246] python sources --- csp/agents.py | 533 ++++++++++++++++++++++++++++++++++++ csp/csp.py | 450 ++++++++++++++++++++++++++++++ csp/search.py | 736 ++++++++++++++++++++++++++++++++++++++++++++++++++ csp/utils.py | 714 ++++++++++++++++++++++++++++++++++++++++++++++++ 4 files changed, 2433 insertions(+) create mode 100644 csp/agents.py create mode 100644 csp/csp.py create mode 100644 csp/search.py create mode 100644 csp/utils.py diff --git a/csp/agents.py b/csp/agents.py new file mode 100644 index 00000000..8ed3fa1f --- /dev/null +++ b/csp/agents.py @@ -0,0 +1,533 @@ +"""Implement Agents and Environments (Chapters 1-2). + +The class hierarchies are as follows: + +Object ## A physical object that can exist in an environment + Agent + Wumpus + RandomAgent + ReflexVacuumAgent + ... + Dirt + Wall + ... + +Environment ## An environment holds objects, runs simulations + XYEnvironment + VacuumEnvironment + WumpusEnvironment + +EnvFrame ## A graphical representation of the Environment + +""" + +from utils import * +import random, copy + +#______________________________________________________________________________ + +class Object: + """This represents any physical object that can appear in an Environment. + You subclass Object to get the objects you want. Each object can have a + .__name__ slot (used for output only).""" + def __repr__(self): + return '<%s>' % getattr(self, '__name__', self.__class__.__name__) + + def is_alive(self): + """Objects that are 'alive' should return true.""" + return hasattr(self, 'alive') and self.alive + + def display(self, canvas, x, y, width, height): + """Display an image of this Object on the canvas.""" + pass + +class Agent(Object): + """An Agent is a subclass of Object with one required slot, + .program, which should hold a function that takes one argument, the + percept, and returns an action. (What counts as a percept or action + will depend on the specific environment in which the agent exists.) + Note that 'program' is a slot, not a method. If it were a method, + then the program could 'cheat' and look at aspects of the agent. + It's not supposed to do that: the program can only look at the + percepts. An agent program that needs a model of the world (and of + the agent itself) will have to build and maintain its own model. + There is an optional slots, .performance, which is a number giving + the performance measure of the agent in its environment.""" + + def __init__(self): + def program(percept): + return raw_input('Percept=%s; action? ' % percept) + self.program = program + self.alive = True + +def TraceAgent(agent): + """Wrap the agent's program to print its input and output. This will let + you see what the agent is doing in the environment.""" + old_program = agent.program + def new_program(percept): + action = old_program(percept) + print '%s perceives %s and does %s' % (agent, percept, action) + return action + agent.program = new_program + return agent + +#______________________________________________________________________________ + +class TableDrivenAgent(Agent): + """This agent selects an action based on the percept sequence. + It is practical only for tiny domains. + To customize it you provide a table to the constructor. [Fig. 2.7]""" + + def __init__(self, table): + "Supply as table a dictionary of all {percept_sequence:action} pairs." + ## The agent program could in principle be a function, but because + ## it needs to store state, we make it a callable instance of a class. + Agent.__init__(self) + percepts = [] + def program(percept): + percepts.append(percept) + action = table.get(tuple(percepts)) + return action + self.program = program + + +class RandomAgent(Agent): + "An agent that chooses an action at random, ignoring all percepts." + def __init__(self, actions): + Agent.__init__(self) + self.program = lambda percept: random.choice(actions) + + +#______________________________________________________________________________ + +loc_A, loc_B = (0, 0), (1, 0) # The two locations for the Vacuum world + +class ReflexVacuumAgent(Agent): + "A reflex agent for the two-state vacuum environment. [Fig. 2.8]" + + def __init__(self): + Agent.__init__(self) + def program((location, status)): + if status == 'Dirty': return 'Suck' + elif location == loc_A: return 'Right' + elif location == loc_B: return 'Left' + self.program = program + + +def RandomVacuumAgent(): + "Randomly choose one of the actions from the vaccum environment." + return RandomAgent(['Right', 'Left', 'Suck', 'NoOp']) + + +def TableDrivenVacuumAgent(): + "[Fig. 2.3]" + table = {((loc_A, 'Clean'),): 'Right', + ((loc_A, 'Dirty'),): 'Suck', + ((loc_B, 'Clean'),): 'Left', + ((loc_B, 'Dirty'),): 'Suck', + ((loc_A, 'Clean'), (loc_A, 'Clean')): 'Right', + ((loc_A, 'Clean'), (loc_A, 'Dirty')): 'Suck', + # ... + ((loc_A, 'Clean'), (loc_A, 'Clean'), (loc_A, 'Clean')): 'Right', + ((loc_A, 'Clean'), (loc_A, 'Clean'), (loc_A, 'Dirty')): 'Suck', + # ... + } + return TableDrivenAgent(table) + + +class ModelBasedVacuumAgent(Agent): + "An agent that keeps track of what locations are clean or dirty." + def __init__(self): + Agent.__init__(self) + model = {loc_A: None, loc_B: None} + def program((location, status)): + "Same as ReflexVacuumAgent, except if everything is clean, do NoOp" + model[location] = status ## Update the model here + if model[loc_A] == model[loc_B] == 'Clean': return 'NoOp' + elif status == 'Dirty': return 'Suck' + elif location == loc_A: return 'Right' + elif location == loc_B: return 'Left' + self.program = program + +#______________________________________________________________________________ + +class Environment: + """Abstract class representing an Environment. 'Real' Environment classes + inherit from this. Your Environment will typically need to implement: + percept: Define the percept that an agent sees. + execute_action: Define the effects of executing an action. + Also update the agent.performance slot. + The environment keeps a list of .objects and .agents (which is a subset + of .objects). Each agent has a .performance slot, initialized to 0. + Each object has a .location slot, even though some environments may not + need this.""" + + def __init__(self,): + self.objects = []; self.agents = [] + + object_classes = [] ## List of classes that can go into environment + + def percept(self, agent): + "Return the percept that the agent sees at this point. Override this." + abstract + + def execute_action(self, agent, action): + "Change the world to reflect this action. Override this." + abstract + + def default_location(self, object): + "Default location to place a new object with unspecified location." + return None + + def exogenous_change(self): + "If there is spontaneous change in the world, override this." + pass + + def is_done(self): + "By default, we're done when we can't find a live agent." + for agent in self.agents: + if agent.is_alive(): return False + return True + + def step(self): + """Run the environment for one time step. If the + actions and exogenous changes are independent, this method will + do. If there are interactions between them, you'll need to + override this method.""" + if not self.is_done(): + actions = [agent.program(self.percept(agent)) + for agent in self.agents] + for (agent, action) in zip(self.agents, actions): + self.execute_action(agent, action) + self.exogenous_change() + + def run(self, steps=1000): + """Run the Environment for given number of time steps.""" + for step in range(steps): + if self.is_done(): return + self.step() + + def add_object(self, object, location=None): + """Add an object to the environment, setting its location. Also keep + track of objects that are agents. Shouldn't need to override this.""" + object.location = location or self.default_location(object) + self.objects.append(object) + if isinstance(object, Agent): + object.performance = 0 + self.agents.append(object) + return self + + +class XYEnvironment(Environment): + """This class is for environments on a 2D plane, with locations + labelled by (x, y) points, either discrete or continuous. Agents + perceive objects within a radius. Each agent in the environment + has a .location slot which should be a location such as (0, 1), + and a .holding slot, which should be a list of objects that are + held """ + + def __init__(self, width=10, height=10): + update(self, objects=[], agents=[], width=width, height=height) + + def objects_at(self, location): + "Return all objects exactly at a given location." + return [obj for obj in self.objects if obj.location == location] + + def objects_near(self, location, radius): + "Return all objects within radius of location." + radius2 = radius * radius + return [obj for obj in self.objects + if distance2(location, obj.location) <= radius2] + + def percept(self, agent): + "By default, agent perceives objects within radius r." + return [self.object_percept(obj, agent) + for obj in self.objects_near(agent)] + + def execute_action(self, agent, action): + if action == 'TurnRight': + agent.heading = turn_heading(agent.heading, -1) + elif action == 'TurnLeft': + agent.heading = turn_heading(agent.heading, +1) + elif action == 'Forward': + self.move_to(agent, vector_add(agent.heading, agent.location)) + elif action == 'Grab': + objs = [obj for obj in self.objects_at(agent.location) + if obj.is_grabable(agent)] + if objs: + agent.holding.append(objs[0]) + elif action == 'Release': + if agent.holding: + agent.holding.pop() + agent.bump = False + + def object_percept(self, obj, agent): #??? Should go to object? + "Return the percept for this object." + return obj.__class__.__name__ + + def default_location(self, object): + return (random.choice(self.width), random.choice(self.height)) + + def move_to(object, destination): + "Move an object to a new location." + + def add_object(self, object, location=(1, 1)): + Environment.add_object(self, object, location) + object.holding = [] + object.held = None + self.objects.append(object) + + def add_walls(self): + "Put walls around the entire perimeter of the grid." + for x in range(self.width): + self.add_object(Wall(), (x, 0)) + self.add_object(Wall(), (x, self.height-1)) + for y in range(self.height): + self.add_object(Wall(), (0, y)) + self.add_object(Wall(), (self.width-1, y)) + +def turn_heading(self, heading, inc, + headings=[(1, 0), (0, 1), (-1, 0), (0, -1)]): + "Return the heading to the left (inc=+1) or right (inc=-1) in headings." + return headings[(headings.index(heading) + inc) % len(headings)] + +#______________________________________________________________________________ +## Vacuum environment + +class TrivialVacuumEnvironment(Environment): + """This environment has two locations, A and B. Each can be Dirty or Clean. + The agent perceives its location and the location's status. This serves as + an example of how to implement a simple Environment.""" + + def __init__(self): + Environment.__init__(self) + self.status = {loc_A:random.choice(['Clean', 'Dirty']), + loc_B:random.choice(['Clean', 'Dirty'])} + + def percept(self, agent): + "Returns the agent's location, and the location status (Dirty/Clean)." + return (agent.location, self.status[agent.location]) + + def execute_action(self, agent, action): + """Change agent's location and/or location's status; track performance. + Score 10 for each dirt cleaned; -1 for each move.""" + if action == 'Right': + agent.location = loc_B + agent.performance -= 1 + elif action == 'Left': + agent.location = loc_A + agent.performance -= 1 + elif action == 'Suck': + if self.status[agent.location] == 'Dirty': + agent.performance += 10 + self.status[agent.location] = 'Clean' + + def default_location(self, object): + "Agents start in either location at random." + return random.choice([loc_A, loc_B]) + +class Dirt(Object): pass +class Wall(Object): pass + +class VacuumEnvironment(XYEnvironment): + """The environment of [Ex. 2.12]. Agent perceives dirty or clean, + and bump (into obstacle) or not; 2D discrete world of unknown size; + performance measure is 100 for each dirt cleaned, and -1 for + each turn taken.""" + def __init__(self, width=10, height=10): + XYEnvironment.__init__(self, width, height) + self.add_walls() + + object_classes = [Wall, Dirt, ReflexVacuumAgent, RandomVacuumAgent, + TableDrivenVacuumAgent, ModelBasedVacuumAgent] + + def percept(self, agent): + """The percept is a tuple of ('Dirty' or 'Clean', 'Bump' or 'None'). + Unlike the TrivialVacuumEnvironment, location is NOT perceived.""" + status = if_(self.find_at(Dirt, agent.location), 'Dirty', 'Clean') + bump = if_(agent.bump, 'Bump', 'None') + return (status, bump) + + def execute_action(self, agent, action): + if action == 'Suck': + if self.find_at(Dirt, agent.location): + agent.performance += 100 + agent.performance -= 1 + XYEnvironment.execute_action(self, agent, action) + +#______________________________________________________________________________ + +class SimpleReflexAgent(Agent): + """This agent takes action based solely on the percept. [Fig. 2.13]""" + + def __init__(self, rules, interpret_input): + Agent.__init__(self) + def program(percept): + state = interpret_input(percept) + rule = rule_match(state, rules) + action = rule.action + return action + self.program = program + +class ReflexAgentWithState(Agent): + """This agent takes action based on the percept and state. [Fig. 2.16]""" + + def __init__(self, rules, udpate_state): + Agent.__init__(self) + state, action = None, None + def program(percept): + state = update_state(state, action, percept) + rule = rule_match(state, rules) + action = rule.action + return action + self.program = program + +#______________________________________________________________________________ +## The Wumpus World + +class Gold(Object): pass +class Pit(Object): pass +class Arrow(Object): pass +class Wumpus(Agent): pass +class Explorer(Agent): pass + +class WumpusEnvironment(XYEnvironment): + object_classes = [Wall, Gold, Pit, Arrow, Wumpus, Explorer] + def __init__(self, width=10, height=10): + XYEnvironment.__init__(self, width, height) + self.add_walls() + ## Needs a lot of work ... + + +#______________________________________________________________________________ + +def compare_agents(EnvFactory, AgentFactories, n=10, steps=1000): + """See how well each of several agents do in n instances of an environment. + Pass in a factory (constructor) for environments, and several for agents. + Create n instances of the environment, and run each agent in copies of + each one for steps. Return a list of (agent, average-score) tuples.""" + envs = [EnvFactory() for i in range(n)] + return [(A, test_agent(A, steps, copy.deepcopy(envs))) + for A in AgentFactories] + +def test_agent(AgentFactory, steps, envs): + "Return the mean score of running an agent in each of the envs, for steps" + total = 0 + for env in envs: + agent = AgentFactory() + env.add_object(agent) + env.run(steps) + total += agent.performance + return float(total)/len(envs) + +#______________________________________________________________________________ + +_docex = """ +a = ReflexVacuumAgent() +a.program +a.program((loc_A, 'Clean')) ==> 'Right' +a.program((loc_B, 'Clean')) ==> 'Left' +a.program((loc_A, 'Dirty')) ==> 'Suck' +a.program((loc_A, 'Dirty')) ==> 'Suck' + +e = TrivialVacuumEnvironment() +e.add_object(TraceAgent(ModelBasedVacuumAgent())) +e.run(5) + +## Environments, and some agents, are randomized, so the best we can +## give is a range of expected scores. If this test fails, it does +## not necessarily mean something is wrong. +envs = [TrivialVacuumEnvironment() for i in range(100)] +def testv(A): return test_agent(A, 4, copy.deepcopy(envs)) +testv(ModelBasedVacuumAgent) +(7 < _ < 11) ==> True +testv(ReflexVacuumAgent) +(5 < _ < 9) ==> True +testv(TableDrivenVacuumAgent) +(2 < _ < 6) ==> True +testv(RandomVacuumAgent) +(0.5 < _ < 3) ==> True +""" + +#______________________________________________________________________________ +# GUI - Graphical User Interface for Environments +# If you do not have Tkinter installed, either get a new installation of Python +# (Tkinter is standard in all new releases), or delete the rest of this file +# and muddle through without a GUI. + +''' +import Tkinter as tk + +class EnvFrame(tk.Frame): + def __init__(self, env, title='AIMA GUI', cellwidth=50, n=10): + update(self, cellwidth = cellwidth, running=False, delay=1.0) + self.n = n + self.running = 0 + self.delay = 1.0 + self.env = env + tk.Frame.__init__(self, None, width=(cellwidth+2)*n, height=(cellwidth+2)*n) + #self.title(title) + # Toolbar + toolbar = tk.Frame(self, relief='raised', bd=2) + toolbar.pack(side='top', fill='x') + for txt, cmd in [('Step >', self.env.step), ('Run >>', self.run), + ('Stop [ ]', self.stop)]: + tk.Button(toolbar, text=txt, command=cmd).pack(side='left') + tk.Label(toolbar, text='Delay').pack(side='left') + scale = tk.Scale(toolbar, orient='h', from_=0.0, to=10, resolution=0.5, + command=lambda d: setattr(self, 'delay', d)) + scale.set(self.delay) + scale.pack(side='left') + # Canvas for drawing on + self.canvas = tk.Canvas(self, width=(cellwidth+1)*n, + height=(cellwidth+1)*n, background="white") + self.canvas.bind('', self.left) ## What should this do? + self.canvas.bind('', self.edit_objects) + self.canvas.bind('', self.add_object) + if cellwidth: + c = self.canvas + for i in range(1, n+1): + c.create_line(0, i*cellwidth, n*cellwidth, i*cellwidth) + c.create_line(i*cellwidth, 0, i*cellwidth, n*cellwidth) + c.pack(expand=1, fill='both') + self.pack() + + + def background_run(self): + if self.running: + self.env.step() + ms = int(1000 * max(float(self.delay), 0.5)) + self.after(ms, self.background_run) + + def run(self): + print 'run' + self.running = 1 + self.background_run() + + def stop(self): + print 'stop' + self.running = 0 + + def left(self, event): + print 'left at ', event.x/50, event.y/50 + + def edit_objects(self, event): + """Choose an object within radius and edit its fields.""" + pass + + def add_object(self, event): + ## This is supposed to pop up a menu of Object classes; you choose the one + ## You want to put in this square. Not working yet. + menu = tk.Menu(self, title='Edit (%d, %d)' % (event.x/50, event.y/50)) + for (txt, cmd) in [('Wumpus', self.run), ('Pit', self.run)]: + menu.add_command(label=txt, command=cmd) + menu.tk_popup(event.x + self.winfo_rootx(), + event.y + self.winfo_rooty()) + + #image=PhotoImage(file=r"C:\Documents and Settings\pnorvig\Desktop\wumpus.gif") + #self.images = [] + #self.images.append(image) + #c.create_image(200,200,anchor=NW,image=image) + +#v = VacuumEnvironment(); w = EnvFrame(v); +''' diff --git a/csp/csp.py b/csp/csp.py new file mode 100644 index 00000000..9347599a --- /dev/null +++ b/csp/csp.py @@ -0,0 +1,450 @@ +"""CSP (Constraint Satisfaction Problems) problems and solvers. (Chapter 5).""" + +from __future__ import generators +from utils import * +import search +import types + +class CSP(search.Problem): + """This class describes finite-domain Constraint Satisfaction Problems. + A CSP is specified by the following three inputs: + vars A list of variables; each is atomic (e.g. int or string). + domains A dict of {var:[possible_value, ...]} entries. + neighbors A dict of {var:[var,...]} that for each variable lists + the other variables that participate in constraints. + constraints A function f(A, a, B, b) that returns true if neighbors + A, B satisfy the constraint when they have values A=a, B=b + In the textbook and in most mathematical definitions, the + constraints are specified as explicit pairs of allowable values, + but the formulation here is easier to express and more compact for + most cases. (For example, the n-Queens problem can be represented + in O(n) space using this notation, instead of O(N^4) for the + explicit representation.) In terms of describing the CSP as a + problem, that's all there is. + + However, the class also supports data structures and methods that help you + solve CSPs by calling a search function on the CSP. Methods and slots are + as follows, where the argument 'a' represents an assignment, which is a + dict of {var:val} entries: + assign(var, val, a) Assign a[var] = val; do other bookkeeping + unassign(var, a) Do del a[var], plus other bookkeeping + nconflicts(var, val, a) Return the number of other variables that + conflict with var=val + curr_domains[var] Slot: remaining consistent values for var + Used by constraint propagation routines. + The following methods are used only by graph_search and tree_search: + succ() Return a list of (action, state) pairs + goal_test(a) Return true if all constraints satisfied + The following are just for debugging purposes: + nassigns Slot: tracks the number of assignments made + display(a) Print a human-readable representation + """ + + def __init__(self, vars, domains, neighbors, constraints): + "Construct a CSP problem. If vars is empty, it becomes domains.keys()." + vars = vars or domains.keys() + update(self, vars=vars, domains=domains, + neighbors=neighbors, constraints=constraints, + initial={}, curr_domains=None, pruned=None, nassigns=0) + + def assign(self, var, val, assignment): + """Add {var: val} to assignment; Discard the old value if any. + Do bookkeeping for curr_domains and nassigns.""" + self.nassigns += 1 + assignment[var] = val + if self.curr_domains: + if self.fc: + self.forward_check(var, val, assignment) + if self.mac: + AC3(self, [(Xk, var) for Xk in self.neighbors[var]]) + + def unassign(self, var, assignment): + """Remove {var: val} from assignment; that is backtrack. + DO NOT call this if you are changing a variable to a new value; + just call assign for that.""" + if var in assignment: + # Reset the curr_domain to be the full original domain + if self.curr_domains: + self.curr_domains[var] = self.domains[var][:] + del assignment[var] + + def nconflicts(self, var, val, assignment): + "Return the number of conflicts var=val has with other variables." + # Subclasses may implement this more efficiently + def conflict(var2): + val2 = assignment.get(var2, None) + return val2 != None and not self.constraints(var, val, var2, val2) + return count_if(conflict, self.neighbors[var]) + + def forward_check(self, var, val, assignment): + "Do forward checking (current domain reduction) for this assignment." + if self.curr_domains: + # Restore prunings from previous value of var + for (B, b) in self.pruned[var]: + self.curr_domains[B].append(b) + self.pruned[var] = [] + # Prune any other B=b assignement that conflict with var=val + for B in self.neighbors[var]: + if B not in assignment: + for b in self.curr_domains[B][:]: + if not self.constraints(var, val, B, b): + self.curr_domains[B].remove(b) + self.pruned[var].append((B, b)) + + def display(self, assignment): + "Show a human-readable representation of the CSP." + # Subclasses can print in a prettier way, or display with a GUI + print 'CSP:', self, 'with assignment:', assignment + + ## These methods are for the tree and graph search interface: + + def succ(self, assignment): + "Return a list of (action, state) pairs." + if len(assignment) == len(self.vars): + return [] + else: + var = find_if(lambda v: v not in assignment, self.vars) + result = [] + for val in self.domains[var]: + if self.nconflicts(self, var, val, assignment) == 0: + a = assignment.copy; a[var] = val + result.append(((var, val), a)) + return result + + def goal_test(self, assignment): + "The goal is to assign all vars, with all constraints satisfied." + return (len(assignment) == len(self.vars) and + every(lambda var: self.nconflicts(var, assignment[var], + assignment) == 0, + self.vars)) + + ## This is for min_conflicts search + + def conflicted_vars(self, current): + "Return a list of variables in current assignment that are in conflict" + return [var for var in self.vars + if self.nconflicts(var, current[var], current) > 0] + +#______________________________________________________________________________ +# CSP Backtracking Search + +def backtracking_search(csp, mcv=False, lcv=False, fc=False, mac=False): + """Set up to do recursive backtracking search. Allow the following options: + mcv - If true, use Most Constrained Variable Heuristic + lcv - If true, use Least Constraining Value Heuristic + fc - If true, use Forward Checking + mac - If true, use Maintaining Arc Consistency. [Fig. 5.3] + >>> backtracking_search(australia) + {'WA': 'B', 'Q': 'B', 'T': 'B', 'V': 'B', 'SA': 'G', 'NT': 'R', 'NSW': 'R'} + """ + if fc or mac: + csp.curr_domains, csp.pruned = {}, {} + for v in csp.vars: + csp.curr_domains[v] = csp.domains[v][:] + csp.pruned[v] = [] + update(csp, mcv=mcv, lcv=lcv, fc=fc, mac=mac) + return recursive_backtracking({}, csp) + +def recursive_backtracking(assignment, csp): + """Search for a consistent assignment for the csp. + Each recursive call chooses a variable, and considers values for it.""" + if len(assignment) == len(csp.vars): + return assignment + var = select_unassigned_variable(assignment, csp) + for val in order_domain_values(var, assignment, csp): + if csp.fc or csp.nconflicts(var, val, assignment) == 0: + csp.assign(var, val, assignment) + result = recursive_backtracking(assignment, csp) + if result is not None: + return result + csp.unassign(var, assignment) + return None + +def select_unassigned_variable(assignment, csp): + "Select the variable to work on next. Find" + if csp.mcv: # Most Constrained Variable + unassigned = [v for v in csp.vars if v not in assignment] + return argmin_random_tie(unassigned, + lambda var: -num_legal_values(csp, var, assignment)) + else: # First unassigned variable + for v in csp.vars: + if v not in assignment: + return v + +def order_domain_values(var, assignment, csp): + "Decide what order to consider the domain variables." + if csp.curr_domains: + domain = csp.curr_domains[var] + else: + domain = csp.domains[var][:] + if csp.lcv: + # If LCV is specified, consider values with fewer conflicts first + key = lambda val: csp.nconflicts(var, val, assignment) + domain.sort(lambda(x,y): cmp(key(x), key(y))) + while domain: + yield domain.pop() + +def num_legal_values(csp, var, assignment): + if csp.curr_domains: + return len(csp.curr_domains[var]) + else: + return count_if(lambda val: csp.nconflicts(var, val, assignment) == 0, + csp.domains[var]) + +#______________________________________________________________________________ +# Constraint Propagation with AC-3 + +def AC3(csp, queue=None): + """[Fig. 5.7]""" + if queue == None: + queue = [(Xi, Xk) for Xi in csp.vars for Xk in csp.neighbors[Xi]] + while queue: + (Xi, Xj) = queue.pop() + if remove_inconsistent_values(csp, Xi, Xj): + for Xk in csp.neighbors[Xi]: + queue.append((Xk, Xi)) + +def remove_inconsistent_values(csp, Xi, Xj): + "Return true if we remove a value." + removed = False + for x in csp.curr_domains[Xi][:]: + # If Xi=x conflicts with Xj=y for every possible y, eliminate Xi=x + if every(lambda y: not csp.constraints(Xi, x, Xj, y), + csp.curr_domains[Xj]): + csp.curr_domains[Xi].remove(x) + removed = True + return removed + +#______________________________________________________________________________ +# Min-conflicts hillclimbing search for CSPs + +def min_conflicts(csp, max_steps=1000000): + """Solve a CSP by stochastic hillclimbing on the number of conflicts.""" + # Generate a complete assignement for all vars (probably with conflicts) + current = {}; csp.current = current + for var in csp.vars: + val = min_conflicts_value(csp, var, current) + csp.assign(var, val, current) + # Now repeapedly choose a random conflicted variable and change it + for i in range(max_steps): + conflicted = csp.conflicted_vars(current) + if not conflicted: + return current + var = random.choice(conflicted) + val = min_conflicts_value(csp, var, current) + csp.assign(var, val, current) + return None + +def min_conflicts_value(csp, var, current): + """Return the value that will give var the least number of conflicts. + If there is a tie, choose at random.""" + return argmin_random_tie(csp.domains[var], + lambda val: csp.nconflicts(var, val, current)) + +#______________________________________________________________________________ +# Map-Coloring Problems + +class UniversalDict: + """A universal dict maps any key to the same value. We use it here + as the domains dict for CSPs in which all vars have the same domain. + >>> d = UniversalDict(42) + >>> d['life'] + 42 + """ + def __init__(self, value): self.value = value + def __getitem__(self, key): return self.value + def __repr__(self): return '{Any: %r}' % self.value + +def different_values_constraint(A, a, B, b): + "A constraint saying two neighboring variables must differ in value." + return a != b + +def MapColoringCSP(colors, neighbors): + """Make a CSP for the problem of coloring a map with different colors + for any two adjacent regions. Arguments are a list of colors, and a + dict of {region: [neighbor,...]} entries. This dict may also be + specified as a string of the form defined by parse_neighbors""" + + if isinstance(neighbors, str): + neighbors = parse_neighbors(neighbors) + return CSP(neighbors.keys(), UniversalDict(colors), neighbors, + different_values_constraint) + +def parse_neighbors(neighbors, vars=[]): + """Convert a string of the form 'X: Y Z; Y: Z' into a dict mapping + regions to neighbors. The syntax is a region name followed by a ':' + followed by zero or more region names, followed by ';', repeated for + each region name. If you say 'X: Y' you don't need 'Y: X'. + >>> parse_neighbors('X: Y Z; Y: Z') + {'Y': ['X', 'Z'], 'X': ['Y', 'Z'], 'Z': ['X', 'Y']} + """ + dict = DefaultDict([]) + for var in vars: + dict[var] = [] + specs = [spec.split(':') for spec in neighbors.split(';')] + for (A, Aneighbors) in specs: + A = A.strip(); + dict.setdefault(A, []) + for B in Aneighbors.split(): + dict[A].append(B) + dict[B].append(A) + return dict + +australia = MapColoringCSP(list('RGB'), + 'SA: WA NT Q NSW V; NT: WA Q; NSW: Q V; T: ') + +usa = MapColoringCSP(list('RGBY'), + """WA: OR ID; OR: ID NV CA; CA: NV AZ; NV: ID UT AZ; ID: MT WY UT; + UT: WY CO AZ; MT: ND SD WY; WY: SD NE CO; CO: NE KA OK NM; NM: OK TX; + ND: MN SD; SD: MN IA NE; NE: IA MO KA; KA: MO OK; OK: MO AR TX; + TX: AR LA; MN: WI IA; IA: WI IL MO; MO: IL KY TN AR; AR: MS TN LA; + LA: MS; WI: MI IL; IL: IN; IN: KY; MS: TN AL; AL: TN GA FL; MI: OH; + OH: PA WV KY; KY: WV VA TN; TN: VA NC GA; GA: NC SC FL; + PA: NY NJ DE MD WV; WV: MD VA; VA: MD DC NC; NC: SC; NY: VT MA CA NJ; + NJ: DE; DE: MD; MD: DC; VT: NH MA; MA: NH RI CT; CT: RI; ME: NH; + HI: ; AK: """) +#______________________________________________________________________________ +# n-Queens Problem + +def queen_constraint(A, a, B, b): + """Constraint is satisfied (true) if A, B are really the same variable, + or if they are not in the same row, down diagonal, or up diagonal.""" + return A == B or (a != b and A + a != B + b and A - a != B - b) + +class NQueensCSP(CSP): + """Make a CSP for the nQueens problem for search with min_conflicts. + Suitable for large n, it uses only data structures of size O(n). + Think of placing queens one per column, from left to right. + That means position (x, y) represents (var, val) in the CSP. + The main structures are three arrays to count queens that could conflict: + rows[i] Number of queens in the ith row (i.e val == i) + downs[i] Number of queens in the \ diagonal + such that their (x, y) coordinates sum to i + ups[i] Number of queens in the / diagonal + such that their (x, y) coordinates have x-y+n-1 = i + We increment/decrement these counts each time a queen is placed/moved from + a row/diagonal. So moving is O(1), as is nconflicts. But choosing + a variable, and a best value for the variable, are each O(n). + If you want, you can keep track of conflicted vars, then variable + selection will also be O(1). + >>> len(backtracking_search(NQueensCSP(8))) + 8 + >>> len(min_conflicts(NQueensCSP(8))) + 8 + """ + def __init__(self, n): + """Initialize data structures for n Queens.""" + CSP.__init__(self, range(n), UniversalDict(range(n)), + UniversalDict(range(n)), queen_constraint) + update(self, rows=[0]*n, ups=[0]*(2*n - 1), downs=[0]*(2*n - 1)) + + def nconflicts(self, var, val, assignment): + """The number of conflicts, as recorded with each assignment. + Count conflicts in row and in up, down diagonals. If there + is a queen there, it can't conflict with itself, so subtract 3.""" + n = len(self.vars) + c = self.rows[val] + self.downs[var+val] + self.ups[var-val+n-1] + if assignment.get(var, None) == val: + c -= 3 + return c + + def assign(self, var, val, assignment): + "Assign var, and keep track of conflicts." + oldval = assignment.get(var, None) + if val != oldval: + if oldval is not None: # Remove old val if there was one + self.record_conflict(assignment, var, oldval, -1) + self.record_conflict(assignment, var, val, +1) + CSP.assign(self, var, val, assignment) + + def unassign(self, var, assignment): + "Remove var from assignment (if it is there) and track conflicts." + if var in assignment: + self.record_conflict(assignment, var, assignment[var], -1) + CSP.unassign(self, var, assignment) + + def record_conflict(self, assignment, var, val, delta): + "Record conflicts caused by addition or deletion of a Queen." + n = len(self.vars) + self.rows[val] += delta + self.downs[var + val] += delta + self.ups[var - val + n - 1] += delta + + def display(self, assignment): + "Print the queens and the nconflicts values (for debugging)." + n = len(self.vars) + for val in range(n): + for var in range(n): + if assignment.get(var,'') == val: ch ='Q' + elif (var+val) % 2 == 0: ch = '.' + else: ch = '-' + print ch, + print ' ', + for var in range(n): + if assignment.get(var,'') == val: ch ='*' + else: ch = ' ' + print str(self.nconflicts(var, val, assignment))+ch, + print + +#______________________________________________________________________________ +# The Zebra Puzzle + +def Zebra(): + "Return an instance of the Zebra Puzzle." + Colors = 'Red Yellow Blue Green Ivory'.split() + Pets = 'Dog Fox Snails Horse Zebra'.split() + Drinks = 'OJ Tea Coffee Milk Water'.split() + Countries = 'Englishman Spaniard Norwegian Ukranian Japanese'.split() + Smokes = 'Kools Chesterfields Winston LuckyStrike Parliaments'.split() + vars = Colors + Pets + Drinks + Countries + Smokes + domains = {} + for var in vars: + domains[var] = range(1, 6) + domains['Norwegian'] = [1] + domains['Milk'] = [3] + neighbors = parse_neighbors("""Englishman: Red; + Spaniard: Dog; Kools: Yellow; Chesterfields: Fox; + Norwegian: Blue; Winston: Snails; LuckyStrike: OJ; + Ukranian: Tea; Japanese: Parliaments; Kools: Horse; + Coffee: Green; Green: Ivory""", vars) + for type in [Colors, Pets, Drinks, Countries, Smokes]: + for A in type: + for B in type: + if A != B: + if B not in neighbors[A]: neighbors[A].append(B) + if A not in neighbors[B]: neighbors[B].append(A) + def zebra_constraint(A, a, B, b, recurse=0): + same = (a == b) + next_to = abs(a - b) == 1 + if A == 'Englishman' and B == 'Red': return same + if A == 'Spaniard' and B == 'Dog': return same + if A == 'Chesterfields' and B == 'Fox': return next_to + if A == 'Norwegian' and B == 'Blue': return next_to + if A == 'Kools' and B == 'Yellow': return same + if A == 'Winston' and B == 'Snails': return same + if A == 'LuckyStrike' and B == 'OJ': return same + if A == 'Ukranian' and B == 'Tea': return same + if A == 'Japanese' and B == 'Parliaments': return same + if A == 'Kools' and B == 'Horse': return next_to + if A == 'Coffee' and B == 'Green': return same + if A == 'Green' and B == 'Ivory': return (a - 1) == b + if recurse == 0: return zebra_constraint(B, b, A, a, 1) + if ((A in Colors and B in Colors) or + (A in Pets and B in Pets) or + (A in Drinks and B in Drinks) or + (A in Countries and B in Countries) or + (A in Smokes and B in Smokes)): return not same + raise 'error' + return CSP(vars, domains, neighbors, zebra_constraint) + +def solve_zebra(algorithm=min_conflicts, **args): + z = Zebra() + ans = algorithm(z, **args) + for h in range(1, 6): + print 'House', h, + for (var, val) in ans.items(): + if val == h: print var, + print + return ans['Zebra'], ans['Water'], z.nassigns, ans, + + diff --git a/csp/search.py b/csp/search.py new file mode 100644 index 00000000..cb0c07dd --- /dev/null +++ b/csp/search.py @@ -0,0 +1,736 @@ +"""Search (Chapters 3-4) + +The way to use this code is to subclass Problem to create a class of problems, +then create problem instances and solve them with calls to the various search +functions.""" + +from __future__ import generators +from utils import * +import agents +import math, random, sys, time, bisect, string + +#______________________________________________________________________________ + +class Problem: + """The abstract class for a formal problem. You should subclass this and + implement the method successor, and possibly __init__, goal_test, and + path_cost. Then you will create instances of your subclass and solve them + with the various search functions.""" + + def __init__(self, initial, goal=None): + """The constructor specifies the initial state, and possibly a goal + state, if there is a unique goal. Your subclass's constructor can add + other arguments.""" + self.initial = initial; self.goal = goal + + def successor(self, state): + """Given a state, return a sequence of (action, state) pairs reachable + from this state. If there are many successors, consider an iterator + that yields the successors one at a time, rather than building them + all at once. Iterators will work fine within the framework.""" + abstract + + def goal_test(self, state): + """Return True if the state is a goal. The default method compares the + state to self.goal, as specified in the constructor. Implement this + method if checking against a single self.goal is not enough.""" + return state == self.goal + + def path_cost(self, c, state1, action, state2): + """Return the cost of a solution path that arrives at state2 from + state1 via action, assuming cost c to get up to state1. If the problem + is such that the path doesn't matter, this function will only look at + state2. If the path does matter, it will consider c and maybe state1 + and action. The default method costs 1 for every step in the path.""" + return c + 1 + + def value(self): + """For optimization problems, each state has a value. Hill-climbing + and related algorithms try to maximize this value.""" + abstract +#______________________________________________________________________________ + +class Node: + """A node in a search tree. Contains a pointer to the parent (the node + that this is a successor of) and to the actual state for this node. Note + that if a state is arrived at by two paths, then there are two nodes with + the same state. Also includes the action that got us to this state, and + the total path_cost (also known as g) to reach the node. Other functions + may add an f and h value; see best_first_graph_search and astar_search for + an explanation of how the f and h values are handled. You will not need to + subclass this class.""" + + def __init__(self, state, parent=None, action=None, path_cost=0): + "Create a search tree Node, derived from a parent by an action." + update(self, state=state, parent=parent, action=action, + path_cost=path_cost, depth=0) + if parent: + self.depth = parent.depth + 1 + + def __repr__(self): + return "" % (self.state,) + + def path(self): + "Create a list of nodes from the root to this node." + x, result = self, [self] + while x.parent: + result.append(x.parent) + x = x.parent + return result + + def expand(self, problem): + "Return a list of nodes reachable from this node. [Fig. 3.8]" + return [Node(next, self, act, + problem.path_cost(self.path_cost, self.state, act, next)) + for (act, next) in problem.successor(self.state)] + +#______________________________________________________________________________ + +class SimpleProblemSolvingAgent(agents.Agent): + """Abstract framework for problem-solving agent. [Fig. 3.1]""" + def __init__(self): + Agent.__init__(self) + state = [] + seq = [] + + def program(percept): + state = self.update_state(state, percept) + if not seq: + goal = self.formulate_goal(state) + problem = self.formulate_problem(state, goal) + seq = self.search(problem) + action = seq[0] + seq[0:1] = [] + return action + + self.program = program + +#______________________________________________________________________________ +## Uninformed Search algorithms + +def tree_search(problem, fringe): + """Search through the successors of a problem to find a goal. + The argument fringe should be an empty queue. + Don't worry about repeated paths to a state. [Fig. 3.8]""" + fringe.append(Node(problem.initial)) + while fringe: + node = fringe.pop() + if problem.goal_test(node.state): + return node + fringe.extend(node.expand(problem)) + return None + +def breadth_first_tree_search(problem): + "Search the shallowest nodes in the search tree first. [p 74]" + return tree_search(problem, FIFOQueue()) + +def depth_first_tree_search(problem): + "Search the deepest nodes in the search tree first. [p 74]" + return tree_search(problem, Stack()) + +def graph_search(problem, fringe): + """Search through the successors of a problem to find a goal. + The argument fringe should be an empty queue. + If two paths reach a state, only use the best one. [Fig. 3.18]""" + closed = {} + fringe.append(Node(problem.initial)) + while fringe: + node = fringe.pop() + if problem.goal_test(node.state): + return node + if node.state not in closed: + closed[node.state] = True + fringe.extend(node.expand(problem)) + return None + +def breadth_first_graph_search(problem): + "Search the shallowest nodes in the search tree first. [p 74]" + return graph_search(problem, FIFOQueue()) + +def depth_first_graph_search(problem): + "Search the deepest nodes in the search tree first. [p 74]" + return graph_search(problem, Stack()) + +def depth_limited_search(problem, limit=50): + "[Fig. 3.12]" + def recursive_dls(node, problem, limit): + cutoff_occurred = False + if problem.goal_test(node.state): + return node + elif node.depth == limit: + return 'cutoff' + else: + for successor in node.expand(problem): + result = recursive_dls(successor, problem, limit) + if result == 'cutoff': + cutoff_occurred = True + elif result != None: + return result + if cutoff_occurred: + return 'cutoff' + else: + return None + # Body of depth_limited_search: + return recursive_dls(Node(problem.initial), problem, limit) + +def iterative_deepening_search(problem): + "[Fig. 3.13]" + for depth in xrange(sys.maxint): + result = depth_limited_search(problem, depth) + if result is not 'cutoff': + return result + +#______________________________________________________________________________ +# Informed (Heuristic) Search + +def best_first_graph_search(problem, f): + """Search the nodes with the lowest f scores first. + You specify the function f(node) that you want to minimize; for example, + if f is a heuristic estimate to the goal, then we have greedy best + first search; if f is node.depth then we have depth-first search. + There is a subtlety: the line "f = memoize(f, 'f')" means that the f + values will be cached on the nodes as they are computed. So after doing + a best first search you can examine the f values of the path returned.""" + f = memoize(f, 'f') + return graph_search(problem, PriorityQueue(min, f)) + +greedy_best_first_graph_search = best_first_graph_search + # Greedy best-first search is accomplished by specifying f(n) = h(n). + +def astar_search(problem, h=None): + """A* search is best-first graph search with f(n) = g(n)+h(n). + You need to specify the h function when you call astar_search. + Uses the pathmax trick: f(n) = max(f(n), g(n)+h(n)).""" + h = h or problem.h + def f(n): + return max(getattr(n, 'f', -infinity), n.path_cost + h(n)) + return best_first_graph_search(problem, f) + +#______________________________________________________________________________ +## Other search algorithms + +def recursive_best_first_search(problem): + "[Fig. 4.5]" + def RBFS(problem, node, flimit): + if problem.goal_test(node.state): + return node + successors = expand(node, problem) + if len(successors) == 0: + return None, infinity + for s in successors: + s.f = max(s.path_cost + s.h, node.f) + while True: + successors.sort(lambda x,y: x.f - y.f) # Order by lowest f value + best = successors[0] + if best.f > flimit: + return None, best.f + alternative = successors[1] + result, best.f = RBFS(problem, best, min(flimit, alternative)) + if result is not None: + return result + return RBFS(Node(problem.initial), infinity) + + +def hill_climbing(problem): + """From the initial node, keep choosing the neighbor with highest value, + stopping when no neighbor is better. [Fig. 4.11]""" + current = Node(problem.initial) + while True: + neighbor = argmax(expand(node, problem), Node.value) + if neighbor.value() <= current.value(): + return current.state + current = neighbor + +def exp_schedule(k=20, lam=0.005, limit=100): + "One possible schedule function for simulated annealing" + return lambda t: if_(t < limit, k * math.exp(-lam * t), 0) + +def simulated_annealing(problem, schedule=exp_schedule()): + "[Fig. 4.5]" + current = Node(problem.initial) + for t in xrange(sys.maxint): + T = schedule(t) + if T == 0: + return current + next = random.choice(expand(node. problem)) + delta_e = next.path_cost - current.path_cost + if delta_e > 0 or probability(math.exp(delta_e/T)): + current = next + +def online_dfs_agent(a): + "[Fig. 4.12]" + pass #### more + +def lrta_star_agent(a): + "[Fig. 4.12]" + pass #### more + +#______________________________________________________________________________ +# Genetic Algorithm + +def genetic_search(problem, fitness_fn, ngen=1000, pmut=0.0, n=20): + """Call genetic_algorithm on the appropriate parts of a problem. + This requires that the problem has a successor function that generates + reasonable states, and that it has a path_cost function that scores states. + We use the negative of the path_cost function, because costs are to be + minimized, while genetic-algorithm expects a fitness_fn to be maximized.""" + states = [s for (a, s) in problem.successor(problem.initial_state)[:n]] + random.shuffle(states) + fitness_fn = lambda s: - problem.path_cost(0, s, None, s) + return genetic_algorithm(states, fitness_fn, ngen, pmut) + +def genetic_algorithm(population, fitness_fn, ngen=1000, pmut=0.0): + """[Fig. 4.7]""" + def reproduce(p1, p2): + c = random.randrange(len(p1)) + return p1[:c] + p2[c:] + + for i in range(ngen): + new_population = [] + for i in len(population): + p1, p2 = random_weighted_selections(population, 2, fitness_fn) + child = reproduce(p1, p2) + if random.uniform(0,1) > pmut: + child.mutate() + new_population.append(child) + population = new_population + return argmax(population, fitness_fn) + +def random_weighted_selection(seq, n, weight_fn): + """Pick n elements of seq, weighted according to weight_fn. + That is, apply weight_fn to each element of seq, add up the total. + Then choose an element e with probability weight[e]/total. + Repeat n times, with replacement. """ + totals = []; runningtotal = 0 + for item in seq: + runningtotal += weight_fn(item) + totals.append(runningtotal) + selections = [] + for s in range(n): + r = random.uniform(0, totals[-1]) + for i in range(len(seq)): + if totals[i] > r: + selections.append(seq[i]) + break + return selections + + +#_____________________________________________________________________________ +# The remainder of this file implements examples for the search algorithms. + +#______________________________________________________________________________ +# Graphs and Graph Problems + +class Graph: + """A graph connects nodes (verticies) by edges (links). Each edge can also + have a length associated with it. The constructor call is something like: + g = Graph({'A': {'B': 1, 'C': 2}) + this makes a graph with 3 nodes, A, B, and C, with an edge of length 1 from + A to B, and an edge of length 2 from A to C. You can also do: + g = Graph({'A': {'B': 1, 'C': 2}, directed=False) + This makes an undirected graph, so inverse links are also added. The graph + stays undirected; if you add more links with g.connect('B', 'C', 3), then + inverse link is also added. You can use g.nodes() to get a list of nodes, + g.get('A') to get a dict of links out of A, and g.get('A', 'B') to get the + length of the link from A to B. 'Lengths' can actually be any object at + all, and nodes can be any hashable object.""" + + def __init__(self, dict=None, directed=True): + self.dict = dict or {} + self.directed = directed + if not directed: self.make_undirected() + + def make_undirected(self): + "Make a digraph into an undirected graph by adding symmetric edges." + for a in self.dict.keys(): + for (b, distance) in self.dict[a].items(): + self.connect1(b, a, distance) + + def connect(self, A, B, distance=1): + """Add a link from A and B of given distance, and also add the inverse + link if the graph is undirected.""" + self.connect1(A, B, distance) + if not self.directed: self.connect1(B, A, distance) + + def connect1(self, A, B, distance): + "Add a link from A to B of given distance, in one direction only." + self.dict.setdefault(A,{})[B] = distance + + def get(self, a, b=None): + """Return a link distance or a dict of {node: distance} entries. + .get(a,b) returns the distance or None; + .get(a) returns a dict of {node: distance} entries, possibly {}.""" + links = self.dict.setdefault(a, {}) + if b is None: return links + else: return links.get(b) + + def nodes(self): + "Return a list of nodes in the graph." + return self.dict.keys() + +def UndirectedGraph(dict=None): + "Build a Graph where every edge (including future ones) goes both ways." + return Graph(dict=dict, directed=False) + +def RandomGraph(nodes=range(10), min_links=2, width=400, height=300, + curvature=lambda: random.uniform(1.1, 1.5)): + """Construct a random graph, with the specified nodes, and random links. + The nodes are laid out randomly on a (width x height) rectangle. + Then each node is connected to the min_links nearest neighbors. + Because inverse links are added, some nodes will have more connections. + The distance between nodes is the hypotenuse times curvature(), + where curvature() defaults to a random number between 1.1 and 1.5.""" + g = UndirectedGraph() + g.locations = {} + ## Build the cities + for node in nodes: + g.locations[node] = (random.randrange(width), random.randrange(height)) + ## Build roads from each city to at least min_links nearest neighbors. + for i in range(min_links): + for node in nodes: + if len(g.get(node)) < min_links: + here = g.locations[node] + def distance_to_node(n): + if n is node or g.get(node,n): return infinity + return distance(g.locations[n], here) + neighbor = argmin(nodes, distance_to_node) + d = distance(g.locations[neighbor], here) * curvature() + g.connect(node, neighbor, int(d)) + return g + +romania = UndirectedGraph(Dict( + A=Dict(Z=75, S=140, T=118), + B=Dict(U=85, P=101, G=90, F=211), + C=Dict(D=120, R=146, P=138), + D=Dict(M=75), + E=Dict(H=86), + F=Dict(S=99), + H=Dict(U=98), + I=Dict(V=92, N=87), + L=Dict(T=111, M=70), + O=Dict(Z=71, S=151), + P=Dict(R=97), + R=Dict(S=80), + U=Dict(V=142))) +romania.locations = Dict( + A=( 91, 492), B=(400, 327), C=(253, 288), D=(165, 299), + E=(562, 293), F=(305, 449), G=(375, 270), H=(534, 350), + I=(473, 506), L=(165, 379), M=(168, 339), N=(406, 537), + O=(131, 571), P=(320, 368), R=(233, 410), S=(207, 457), + T=( 94, 410), U=(456, 350), V=(509, 444), Z=(108, 531)) + +australia = UndirectedGraph(Dict( + T=Dict(), + SA=Dict(WA=1, NT=1, Q=1, NSW=1, V=1), + NT=Dict(WA=1, Q=1), + NSW=Dict(Q=1, V=1))) +australia.locations = Dict(WA=(120, 24), NT=(135, 20), SA=(135, 30), + Q=(145, 20), NSW=(145, 32), T=(145, 42), V=(145, 37)) + +class GraphProblem(Problem): + "The problem of searching a graph from one node to another." + def __init__(self, initial, goal, graph): + Problem.__init__(self, initial, goal) + self.graph = graph + + def successor(self, A): + "Return a list of (action, result) pairs." + return [(B, B) for B in self.graph.get(A).keys()] + + def path_cost(self, cost_so_far, A, action, B): + return cost_so_far + (self.graph.get(A,B) or infinity) + + def h(self, node): + "h function is straight-line distance from a node's state to goal." + locs = getattr(self.graph, 'locations', None) + if locs: + return int(distance(locs[node.state], locs[self.goal])) + else: + return infinity + +#______________________________________________________________________________ + +#### NOTE: NQueensProblem not working properly yet. + +class NQueensProblem(Problem): + """The problem of placing N queens on an NxN board with none attacking + each other. A state is represented as an N-element array, where the + a value of r in the c-th entry means there is a queen at column c, + row r, and a value of None means that the c-th column has not been + filled in left. We fill in columns left to right.""" + def __init__(self, N): + self.N = N + self.initial = [None] * N + + def successor(self, state): + "In the leftmost empty column, try all non-conflicting rows." + if state[-1] is not None: + return [] ## All columns filled; no successors + else: + def place(col, row): + new = state[:] + new[col] = row + return new + col = state.index(None) + return [(row, place(col, row)) for row in range(self.N) + if not self.conflicted(state, row, col)] + + def conflicted(self, state, row, col): + "Would placing a queen at (row, col) conflict with anything?" + for c in range(col-1): + if self.conflict(row, col, state[c], c): + return True + return False + + def conflict(self, row1, col1, row2, col2): + "Would putting two queens in (row1, col1) and (row2, col2) conflict?" + return (row1 == row2 ## same row + or col1 == col2 ## same column + or row1-col1 == row2-col2 ## same \ diagonal + or row1+col1 == row2+col2) ## same / diagonal + + def goal_test(self, state): + "Check if all columns filled, no conflicts." + if state[-1] is None: + return False + for c in range(len(state)): + if self.conflicted(state, state[c], c): + return False + return True + +#______________________________________________________________________________ +## Inverse Boggle: Search for a high-scoring Boggle board. A good domain for +## iterative-repair and related search tehniques, as suggested by Justin Boyan. + +ALPHABET = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' + +cubes16 = ['FORIXB', 'MOQABJ', 'GURILW', 'SETUPL', + 'CMPDAE', 'ACITAO', 'SLCRAE', 'ROMASH', + 'NODESW', 'HEFIYE', 'ONUDTK', 'TEVIGN', + 'ANEDVZ', 'PINESH', 'ABILYT', 'GKYLEU'] + +def random_boggle(n=4): + """Return a random Boggle board of size n x n. + We represent a board as a linear list of letters.""" + cubes = [cubes16[i % 16] for i in range(n*n)] + random.shuffle(cubes) + return map(random.choice, cubes) + +## The best 5x5 board found by Boyan, with our word list this board scores +## 2274 words, for a score of 9837 + +boyan_best = list('RSTCSDEIAEGNLRPEATESMSSID') + +def print_boggle(board): + "Print the board in a 2-d array." + n2 = len(board); n = exact_sqrt(n2) + for i in range(n2): + if i % n == 0: print + if board[i] == 'Q': print 'Qu', + else: print str(board[i]) + ' ', + print + +def boggle_neighbors(n2, cache={}): + """"Return a list of lists, where the i-th element is the list of indexes + for the neighbors of square i.""" + if cache.get(n2): + return cache.get(n2) + n = exact_sqrt(n2) + neighbors = [None] * n2 + for i in range(n2): + neighbors[i] = [] + on_top = i < n + on_bottom = i >= n2 - n + on_left = i % n == 0 + on_right = (i+1) % n == 0 + if not on_top: + neighbors[i].append(i - n) + if not on_left: neighbors[i].append(i - n - 1) + if not on_right: neighbors[i].append(i - n + 1) + if not on_bottom: + neighbors[i].append(i + n) + if not on_left: neighbors[i].append(i + n - 1) + if not on_right: neighbors[i].append(i + n + 1) + if not on_left: neighbors[i].append(i - 1) + if not on_right: neighbors[i].append(i + 1) + cache[n2] = neighbors + return neighbors + +def exact_sqrt(n2): + "If n2 is a perfect square, return its square root, else raise error." + n = int(math.sqrt(n2)) + assert n * n == n2 + return n + +##_____________________________________________________________________________ + +class Wordlist: + """This class holds a list of words. You can use (word in wordlist) + to check if a word is in the list, or wordlist.lookup(prefix) + to see if prefix starts any of the words in the list.""" + def __init__(self, filename, min_len=3): + lines = open(filename).read().upper().split() + self.words = [word for word in lines if len(word) >= min_len] + self.words.sort() + self.bounds = {} + for c in ALPHABET: + c2 = chr(ord(c) + 1) + self.bounds[c] = (bisect.bisect(self.words, c), + bisect.bisect(self.words, c2)) + + def lookup(self, prefix, lo=0, hi=None): + """See if prefix is in dictionary, as a full word or as a prefix. + Return two values: the first is the lowest i such that + words[i].startswith(prefix), or is None; the second is + True iff prefix itself is in the Wordlist.""" + words = self.words + i = bisect.bisect_left(words, prefix, lo, hi) + if i < len(words) and words[i].startswith(prefix): + return i, (words[i] == prefix) + else: + return None, False + + def __contains__(self, word): + return self.words[bisect.bisect_left(self.words, word)] == word + + def __len__(self): + return len(self.words) + +##_____________________________________________________________________________ + +class BoggleFinder: + """A class that allows you to find all the words in a Boggle board. """ + + wordlist = None ## A class variable, holding a wordlist + + def __init__(self, board=None): + if BoggleFinder.wordlist is None: + BoggleFinder.wordlist = Wordlist("../data/wordlist") + self.found = {} + if board: + self.set_board(board) + + def set_board(self, board=None): + "Set the board, and find all the words in it." + if board is None: + board = random_boggle() + self.board = board + self.neighbors = boggle_neighbors(len(board)) + self.found = {} + for i in range(len(board)): + lo, hi = self.wordlist.bounds[board[i]] + self.find(lo, hi, i, [], '') + return self + + def find(self, lo, hi, i, visited, prefix): + """Looking in square i, find the words that continue the prefix, + considering the entries in self.wordlist.words[lo:hi], and not + revisiting the squares in visited.""" + if i in visited: + return + wordpos, is_word = self.wordlist.lookup(prefix, lo, hi) + if wordpos is not None: + if is_word: + self.found[prefix] = True + visited.append(i) + c = self.board[i] + if c == 'Q': c = 'QU' + prefix += c + for j in self.neighbors[i]: + self.find(wordpos, hi, j, visited, prefix) + visited.pop() + + def words(self): + "The words found." + return self.found.keys() + + scores = [0, 0, 0, 0, 1, 2, 3, 5] + [11] * 100 + + def score(self): + "The total score for the words found, according to the rules." + return sum([self.scores[len(w)] for w in self.words()]) + + def __len__(self): + "The number of words found." + return len(self.found) + +##_____________________________________________________________________________ + +def boggle_hill_climbing(board=None, ntimes=100, print_it=True): + """Solve inverse Boggle by hill-climbing: find a high-scoring board by + starting with a random one and changing it.""" + finder = BoggleFinder() + if board is None: + board = random_boggle() + best = len(finder.set_board(board)) + for _ in range(ntimes): + i, oldc = mutate_boggle(board) + new = len(finder.set_board(board)) + if new > best: + best = new + print best, _, board + else: + board[i] = oldc ## Change back + if print_it: + print_boggle(board) + return board, best + +def mutate_boggle(board): + i = random.randrange(len(board)) + oldc = board[i] + board[i] = random.choice(random.choice(cubes16)) ##random.choice(boyan_best) + return i, oldc + +#______________________________________________________________________________ + +## Code to compare searchers on various problems. + +class InstrumentedProblem(Problem): + """Delegates to a problem, and keeps statistics.""" + + def __init__(self, problem): + self.problem = problem + self.succs = self.goal_tests = self.states = 0 + self.found = None + + def successor(self, state): + "Return a list of (action, state) pairs reachable from this state." + result = self.problem.successor(state) + self.succs += 1; self.states += len(result) + return result + + def goal_test(self, state): + "Return true if the state is a goal." + self.goal_tests += 1 + result = self.problem.goal_test(state) + if result: + self.found = state + return result + + def __getattr__(self, attr): + if attr in ('succs', 'goal_tests', 'states'): + return self.__dict__[attr] + else: + return getattr(self.problem, attr) + + def __repr__(self): + return '<%4d/%4d/%4d/%s>' % (self.succs, self.goal_tests, + self.states, str(self.found)[0:4]) + +def compare_searchers(problems, header, searchers=[breadth_first_tree_search, + breadth_first_graph_search, depth_first_graph_search, + iterative_deepening_search, depth_limited_search, + astar_search]): + def do(searcher, problem): + p = InstrumentedProblem(problem) + searcher(p) + return p + table = [[name(s)] + [do(s, p) for p in problems] for s in searchers] + print_table(table, header) + +def compare_graph_searchers(): + compare_searchers(problems=[GraphProblem('A', 'B', romania), + GraphProblem('O', 'N', romania), + GraphProblem('Q', 'WA', australia)], + header=['Searcher', 'Romania(A,B)', 'Romania(O, N)', 'Australia']) + diff --git a/csp/utils.py b/csp/utils.py new file mode 100644 index 00000000..87728c1d --- /dev/null +++ b/csp/utils.py @@ -0,0 +1,714 @@ +"""Provide some widely useful utilities. Safe for "from utils import *". + +""" + +from __future__ import generators +import operator, math, random, copy, sys, os.path, bisect + +#______________________________________________________________________________ +# Compatibility with Python 2.2 and 2.3 + +# The AIMA code is designed to run in Python 2.2 and up (at some point, +# support for 2.2 may go away; 2.2 was released in 2001, and so is over +# 3 years old). The first part of this file brings you up to 2.4 +# compatibility if you are running in Python 2.2 or 2.3: + +try: bool, True, False ## Introduced in 2.3 +except NameError: + class bool(int): + "Simple implementation of Booleans, as in PEP 285" + def __init__(self, val): self.val = val + def __int__(self): return self.val + def __repr__(self): return ('False', 'True')[self.val] + + True, False = bool(1), bool(0) + +try: sum ## Introduced in 2.3 +except NameError: + def sum(seq, start=0): + """Sum the elements of seq. + >>> sum([1, 2, 3]) + 6 + """ + return reduce(operator.add, seq, start) + +try: enumerate ## Introduced in 2.3 +except NameError: + def enumerate(collection): + """Return an iterator that enumerates pairs of (i, c[i]). PEP 279. + >>> list(enumerate('abc')) + [(0, 'a'), (1, 'b'), (2, 'c')] + """ + ## Copied from PEP 279 + i = 0 + it = iter(collection) + while 1: + yield (i, it.next()) + i += 1 + + +try: reversed ## Introduced in 2.4 +except NameError: + def reversed(seq): + """Iterate over x in reverse order. + >>> list(reversed([1,2,3])) + [3, 2, 1] + """ + if hasattr(seq, 'keys'): + raise ValueError("mappings do not support reverse iteration") + i = len(seq) + while i > 0: + i -= 1 + yield seq[i] + + +try: sorted ## Introduced in 2.4 +except NameError: + def sorted(seq, cmp=None, key=None, reverse=False): + """Copy seq and sort and return it. + >>> sorted([3, 1, 2]) + [1, 2, 3] + """ + seq2 = copy.copy(seq) + if key: + if cmp == None: + cmp = __builtins__.cmp + seq2.sort(lambda x,y: cmp(key(x), key(y))) + else: + if cmp == None: + seq2.sort() + else: + seq2.sort(cmp) + if reverse: + seq2.reverse() + return seq2 + +try: + set, frozenset ## set builtin introduced in 2.4 +except NameError: + try: + import sets ## sets module introduced in 2.3 + set, frozenset = sets.Set, sets.ImmutableSet + except (NameError, ImportError): + class BaseSet: + "set type (see http://docs.python.org/lib/types-set.html)" + + + def __init__(self, elements=[]): + self.dict = {} + for e in elements: + self.dict[e] = 1 + + def __len__(self): + return len(self.dict) + + def __iter__(self): + for e in self.dict: + yield e + + def __contains__(self, element): + return element in self.dict + + def issubset(self, other): + for e in self.dict.keys(): + if e not in other: + return False + return True + + def issuperset(self, other): + for e in other: + if e not in self: + return False + return True + + + def union(self, other): + return type(self)(list(self) + list(other)) + + def intersection(self, other): + return type(self)([e for e in self.dict if e in other]) + + def difference(self, other): + return type(self)([e for e in self.dict if e not in other]) + + def symmetric_difference(self, other): + return type(self)([e for e in self.dict if e not in other] + + [e for e in other if e not in self.dict]) + + def copy(self): + return type(self)(self.dict) + + def __repr__(self): + elements = ", ".join(map(str, self.dict)) + return "%s([%s])" % (type(self).__name__, elements) + + __le__ = issubset + __ge__ = issuperset + __or__ = union + __and__ = intersection + __sub__ = difference + __xor__ = symmetric_difference + + class frozenset(BaseSet): + "A frozenset is a BaseSet that has a hash value and is immutable." + + def __init__(self, elements=[]): + BaseSet.__init__(elements) + self.hash = 0 + for e in self: + self.hash |= hash(e) + + def __hash__(self): + return self.hash + + class set(BaseSet): + "A set is a BaseSet that does not have a hash, but is mutable." + + def update(self, other): + for e in other: + self.add(e) + return self + + def intersection_update(self, other): + for e in self.dict.keys(): + if e not in other: + self.remove(e) + return self + + def difference_update(self, other): + for e in self.dict.keys(): + if e in other: + self.remove(e) + return self + + def symmetric_difference_update(self, other): + to_remove1 = [e for e in self.dict if e in other] + to_remove2 = [e for e in other if e in self.dict] + self.difference_update(to_remove1) + self.difference_update(to_remove2) + return self + + def add(self, element): + self.dict[element] = 1 + + def remove(self, element): + del self.dict[element] + + def discard(self, element): + if element in self.dict: + del self.dict[element] + + def pop(self): + key, val = self.dict.popitem() + return key + + def clear(self): + self.dict.clear() + + __ior__ = update + __iand__ = intersection_update + __isub__ = difference_update + __ixor__ = symmetric_difference_update + + + + +#______________________________________________________________________________ +# Simple Data Structures: infinity, Dict, Struct + +infinity = 1.0e400 + +def Dict(**entries): + """Create a dict out of the argument=value arguments. + >>> Dict(a=1, b=2, c=3) + {'a': 1, 'c': 3, 'b': 2} + """ + return entries + +class DefaultDict(dict): + """Dictionary with a default value for unknown keys.""" + def __init__(self, default): + self.default = default + + def __getitem__(self, key): + if key in self: return self.get(key) + return self.setdefault(key, copy.deepcopy(self.default)) + + def __copy__(self): + copy = DefaultDict(self.default) + copy.update(self) + return copy + +class Struct: + """Create an instance with argument=value slots. + This is for making a lightweight object whose class doesn't matter.""" + def __init__(self, **entries): + self.__dict__.update(entries) + + def __cmp__(self, other): + if isinstance(other, Struct): + return cmp(self.__dict__, other.__dict__) + else: + return cmp(self.__dict__, other) + + def __repr__(self): + args = ['%s=%s' % (k, repr(v)) for (k, v) in vars(self).items()] + return 'Struct(%s)' % ', '.join(args) + +def update(x, **entries): + """Update a dict; or an object with slots; according to entries. + >>> update({'a': 1}, a=10, b=20) + {'a': 10, 'b': 20} + >>> update(Struct(a=1), a=10, b=20) + Struct(a=10, b=20) + """ + if isinstance(x, dict): + x.update(entries) + else: + x.__dict__.update(entries) + return x + +#______________________________________________________________________________ +# Functions on Sequences (mostly inspired by Common Lisp) +# NOTE: Sequence functions (count_if, find_if, every, some) take function +# argument first (like reduce, filter, and map). + +def removeall(item, seq): + """Return a copy of seq (or string) with all occurences of item removed. + >>> removeall(3, [1, 2, 3, 3, 2, 1, 3]) + [1, 2, 2, 1] + >>> removeall(4, [1, 2, 3]) + [1, 2, 3] + """ + if isinstance(seq, str): + return seq.replace(item, '') + else: + return [x for x in seq if x != item] + +def unique(seq): + """Remove duplicate elements from seq. Assumes hashable elements. + >>> unique([1, 2, 3, 2, 1]) + [1, 2, 3] + """ + return list(set(seq)) + +def product(numbers): + """Return the product of the numbers. + >>> product([1,2,3,4]) + 24 + """ + return reduce(operator.mul, numbers, 1) + +def count_if(predicate, seq): + """Count the number of elements of seq for which the predicate is true. + >>> count_if(callable, [42, None, max, min]) + 2 + """ + f = lambda count, x: count + (not not predicate(x)) + return reduce(f, seq, 0) + +def find_if(predicate, seq): + """If there is an element of seq that satisfies predicate; return it. + >>> find_if(callable, [3, min, max]) + + >>> find_if(callable, [1, 2, 3]) + """ + for x in seq: + if predicate(x): return x + return None + +def every(predicate, seq): + """True if every element of seq satisfies predicate. + >>> every(callable, [min, max]) + 1 + >>> every(callable, [min, 3]) + 0 + """ + for x in seq: + if not predicate(x): return False + return True + +def some(predicate, seq): + """If some element x of seq satisfies predicate(x), return predicate(x). + >>> some(callable, [min, 3]) + 1 + >>> some(callable, [2, 3]) + 0 + """ + for x in seq: + px = predicate(x) + if px: return px + return False + +def isin(elt, seq): + """Like (elt in seq), but compares with is, not ==. + >>> e = []; isin(e, [1, e, 3]) + True + >>> isin(e, [1, [], 3]) + False + """ + for x in seq: + if elt is x: return True + return False + +#______________________________________________________________________________ +# Functions on sequences of numbers +# NOTE: these take the sequence argument first, like min and max, +# and like standard math notation: \sigma (i = 1..n) fn(i) +# A lot of programing is finding the best value that satisfies some condition; +# so there are three versions of argmin/argmax, depending on what you want to +# do with ties: return the first one, return them all, or pick at random. + + +def argmin(seq, fn): + """Return an element with lowest fn(seq[i]) score; tie goes to first one. + >>> argmin(['one', 'to', 'three'], len) + 'to' + """ + best = seq[0]; best_score = fn(best) + for x in seq: + x_score = fn(x) + if x_score < best_score: + best, best_score = x, x_score + return best + +def argmin_list(seq, fn): + """Return a list of elements of seq[i] with the lowest fn(seq[i]) scores. + >>> argmin_list(['one', 'to', 'three', 'or'], len) + ['to', 'or'] + """ + best_score, best = fn(seq[0]), [] + for x in seq: + x_score = fn(x) + if x_score < best_score: + best, best_score = [x], x_score + elif x_score == best_score: + best.append(x) + return best + +def argmin_random_tie(seq, fn): + """Return an element with lowest fn(seq[i]) score; break ties at random. + Thus, for all s,f: argmin_random_tie(s, f) in argmin_list(s, f)""" + best_score = fn(seq[0]); n = 0 + for x in seq: + x_score = fn(x) + if x_score < best_score: + best, best_score = x, x_score; n = 1 + elif x_score == best_score: + n += 1 + if random.randrange(n) == 0: + best = x + return best + +def argmax(seq, fn): + """Return an element with highest fn(seq[i]) score; tie goes to first one. + >>> argmax(['one', 'to', 'three'], len) + 'three' + """ + return argmin(seq, lambda x: -fn(x)) + +def argmax_list(seq, fn): + """Return a list of elements of seq[i] with the highest fn(seq[i]) scores. + >>> argmax_list(['one', 'three', 'seven'], len) + ['three', 'seven'] + """ + return argmin_list(seq, lambda x: -fn(x)) + +def argmax_random_tie(seq, fn): + "Return an element with highest fn(seq[i]) score; break ties at random." + return argmin_random_tie(seq, lambda x: -fn(x)) +#______________________________________________________________________________ +# Statistical and mathematical functions + +def histogram(values, mode=0, bin_function=None): + """Return a list of (value, count) pairs, summarizing the input values. + Sorted by increasing value, or if mode=1, by decreasing count. + If bin_function is given, map it over values first.""" + if bin_function: values = map(bin_function, values) + bins = {} + for val in values: + bins[val] = bins.get(val, 0) + 1 + if mode: + return sorted(bins.items(), key=lambda v: v[1], reverse=True) + else: + return sorted(bins.items()) + +def log2(x): + """Base 2 logarithm. + >>> log2(1024) + 10.0 + """ + return math.log10(x) / math.log10(2) + +def mode(values): + """Return the most common value in the list of values. + >>> mode([1, 2, 3, 2]) + 2 + """ + return histogram(values, mode=1)[0][0] + +def median(values): + """Return the middle value, when the values are sorted. + If there are an odd number of elements, try to average the middle two. + If they can't be averaged (e.g. they are strings), choose one at random. + >>> median([10, 100, 11]) + 11 + >>> median([1, 2, 3, 4]) + 2.5 + """ + n = len(values) + values = sorted(values) + if n % 2 == 1: + return values[n/2] + else: + middle2 = values[(n/2)-1:(n/2)+1] + try: + return mean(middle2) + except TypeError: + return random.choice(middle2) + +def mean(values): + """Return the arithmetic average of the values.""" + return sum(values) / float(len(values)) + +def stddev(values, meanval=None): + """The standard deviation of a set of values. + Pass in the mean if you already know it.""" + if meanval == None: meanval = mean(values) + return math.sqrt(sum([(x - meanval)**2 for x in values]) / (len(values)-1)) + +def dotproduct(X, Y): + """Return the sum of the element-wise product of vectors x and y. + >>> dotproduct([1, 2, 3], [1000, 100, 10]) + 1230 + """ + return sum([x * y for x, y in zip(X, Y)]) + +def vector_add(a, b): + """Component-wise addition of two vectors. + >>> vector_add((0, 1), (8, 9)) + (8, 10) + """ + return tuple(map(operator.add, a, b)) + +def probability(p): + "Return true with probability p." + return p > random.uniform(0.0, 1.0) + +def num_or_str(x): + """The argument is a string; convert to a number if possible, or strip it. + >>> num_or_str('42') + 42 + >>> num_or_str(' 42x ') + '42x' + """ + if isnumber(x): return x + try: + return int(x) + except ValueError: + try: + return float(x) + except ValueError: + return str(x).strip() + +def normalize(numbers, total=1.0): + """Multiply each number by a constant such that the sum is 1.0 (or total). + >>> normalize([1,2,1]) + [0.25, 0.5, 0.25] + """ + k = total / sum(numbers) + return [k * n for n in numbers] + +## OK, the following are not as widely useful utilities as some of the other +## functions here, but they do show up wherever we have 2D grids: Wumpus and +## Vacuum worlds, TicTacToe and Checkers, and markov decision Processes. + +orientations = [(1,0), (0, 1), (-1, 0), (0, -1)] + +def turn_right(orientation): + return orientations[orientations.index(orientation)-1] + +def turn_left(orientation): + return orientations[(orientations.index(orientation)+1) % len(orientations)] + +def distance((ax, ay), (bx, by)): + "The distance between two (x, y) points." + return math.hypot((ax - bx), (ay - by)) + +def distance2((ax, ay), (bx, by)): + "The square of the distance between two (x, y) points." + return (ax - bx)**2 + (ay - by)**2 + +def clip(vector, lowest, highest): + """Return vector, except if any element is less than the corresponding + value of lowest or more than the corresponding value of highest, clip to + those values. + >>> clip((-1, 10), (0, 0), (9, 9)) + (0, 9) + """ + return type(vector)(map(min, map(max, vector, lowest), highest)) +#______________________________________________________________________________ +# Misc Functions + +def printf(format, *args): + """Format args with the first argument as format string, and write. + Return the last arg, or format itself if there are no args.""" + sys.stdout.write(str(format) % args) + return if_(args, args[-1], format) + +def caller(n=1): + """Return the name of the calling function n levels up in the frame stack. + >>> caller(0) + 'caller' + >>> def f(): + ... return caller() + >>> f() + 'f' + """ + import inspect + return inspect.getouterframes(inspect.currentframe())[n][3] + +def memoize(fn, slot=None): + """Memoize fn: make it remember the computed value for any argument list. + If slot is specified, store result in that slot of first argument. + If slot is false, store results in a dictionary.""" + if slot: + def memoized_fn(obj, *args): + if hasattr(obj, slot): + return getattr(obj, slot) + else: + val = fn(obj, *args) + setattr(obj, slot, val) + return val + else: + def memoized_fn(*args): + if not memoized_fn.cache.has_key(args): + memoized_fn.cache[args] = fn(*args) + return memoized_fn.cache[args] + memoized_fn.cache = {} + return memoized_fn + +def if_(test, result, alternative): + """Like C++ and Java's (test ? result : alternative), except + both result and alternative are always evaluated. However, if + either evaluates to a function, it is applied to the empty arglist, + so you can delay execution by putting it in a lambda. + >>> if_(2 + 2 == 4, 'ok', lambda: expensive_computation()) + 'ok' + """ + if test: + if callable(result): return result() + return result + else: + if callable(alternative): return alternative() + return alternative + +def name(object): + "Try to find some reasonable name for the object." + return (getattr(object, 'name', 0) or getattr(object, '__name__', 0) + or getattr(getattr(object, '__class__', 0), '__name__', 0) + or str(object)) + +def isnumber(x): + "Is x a number? We say it is if it has a __int__ method." + return hasattr(x, '__int__') + +def issequence(x): + "Is x a sequence? We say it is if it has a __getitem__ method." + return hasattr(x, '__getitem__') + +def print_table(table, header=None, sep=' ', numfmt='%g'): + """Print a list of lists as a table, so that columns line up nicely. + header, if specified, will be printed as the first row. + numfmt is the format for all numbers; you might want e.g. '%6.2f'. + (If you want different formats in differnt columns, don't use print_table.) + sep is the separator between columns.""" + justs = [if_(isnumber(x), 'rjust', 'ljust') for x in table[0]] + if header: + table = [header] + table + table = [[if_(isnumber(x), lambda: numfmt % x, x) for x in row] + for row in table] + maxlen = lambda seq: max(map(len, seq)) + sizes = map(maxlen, zip(*[map(str, row) for row in table])) + for row in table: + for (j, size, x) in zip(justs, sizes, row): + print getattr(str(x), j)(size), sep, + print + +def AIMAFile(components, mode='r'): + "Open a file based at the AIMA root directory." + import utils + dir = os.path.dirname(utils.__file__) + return open(apply(os.path.join, [dir] + components), mode) + +def DataFile(name, mode='r'): + "Return a file in the AIMA /data directory." + return AIMAFile(['..', 'data', name], mode) + + +#______________________________________________________________________________ +# Queues: Stack, FIFOQueue, PriorityQueue + +class Queue: + """Queue is an abstract class/interface. There are three types: + Stack(): A Last In First Out Queue. + FIFOQueue(): A First In First Out Queue. + PriorityQueue(lt): Queue where items are sorted by lt, (default <). + Each type supports the following methods and functions: + q.append(item) -- add an item to the queue + q.extend(items) -- equivalent to: for item in items: q.append(item) + q.pop() -- return the top item from the queue + len(q) -- number of items in q (also q.__len()) + Note that isinstance(Stack(), Queue) is false, because we implement stacks + as lists. If Python ever gets interfaces, Queue will be an interface.""" + + def __init__(self): + abstract + + def extend(self, items): + for item in items: self.append(item) + +def Stack(): + """Return an empty list, suitable as a Last-In-First-Out Queue.""" + return [] + +class FIFOQueue(Queue): + """A First-In-First-Out Queue.""" + def __init__(self): + self.A = []; self.start = 0 + def append(self, item): + self.A.append(item) + def __len__(self): + return len(self.A) - self.start + def extend(self, items): + self.A.extend(items) + def pop(self): + e = self.A[self.start] + self.start += 1 + if self.start > 5 and self.start > len(self.A)/2: + self.A = self.A[self.start:] + self.start = 0 + return e + +class PriorityQueue(Queue): + """A queue in which the minimum (or maximum) element (as determined by f and + order) is returned first. If order is min, the item with minimum f(x) is + returned first; if order is max, then it is the item with maximum f(x).""" + def __init__(self, order=min, f=lambda x: x): + update(self, A=[], order=order, f=f) + def append(self, item): + bisect.insort(self.A, (self.f(item), item)) + def __len__(self): + return len(self.A) + def pop(self): + if self.order == min: + return self.A.pop(0)[1] + else: + return self.A.pop()[1] + +## Fig: The idea is we can define things like Fig[3,10] later. +## Alas, it is Fig[3,10] not Fig[3.10], because that would be the same as Fig[3.1] +Fig = {} + + + From 54b24fce7a4ca50c756bcfba1859c06c2ed1e6a9 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Sat, 27 Sep 2014 17:23:13 -0700 Subject: [PATCH 004/246] put up all aima code --- csp/{ => aima}/agents.py | 0 csp/{ => aima}/csp.py | 0 csp/aima/csp.txt | 8 + csp/aima/doctests.py | 43 ++ csp/aima/doctests.txt | 21 + csp/aima/games.py | 286 +++++++++++++ csp/aima/learning.py | 586 ++++++++++++++++++++++++++ csp/aima/logic.py | 888 +++++++++++++++++++++++++++++++++++++++ csp/aima/logic.txt | 78 ++++ csp/aima/mdp.py | 142 +++++++ csp/aima/mdp.txt | 27 ++ csp/aima/nlp.py | 170 ++++++++ csp/aima/nlp.txt | 23 + csp/aima/planning.py | 7 + csp/aima/probability.py | 171 ++++++++ csp/aima/probability.txt | 32 ++ csp/aima/rl.py | 15 + csp/{ => aima}/search.py | 0 csp/aima/search.txt | 68 +++ csp/aima/text.py | 365 ++++++++++++++++ csp/aima/text.txt | 122 ++++++ csp/{ => aima}/utils.py | 0 csp/aima/utils.txt | 169 ++++++++ 23 files changed, 3221 insertions(+) rename csp/{ => aima}/agents.py (100%) rename csp/{ => aima}/csp.py (100%) create mode 100644 csp/aima/csp.txt create mode 100644 csp/aima/doctests.py create mode 100644 csp/aima/doctests.txt create mode 100644 csp/aima/games.py create mode 100644 csp/aima/learning.py create mode 100644 csp/aima/logic.py create mode 100644 csp/aima/logic.txt create mode 100644 csp/aima/mdp.py create mode 100644 csp/aima/mdp.txt create mode 100644 csp/aima/nlp.py create mode 100644 csp/aima/nlp.txt create mode 100644 csp/aima/planning.py create mode 100644 csp/aima/probability.py create mode 100644 csp/aima/probability.txt create mode 100644 csp/aima/rl.py rename csp/{ => aima}/search.py (100%) create mode 100644 csp/aima/search.txt create mode 100644 csp/aima/text.py create mode 100644 csp/aima/text.txt rename csp/{ => aima}/utils.py (100%) create mode 100644 csp/aima/utils.txt diff --git a/csp/agents.py b/csp/aima/agents.py similarity index 100% rename from csp/agents.py rename to csp/aima/agents.py diff --git a/csp/csp.py b/csp/aima/csp.py similarity index 100% rename from csp/csp.py rename to csp/aima/csp.py diff --git a/csp/aima/csp.txt b/csp/aima/csp.txt new file mode 100644 index 00000000..dbf45c47 --- /dev/null +++ b/csp/aima/csp.txt @@ -0,0 +1,8 @@ + +### demo + +>>> min_conflicts(australia) +{'WA': 'B', 'Q': 'B', 'T': 'G', 'V': 'B', 'SA': 'R', 'NT': 'G', 'NSW': 'G'} + +>>> min_conflicts(usa) +{'WA': 'B', 'DE': 'R', 'DC': 'Y', 'WI': 'G', 'WV': 'Y', 'HI': 'R', 'FL': 'B', 'WY': 'Y', 'NH': 'R', 'NJ': 'Y', 'NM': 'Y', 'TX': 'G', 'LA': 'R', 'NC': 'B', 'ND': 'Y', 'NE': 'B', 'TN': 'G', 'NY': 'R', 'PA': 'B', 'RI': 'R', 'NV': 'Y', 'VA': 'R', 'CO': 'R', 'CA': 'B', 'AL': 'R', 'AR': 'Y', 'VT': 'Y', 'IL': 'B', 'GA': 'Y', 'IN': 'Y', 'IA': 'Y', 'OK': 'B', 'AZ': 'R', 'ID': 'G', 'CT': 'Y', 'ME': 'B', 'MD': 'G', 'KA': 'Y', 'MA': 'B', 'OH': 'R', 'UT': 'B', 'MO': 'R', 'MN': 'R', 'MI': 'B', 'AK': 'B', 'MT': 'R', 'MS': 'B', 'SC': 'G', 'KY': 'B', 'OR': 'R', 'SD': 'G'} diff --git a/csp/aima/doctests.py b/csp/aima/doctests.py new file mode 100644 index 00000000..4782f172 --- /dev/null +++ b/csp/aima/doctests.py @@ -0,0 +1,43 @@ +"""Run all doctests from modules on the command line. For each +module, if there is a "module.txt" file, run that too. However, +if the module.txt file contains the comment "# demo", +then the remainder of the file has its ">>>" lines executed, +but not run through doctest. The idea is that you can use this +to demo statements that return random or otherwise variable results. + +Example usage: + + python doctests.py *.py +""" + +import doctest, re + +def run_tests(modules, verbose=None): + "Run tests for a list of modules; then summarize results." + for module in modules: + tests, demos = split_extra_tests(module.__name__ + ".txt") + if tests: + if '__doc__' not in dir(module): + module.__doc__ = '' + module.__doc__ += '\n' + tests + '\n' + doctest.testmod(module, report=0, verbose=verbose) + if demos: + for stmt in re.findall(">>> (.*)", demos): + exec stmt in module.__dict__ + doctest.master.summarize() + + +def split_extra_tests(filename): + """Take a filename and, if it exists, return a 2-tuple of + the parts before and after '# demo'.""" + try: + contents = open(filename).read() + '# demo' + return contents.split("# demo", 1) + except IOError: + return ('', '') + +if __name__ == "__main__": + import sys + modules = [__import__(name.replace('.py','')) + for name in sys.argv if name != "-v"] + run_tests(modules, ("-v" in sys.argv)) diff --git a/csp/aima/doctests.txt b/csp/aima/doctests.txt new file mode 100644 index 00000000..5f12b6b4 --- /dev/null +++ b/csp/aima/doctests.txt @@ -0,0 +1,21 @@ +### This is an example module.txt file. +### It should contain unit tests and their expected results: + +>>> 2 + 2 +4 + +>>> '2' + '2' +'22' + +### demo + +### After the part that says 'demo' we have statements that +### are intended not as unit tests, but as demos of how to +### use the functions and methods in the module. The +### statements are executed, but the results are not +### compared to the expected results. This can be useful +### for nondeterministic functions: + + +>>> import random; random.choice('abc') +'c' diff --git a/csp/aima/games.py b/csp/aima/games.py new file mode 100644 index 00000000..0fc986b0 --- /dev/null +++ b/csp/aima/games.py @@ -0,0 +1,286 @@ +"""Games, or Adversarial Search. (Chapters 6) + +""" + +from utils import * +import random + +#______________________________________________________________________________ +# Minimax Search + +def minimax_decision(state, game): + """Given a state in a game, calculate the best move by searching + forward all the way to the terminal states. [Fig. 6.4]""" + + player = game.to_move(state) + + def max_value(state): + if game.terminal_test(state): + return game.utility(state, player) + v = -infinity + for (a, s) in game.successors(state): + v = max(v, min_value(s)) + return v + + def min_value(state): + if game.terminal_test(state): + return game.utility(state, player) + v = infinity + for (a, s) in game.successors(state): + v = min(v, max_value(s)) + return v + + # Body of minimax_decision starts here: + action, state = argmax(game.successors(state), + lambda ((a, s)): min_value(s)) + return action + + +#______________________________________________________________________________ + +def alphabeta_full_search(state, game): + """Search game to determine best action; use alpha-beta pruning. + As in [Fig. 6.7], this version searches all the way to the leaves.""" + + player = game.to_move(state) + + def max_value(state, alpha, beta): + if game.terminal_test(state): + return game.utility(state, player) + v = -infinity + for (a, s) in game.successors(state): + v = max(v, min_value(s, alpha, beta)) + if v >= beta: + return v + alpha = max(alpha, v) + return v + + def min_value(state, alpha, beta): + if game.terminal_test(state): + return game.utility(state, player) + v = infinity + for (a, s) in game.successors(state): + v = min(v, max_value(s, alpha, beta)) + if v <= alpha: + return v + beta = min(beta, v) + return v + + # Body of alphabeta_search starts here: + action, state = argmax(game.successors(state), + lambda ((a, s)): min_value(s, -infinity, infinity)) + return action + +def alphabeta_search(state, game, d=4, cutoff_test=None, eval_fn=None): + """Search game to determine best action; use alpha-beta pruning. + This version cuts off search and uses an evaluation function.""" + + player = game.to_move(state) + + def max_value(state, alpha, beta, depth): + if cutoff_test(state, depth): + return eval_fn(state) + v = -infinity + for (a, s) in game.successors(state): + v = max(v, min_value(s, alpha, beta, depth+1)) + if v >= beta: + return v + alpha = max(alpha, v) + return v + + def min_value(state, alpha, beta, depth): + if cutoff_test(state, depth): + return eval_fn(state) + v = infinity + for (a, s) in game.successors(state): + v = min(v, max_value(s, alpha, beta, depth+1)) + if v <= alpha: + return v + beta = min(beta, v) + return v + + # Body of alphabeta_search starts here: + # The default test cuts off at depth d or at a terminal state + cutoff_test = (cutoff_test or + (lambda state,depth: depth>d or game.terminal_test(state))) + eval_fn = eval_fn or (lambda state: game.utility(state, player)) + action, state = argmax(game.successors(state), + lambda ((a, s)): min_value(s, -infinity, infinity, 0)) + return action + +#______________________________________________________________________________ +# Players for Games + +def query_player(game, state): + "Make a move by querying standard input." + game.display(state) + return num_or_str(raw_input('Your move? ')) + +def random_player(game, state): + "A player that chooses a legal move at random." + return random.choice(game.legal_moves()) + +def alphabeta_player(game, state): + return alphabeta_search(state, game) + +def play_game(game, *players): + "Play an n-person, move-alternating game." + state = game.initial + while True: + for player in players: + move = player(game, state) + state = game.make_move(move, state) + if game.terminal_test(state): + return game.utility(state, players[0]) + +#______________________________________________________________________________ +# Some Sample Games + +class Game: + """A game is similar to a problem, but it has a utility for each + state and a terminal test instead of a path cost and a goal + test. To create a game, subclass this class and implement + legal_moves, make_move, utility, and terminal_test. You may + override display and successors or you can inherit their default + methods. You will also need to set the .initial attribute to the + initial state; this can be done in the constructor.""" + + def legal_moves(self, state): + "Return a list of the allowable moves at this point." + abstract + + def make_move(self, move, state): + "Return the state that results from making a move from a state." + abstract + + def utility(self, state, player): + "Return the value of this final state to player." + abstract + + def terminal_test(self, state): + "Return True if this is a final state for the game." + return not self.legal_moves(state) + + def to_move(self, state): + "Return the player whose move it is in this state." + return state.to_move + + def display(self, state): + "Print or otherwise display the state." + print state + + def successors(self, state): + "Return a list of legal (move, state) pairs." + return [(move, self.make_move(move, state)) + for move in self.legal_moves(state)] + + def __repr__(self): + return '<%s>' % self.__class__.__name__ + +class Fig62Game(Game): + """The game represented in [Fig. 6.2]. Serves as a simple test case. + >>> g = Fig62Game() + >>> minimax_decision('A', g) + 'a1' + >>> alphabeta_full_search('A', g) + 'a1' + >>> alphabeta_search('A', g) + 'a1' + """ + succs = {'A': [('a1', 'B'), ('a2', 'C'), ('a3', 'D')], + 'B': [('b1', 'B1'), ('b2', 'B2'), ('b3', 'B3')], + 'C': [('c1', 'C1'), ('c2', 'C2'), ('c3', 'C3')], + 'D': [('d1', 'D1'), ('d2', 'D2'), ('d3', 'D3')]} + utils = Dict(B1=3, B2=12, B3=8, C1=2, C2=4, C3=6, D1=14, D2=5, D3=2) + initial = 'A' + + def successors(self, state): + return self.succs.get(state, []) + + def utility(self, state, player): + if player == 'MAX': + return self.utils[state] + else: + return -self.utils[state] + + def terminal_test(self, state): + return state not in ('A', 'B', 'C', 'D') + + def to_move(self, state): + return if_(state in 'BCD', 'MIN', 'MAX') + +class TicTacToe(Game): + """Play TicTacToe on an h x v board, with Max (first player) playing 'X'. + A state has the player to move, a cached utility, a list of moves in + the form of a list of (x, y) positions, and a board, in the form of + a dict of {(x, y): Player} entries, where Player is 'X' or 'O'.""" + def __init__(self, h=3, v=3, k=3): + update(self, h=h, v=v, k=k) + moves = [(x, y) for x in range(1, h+1) + for y in range(1, v+1)] + self.initial = Struct(to_move='X', utility=0, board={}, moves=moves) + + def legal_moves(self, state): + "Legal moves are any square not yet taken." + return state.moves + + def make_move(self, move, state): + if move not in state.moves: + return state # Illegal move has no effect + board = state.board.copy(); board[move] = state.to_move + moves = list(state.moves); moves.remove(move) + return Struct(to_move=if_(state.to_move == 'X', 'O', 'X'), + utility=self.compute_utility(board, move, state.to_move), + board=board, moves=moves) + + def utility(self, state): + "Return the value to X; 1 for win, -1 for loss, 0 otherwise." + return state.utility + + def terminal_test(self, state): + "A state is terminal if it is won or there are no empty squares." + return state.utility != 0 or len(state.moves) == 0 + + def display(self, state): + board = state.board + for x in range(1, self.h+1): + for y in range(1, self.v+1): + print board.get((x, y), '.'), + print + + def compute_utility(self, board, move, player): + "If X wins with this move, return 1; if O return -1; else return 0." + if (self.k_in_row(board, move, player, (0, 1)) or + self.k_in_row(board, move, player, (1, 0)) or + self.k_in_row(board, move, player, (1, -1)) or + self.k_in_row(board, move, player, (1, 1))): + return if_(player == 'X', +1, -1) + else: + return 0 + + def k_in_row(self, board, move, player, (delta_x, delta_y)): + "Return true if there is a line through move on board for player." + x, y = move + n = 0 # n is number of moves in row + while board.get((x, y)) == player: + n += 1 + x, y = x + delta_x, y + delta_y + x, y = move + while board.get((x, y)) == player: + n += 1 + x, y = x - delta_x, y - delta_y + n -= 1 # Because we counted move itself twice + return n >= self.k + +class ConnectFour(TicTacToe): + """A TicTacToe-like game in which you can only make a move on the bottom + row, or in a square directly above an occupied square. Traditionally + played on a 7x6 board and requiring 4 in a row.""" + + def __init__(self, h=7, v=6, k=4): + TicTacToe.__init__(self, h, v, k) + + def legal_moves(self, state): + "Legal moves are any square not yet taken." + return [(x, y) for (x, y) in state.moves + if y == 0 or (x, y-1) in state.board] diff --git a/csp/aima/learning.py b/csp/aima/learning.py new file mode 100644 index 00000000..3da30004 --- /dev/null +++ b/csp/aima/learning.py @@ -0,0 +1,586 @@ +"""Learn to estimate functions from examples. (Chapters 18-20)""" + +from utils import * +import agents, random, operator + +#______________________________________________________________________________ + +class DataSet: + """A data set for a machine learning problem. It has the following fields: + + d.examples A list of examples. Each one is a list of attribute values. + d.attrs A list of integers to index into an example, so example[attr] + gives a value. Normally the same as range(len(d.examples)). + d.attrnames Optional list of mnemonic names for corresponding attrs. + d.target The attribute that a learning algorithm will try to predict. + By default the final attribute. + d.inputs The list of attrs without the target. + d.values A list of lists, each sublist is the set of possible + values for the corresponding attribute. If None, it + is computed from the known examples by self.setproblem. + If not None, an erroneous value raises ValueError. + d.name Name of the data set (for output display only). + d.source URL or other source where the data came from. + + Normally, you call the constructor and you're done; then you just + access fields like d.examples and d.target and d.inputs.""" + + def __init__(self, examples=None, attrs=None, target=-1, values=None, + attrnames=None, name='', source='', + inputs=None, exclude=(), doc=''): + """Accepts any of DataSet's fields. Examples can + also be a string or file from which to parse examples using parse_csv. + >>> DataSet(examples='1, 2, 3') + + """ + update(self, name=name, source=source, values=values) + # Initialize .examples from string or list or data directory + if isinstance(examples, str): + self.examples = parse_csv(examples) + elif examples is None: + self.examples = parse_csv(DataFile(name+'.csv').read()) + else: + self.examples = examples + map(self.check_example, self.examples) + # Attrs are the indicies of examples, unless otherwise stated. + if not attrs and self.examples: + attrs = range(len(self.examples[0])) + self.attrs = attrs + # Initialize .attrnames from string, list, or by default + if isinstance(attrnames, str): + self.attrnames = attrnames.split() + else: + self.attrnames = attrnames or attrs + self.setproblem(target, inputs=inputs, exclude=exclude) + + def setproblem(self, target, inputs=None, exclude=()): + """Set (or change) the target and/or inputs. + This way, one DataSet can be used multiple ways. inputs, if specified, + is a list of attributes, or specify exclude as a list of attributes + to not put use in inputs. Attributes can be -n .. n, or an attrname. + Also computes the list of possible values, if that wasn't done yet.""" + self.target = self.attrnum(target) + exclude = map(self.attrnum, exclude) + if inputs: + self.inputs = removall(self.target, inputs) + else: + self.inputs = [a for a in self.attrs + if a is not self.target and a not in exclude] + if not self.values: + self.values = map(unique, zip(*self.examples)) + + def add_example(self, example): + """Add an example to the list of examples, checking it first.""" + self.check_example(example) + self.examples.append(example) + + def check_example(self, example): + """Raise ValueError if example has any invalid values.""" + if self.values: + for a in self.attrs: + if example[a] not in self.values[a]: + raise ValueError('Bad value %s for attribute %s in %s' % + (example[a], self.attrnames[a], example)) + + def attrnum(self, attr): + "Returns the number used for attr, which can be a name, or -n .. n." + if attr < 0: + return len(self.attrs) + attr + elif isinstance(attr, str): + return self.attrnames.index(attr) + else: + return attr + + def sanitize(self, example): + "Return a copy of example, with non-input attributes replaced by 0." + return [i in self.inputs and example[i] for i in range(len(example))] + + def __repr__(self): + return '' % ( + self.name, len(self.examples), len(self.attrs)) + +#______________________________________________________________________________ + +def parse_csv(input, delim=','): + r"""Input is a string consisting of lines, each line has comma-delimited + fields. Convert this into a list of lists. Blank lines are skipped. + Fields that look like numbers are converted to numbers. + The delim defaults to ',' but '\t' and None are also reasonable values. + >>> parse_csv('1, 2, 3 \n 0, 2, na') + [[1, 2, 3], [0, 2, 'na']] + """ + lines = [line for line in input.splitlines() if line.strip() is not ''] + return [map(num_or_str, line.split(delim)) for line in lines] + +def rms_error(predictions, targets): + return math.sqrt(ms_error(predictions, targets)) + +def ms_error(predictions, targets): + return mean([(p - t)**2 for p, t in zip(predictions, targets)]) + +def mean_error(predictions, targets): + return mean([abs(p - t) for p, t in zip(predictions, targets)]) + +def mean_boolean_error(predictions, targets): + return mean([(p != t) for p, t in zip(predictions, targets)]) + + +#______________________________________________________________________________ + +class Learner: + """A Learner, or Learning Algorithm, can be trained with a dataset, + and then asked to predict the target attribute of an example.""" + + def train(self, dataset): + self.dataset = dataset + + def predict(self, example): + abstract + +#______________________________________________________________________________ + +class MajorityLearner(Learner): + """A very dumb algorithm: always pick the result that was most popular + in the training data. Makes a baseline for comparison.""" + + def train(self, dataset): + "Find the target value that appears most often." + self.most_popular = mode([e[dataset.target] for e in dataset.examples]) + + def predict(self, example): + "Always return same result: the most popular from the training set." + return self.most_popular + +#______________________________________________________________________________ + +class NaiveBayesLearner(Learner): + + def train(self, dataset): + """Just count the target/attr/val occurences. + Count how many times each value of each attribute occurs. + Store count in N[targetvalue][attr][val]. Let N[attr][None] be the + sum over all vals.""" + N = {} + ## Initialize to 0 + for gv in self.dataset.values[self.dataset.target]: + N[gv] = {} + for attr in self.dataset.attrs: + N[gv][attr] = {} + for val in self.dataset.values[attr]: + N[gv][attr][val] = 0 + N[gv][attr][None] = 0 + ## Go thru examples + for example in self.dataset.examples: + Ngv = N[example[self.dataset.target]] + for attr in self.dataset.attrs: + Ngv[attr][example[attr]] += 1 + Ngv[attr][None] += 1 + self._N = N + + def N(self, targetval, attr, attrval): + "Return the count in the training data of this combination." + try: + return self._N[targetval][attr][attrval] + except KeyError: + return 0 + + def P(self, targetval, attr, attrval): + """Smooth the raw counts to give a probability estimate. + Estimate adds 1 to numerator and len(possible vals) to denominator.""" + return ((self.N(targetval, attr, attrval) + 1.0) / + (self.N(targetval, attr, None) + len(self.dataset.values[attr]))) + + def predict(self, example): + """Predict the target value for example. Consider each possible value, + choose the most likely, by looking at each attribute independently.""" + possible_values = self.dataset.values[self.dataset.target] + def class_probability(targetval): + return product([self.P(targetval, a, example[a]) + for a in self.dataset.inputs], 1) + return argmax(possible_values, class_probability) + +#______________________________________________________________________________ + +class NearestNeighborLearner(Learner): + + def __init__(self, k=1): + "k-NearestNeighbor: the k nearest neighbors vote." + self.k = k + + def predict(self, example): + """With k=1, find the point closest to example. + With k>1, find k closest, and have them vote for the best.""" + if self.k == 1: + neighbor = argmin(self.dataset.examples, + lambda e: self.distance(e, example)) + return neighbor[self.dataset.target] + else: + ## Maintain a sorted list of (distance, example) pairs. + ## For very large k, a PriorityQueue would be better + best = [] + for e in examples: + d = self.distance(e, example) + if len(best) < k: + e.append((d, e)) + elif d < best[-1][0]: + best[-1] = (d, e) + best.sort() + return mode([e[self.dataset.target] for (d, e) in best]) + + def distance(self, e1, e2): + return mean_boolean_error(e1, e2) + +#______________________________________________________________________________ + +class DecisionTree: + """A DecisionTree holds an attribute that is being tested, and a + dict of {attrval: Tree} entries. If Tree here is not a DecisionTree + then it is the final classification of the example.""" + + def __init__(self, attr, attrname=None, branches=None): + "Initialize by saying what attribute this node tests." + update(self, attr=attr, attrname=attrname or attr, + branches=branches or {}) + + def predict(self, example): + "Given an example, use the tree to classify the example." + child = self.branches[example[self.attr]] + if isinstance(child, DecisionTree): + return child.predict(example) + else: + return child + + def add(self, val, subtree): + "Add a branch. If self.attr = val, go to the given subtree." + self.branches[val] = subtree + return self + + def display(self, indent=0): + name = self.attrname + print 'Test', name + for (val, subtree) in self.branches.items(): + print ' '*4*indent, name, '=', val, '==>', + if isinstance(subtree, DecisionTree): + subtree.display(indent+1) + else: + print 'RESULT = ', subtree + + def __repr__(self): + return 'DecisionTree(%r, %r, %r)' % ( + self.attr, self.attrname, self.branches) + +Yes, No = True, False + +#______________________________________________________________________________ + +class DecisionTreeLearner(Learner): + + def predict(self, example): + if isinstance(self.dt, DecisionTree): + return self.dt.predict(example) + else: + return self.dt + + def train(self, dataset): + self.dataset = dataset + self.attrnames = dataset.attrnames + self.dt = self.decision_tree_learning(dataset.examples, dataset.inputs) + + def decision_tree_learning(self, examples, attrs, default=None): + if len(examples) == 0: + return default + elif self.all_same_class(examples): + return examples[0][self.dataset.target] + elif len(attrs) == 0: + return self.majority_value(examples) + else: + best = self.choose_attribute(attrs, examples) + tree = DecisionTree(best, self.attrnames[best]) + for (v, examples_i) in self.split_by(best, examples): + subtree = self.decision_tree_learning(examples_i, + removeall(best, attrs), self.majority_value(examples)) + tree.add(v, subtree) + return tree + + def choose_attribute(self, attrs, examples): + "Choose the attribute with the highest information gain." + return argmax(attrs, lambda a: self.information_gain(a, examples)) + + def all_same_class(self, examples): + "Are all these examples in the same target class?" + target = self.dataset.target + class0 = examples[0][target] + for e in examples: + if e[target] != class0: return False + return True + + def majority_value(self, examples): + """Return the most popular target value for this set of examples. + (If target is binary, this is the majority; otherwise plurality.)""" + g = self.dataset.target + return argmax(self.dataset.values[g], + lambda v: self.count(g, v, examples)) + + def count(self, attr, val, examples): + return count_if(lambda e: e[attr] == val, examples) + + def information_gain(self, attr, examples): + def I(examples): + target = self.dataset.target + return information_content([self.count(target, v, examples) + for v in self.dataset.values[target]]) + N = float(len(examples)) + remainder = 0 + for (v, examples_i) in self.split_by(attr, examples): + remainder += (len(examples_i) / N) * I(examples_i) + return I(examples) - remainder + + def split_by(self, attr, examples=None): + "Return a list of (val, examples) pairs for each val of attr." + if examples == None: + examples = self.dataset.examples + return [(v, [e for e in examples if e[attr] == v]) + for v in self.dataset.values[attr]] + +def information_content(values): + "Number of bits to represent the probability distribution in values." + # If the values do not sum to 1, normalize them to make them a Prob. Dist. + values = removeall(0, values) + s = float(sum(values)) + if s != 1.0: values = [v/s for v in values] + return sum([- v * log2(v) for v in values]) + +#______________________________________________________________________________ + +### A decision list is implemented as a list of (test, value) pairs. + +class DecisionListLearner(Learner): + + def train(self, dataset): + self.dataset = dataset + self.attrnames = dataset.attrnames + self.dl = self.decision_list_learning(Set(dataset.examples)) + + def decision_list_learning(self, examples): + """[Fig. 18.14]""" + if not examples: + return [(True, No)] + t, o, examples_t = self.find_examples(examples) + if not t: + raise Failure + return [(t, o)] + self.decision_list_learning(examples - examples_t) + + def find_examples(self, examples): + """Find a set of examples that all have the same outcome under some test. + Return a tuple of the test, outcome, and examples.""" + NotImplemented +#______________________________________________________________________________ + +class NeuralNetLearner(Learner): + """Layered feed-forward network.""" + + def __init__(self, sizes): + self.activations = map(lambda n: [0.0 for i in range(n)], sizes) + self.weights = [] + + def train(self, dataset): + NotImplemented + + def predict(self, example): + NotImplemented + +class NNUnit: + """Unit of a neural net.""" + def __init__(self): + NotImplemented + +class PerceptronLearner(NeuralNetLearner): + + def predict(self, example): + return sum([]) +#______________________________________________________________________________ + +class Linearlearner(Learner): + """Fit a linear model to the data.""" + + NotImplemented +#______________________________________________________________________________ + +class EnsembleLearner(Learner): + """Given a list of learning algorithms, have them vote.""" + + def __init__(self, learners=[]): + self.learners=learners + + def train(self, dataset): + for learner in self.learners: + learner.train(dataset) + + def predict(self, example): + return mode([learner.predict(example) for learner in self.learners]) + +#_____________________________________________________________________________ +# Functions for testing learners on examples + +def test(learner, dataset, examples=None, verbose=0): + """Return the proportion of the examples that are correctly predicted. + Assumes the learner has already been trained.""" + if examples == None: examples = dataset.examples + if len(examples) == 0: return 0.0 + right = 0.0 + for example in examples: + desired = example[dataset.target] + output = learner.predict(dataset.sanitize(example)) + if output == desired: + right += 1 + if verbose >= 2: + print ' OK: got %s for %s' % (desired, example) + elif verbose: + print 'WRONG: got %s, expected %s for %s' % ( + output, desired, example) + return right / len(examples) + +def train_and_test(learner, dataset, start, end): + """Reserve dataset.examples[start:end] for test; train on the remainder. + Return the proportion of examples correct on the test examples.""" + examples = dataset.examples + try: + dataset.examples = examples[:start] + examples[end:] + learner.dataset = dataset + learner.train(dataset) + return test(learner, dataset, examples[start:end]) + finally: + dataset.examples = examples + +def cross_validation(learner, dataset, k=10, trials=1): + """Do k-fold cross_validate and return their mean. + That is, keep out 1/k of the examples for testing on each of k runs. + Shuffle the examples first; If trials>1, average over several shuffles.""" + if k == None: + k = len(dataset.examples) + if trials > 1: + return mean([cross_validation(learner, dataset, k, trials=1) + for t in range(trials)]) + else: + n = len(dataset.examples) + random.shuffle(dataset.examples) + return mean([train_and_test(learner, dataset, i*(n/k), (i+1)*(n/k)) + for i in range(k)]) + +def leave1out(learner, dataset): + "Leave one out cross-validation over the dataset." + return cross_validation(learner, dataset, k=len(dataset.examples)) + +def learningcurve(learner, dataset, trials=10, sizes=None): + if sizes == None: + sizes = range(2, len(dataset.examples)-10, 2) + def score(learner, size): + random.shuffle(dataset.examples) + return train_and_test(learner, dataset, 0, size) + return [(size, mean([score(learner, size) for t in range(trials)])) + for size in sizes] + +#______________________________________________________________________________ +# The rest of this file gives Data sets for machine learning problems. + +orings = DataSet(name='orings', target='Distressed', + attrnames="Rings Distressed Temp Pressure Flightnum") + + +zoo = DataSet(name='zoo', target='type', exclude=['name'], + attrnames="name hair feathers eggs milk airborne aquatic " + + "predator toothed backbone breathes venomous fins legs tail " + + "domestic catsize type") + + +iris = DataSet(name="iris", target="class", + attrnames="sepal-len sepal-width petal-len petal-width class") + +#______________________________________________________________________________ +# The Restaurant example from Fig. 18.2 + +def RestaurantDataSet(examples=None): + "Build a DataSet of Restaurant waiting examples." + return DataSet(name='restaurant', target='Wait', examples=examples, + attrnames='Alternate Bar Fri/Sat Hungry Patrons Price ' + + 'Raining Reservation Type WaitEstimate Wait') + +restaurant = RestaurantDataSet() + +def T(attrname, branches): + return DecisionTree(restaurant.attrnum(attrname), attrname, branches) + +Fig[18,2] = T('Patrons', + {'None': 'No', 'Some': 'Yes', 'Full': + T('WaitEstimate', + {'>60': 'No', '0-10': 'Yes', + '30-60': + T('Alternate', {'No': + T('Reservation', {'Yes': 'Yes', 'No': + T('Bar', {'No':'No', + 'Yes':'Yes'})}), + 'Yes': + T('Fri/Sat', {'No': 'No', 'Yes': 'Yes'})}), + '10-30': + T('Hungry', {'No': 'Yes', 'Yes': + T('Alternate', + {'No': 'Yes', 'Yes': + T('Raining', {'No': 'No', 'Yes': 'Yes'})})})})}) + +def SyntheticRestaurant(n=20): + "Generate a DataSet with n examples." + def gen(): + example = map(random.choice, restaurant.values) + example[restaurant.target] = Fig[18,2].predict(example) + return example + return RestaurantDataSet([gen() for i in range(n)]) + +#______________________________________________________________________________ +# Artificial, generated examples. + +def Majority(k, n): + """Return a DataSet with n k-bit examples of the majority problem: + k random bits followed by a 1 if more than half the bits are 1, else 0.""" + examples = [] + for i in range(n): + bits = [random.choice([0, 1]) for i in range(k)] + bits.append(sum(bits) > k/2) + examples.append(bits) + return DataSet(name="majority", examples=examples) + +def Parity(k, n, name="parity"): + """Return a DataSet with n k-bit examples of the parity problem: + k random bits followed by a 1 if an odd number of bits are 1, else 0.""" + examples = [] + for i in range(n): + bits = [random.choice([0, 1]) for i in range(k)] + bits.append(sum(bits) % 2) + examples.append(bits) + return DataSet(name=name, examples=examples) + +def Xor(n): + """Return a DataSet with n examples of 2-input xor.""" + return Parity(2, n, name="xor") + +def ContinuousXor(n): + "2 inputs are chosen uniformly form (0.0 .. 2.0]; output is xor of ints." + examples = [] + for i in range(n): + x, y = [random.uniform(0.0, 2.0) for i in '12'] + examples.append([x, y, int(x) != int(y)]) + return DataSet(name="continuous xor", examples=examples) + +#______________________________________________________________________________ + +def compare(algorithms=[MajorityLearner, NaiveBayesLearner, + NearestNeighborLearner, DecisionTreeLearner], + datasets=[iris, orings, zoo, restaurant, SyntheticRestaurant(20), + Majority(7, 100), Parity(7, 100), Xor(100)], + k=10, trials=1): + """Compare various learners on various datasets using cross-validation. + Print results as a table.""" + print_table([[a.__name__.replace('Learner','')] + + [cross_validation(a(), d, k, trials) for d in datasets] + for a in algorithms], + header=[''] + [d.name[0:7] for d in datasets], round=2) + diff --git a/csp/aima/logic.py b/csp/aima/logic.py new file mode 100644 index 00000000..1c89a96b --- /dev/null +++ b/csp/aima/logic.py @@ -0,0 +1,888 @@ +"""Representations and Inference for Logic (Chapters 7-10) + +Covers both Propositional and First-Order Logic. First we have four +important data types: + + KB Abstract class holds a knowledge base of logical expressions + KB_Agent Abstract class subclasses agents.Agent + Expr A logical expression + substitution Implemented as a dictionary of var:value pairs, {x:1, y:x} + +Be careful: some functions take an Expr as argument, and some take a KB. +Then we implement various functions for doing logical inference: + + pl_true Evaluate a propositional logical sentence in a model + tt_entails Say if a statement is entailed by a KB + pl_resolution Do resolution on propositional sentences + dpll_satisfiable See if a propositional sentence is satisfiable + WalkSAT (not yet implemented) + +And a few other functions: + + to_cnf Convert to conjunctive normal form + unify Do unification of two FOL sentences + diff, simp Symbolic differentiation and simplification +""" + +from __future__ import generators +import re +import agents +from utils import * + +#______________________________________________________________________________ + +class KB: + """A Knowledge base to which you can tell and ask sentences. + To create a KB, first subclass this class and implement + tell, ask_generator, and retract. Why ask_generator instead of ask? + The book is a bit vague on what ask means -- + For a Propositional Logic KB, ask(P & Q) returns True or False, but for an + FOL KB, something like ask(Brother(x, y)) might return many substitutions + such as {x: Cain, y: Able}, {x: Able, y: Cain}, {x: George, y: Jeb}, etc. + So ask_generator generates these one at a time, and ask either returns the + first one or returns False.""" + + def __init__(self, sentence=None): + abstract + + def tell(self, sentence): + "Add the sentence to the KB" + abstract + + def ask(self, query): + """Ask returns a substitution that makes the query true, or + it returns False. It is implemented in terms of ask_generator.""" + try: + return self.ask_generator(query).next() + except StopIteration: + return False + + def ask_generator(self, query): + "Yield all the substitutions that make query true." + abstract + + def retract(self, sentence): + "Remove the sentence from the KB" + abstract + + +class PropKB(KB): + "A KB for Propositional Logic. Inefficient, with no indexing." + + def __init__(self, sentence=None): + self.clauses = [] + if sentence: + self.tell(sentence) + + def tell(self, sentence): + "Add the sentence's clauses to the KB" + self.clauses.extend(conjuncts(to_cnf(sentence))) + + def ask_generator(self, query): + "Yield the empty substitution if KB implies query; else False" + if not tt_entails(Expr('&', *self.clauses), query): + return + yield {} + + def retract(self, sentence): + "Remove the sentence's clauses from the KB" + for c in conjuncts(to_cnf(sentence)): + if c in self.clauses: + self.clauses.remove(c) + +#______________________________________________________________________________ + +class KB_Agent(agents.Agent): + """A generic logical knowledge-based agent. [Fig. 7.1]""" + def __init__(self, KB): + t = 0 + def program(percept): + KB.tell(self.make_percept_sentence(percept, t)) + action = KB.ask(self.make_action_query(t)) + KB.tell(self.make_action_sentence(action, t)) + t = t + 1 + return action + self.program = program + + def make_percept_sentence(self, percept, t): + return(Expr("Percept")(percept, t)) + + def make_action_query(self, t): + return(expr("ShouldDo(action, %d)" % t)) + + def make_action_sentence(self, action, t): + return(Expr("Did")(action, t)) + +#______________________________________________________________________________ + +class Expr: + """A symbolic mathematical expression. We use this class for logical + expressions, and for terms within logical expressions. In general, an + Expr has an op (operator) and a list of args. The op can be: + Null-ary (no args) op: + A number, representing the number itself. (e.g. Expr(42) => 42) + A symbol, representing a variable or constant (e.g. Expr('F') => F) + Unary (1 arg) op: + '~', '-', representing NOT, negation (e.g. Expr('~', Expr('P')) => ~P) + Binary (2 arg) op: + '>>', '<<', representing forward and backward implication + '+', '-', '*', '/', '**', representing arithmetic operators + '<', '>', '>=', '<=', representing comparison operators + '<=>', '^', representing logical equality and XOR + N-ary (0 or more args) op: + '&', '|', representing conjunction and disjunction + A symbol, representing a function term or FOL proposition + + Exprs can be constructed with operator overloading: if x and y are Exprs, + then so are x + y and x & y, etc. Also, if F and x are Exprs, then so is + F(x); it works by overloading the __call__ method of the Expr F. Note + that in the Expr that is created by F(x), the op is the str 'F', not the + Expr F. See http://www.python.org/doc/current/ref/specialnames.html + to learn more about operator overloading in Python. + + WARNING: x == y and x != y are NOT Exprs. The reason is that we want + to write code that tests 'if x == y:' and if x == y were the same + as Expr('==', x, y), then the result would always be true; not what a + programmer would expect. But we still need to form Exprs representing + equalities and disequalities. We concentrate on logical equality (or + equivalence) and logical disequality (or XOR). You have 3 choices: + (1) Expr('<=>', x, y) and Expr('^', x, y) + Note that ^ is bitwose XOR in Python (and Java and C++) + (2) expr('x <=> y') and expr('x =/= y'). + See the doc string for the function expr. + (3) (x % y) and (x ^ y). + It is very ugly to have (x % y) mean (x <=> y), but we need + SOME operator to make (2) work, and this seems the best choice. + + WARNING: if x is an Expr, then so is x + 1, because the int 1 gets + coerced to an Expr by the constructor. But 1 + x is an error, because + 1 doesn't know how to add an Expr. (Adding an __radd__ method to Expr + wouldn't help, because int.__add__ is still called first.) Therefore, + you should use Expr(1) + x instead, or ONE + x, or expr('1 + x'). + """ + + def __init__(self, op, *args): + "Op is a string or number; args are Exprs (or are coerced to Exprs)." + assert isinstance(op, str) or (isnumber(op) and not args) + self.op = num_or_str(op) + self.args = map(expr, args) ## Coerce args to Exprs + + def __call__(self, *args): + """Self must be a symbol with no args, such as Expr('F'). Create a new + Expr with 'F' as op and the args as arguments.""" + assert is_symbol(self.op) and not self.args + return Expr(self.op, *args) + + def __repr__(self): + "Show something like 'P' or 'P(x, y)', or '~P' or '(P | Q | R)'" + if len(self.args) == 0: # Constant or proposition with arity 0 + return str(self.op) + elif is_symbol(self.op): # Functional or Propositional operator + return '%s(%s)' % (self.op, ', '.join(map(repr, self.args))) + elif len(self.args) == 1: # Prefix operator + return self.op + repr(self.args[0]) + else: # Infix operator + return '(%s)' % (' '+self.op+' ').join(map(repr, self.args)) + + def __eq__(self, other): + """x and y are equal iff their ops and args are equal.""" + return (other is self) or (isinstance(other, Expr) + and self.op == other.op and self.args == other.args) + + def __hash__(self): + "Need a hash method so Exprs can live in dicts." + return hash(self.op) ^ hash(tuple(self.args)) + + # See http://www.python.org/doc/current/lib/module-operator.html + # Not implemented: not, abs, pos, concat, contains, *item, *slice + def __lt__(self, other): return Expr('<', self, other) + def __le__(self, other): return Expr('<=', self, other) + def __ge__(self, other): return Expr('>=', self, other) + def __gt__(self, other): return Expr('>', self, other) + def __add__(self, other): return Expr('+', self, other) + def __sub__(self, other): return Expr('-', self, other) + def __and__(self, other): return Expr('&', self, other) + def __div__(self, other): return Expr('/', self, other) + def __truediv__(self, other):return Expr('/', self, other) + def __invert__(self): return Expr('~', self) + def __lshift__(self, other): return Expr('<<', self, other) + def __rshift__(self, other): return Expr('>>', self, other) + def __mul__(self, other): return Expr('*', self, other) + def __neg__(self): return Expr('-', self) + def __or__(self, other): return Expr('|', self, other) + def __pow__(self, other): return Expr('**', self, other) + def __xor__(self, other): return Expr('^', self, other) + def __mod__(self, other): return Expr('<=>', self, other) ## (x % y) + + + +def expr(s): + """Create an Expr representing a logic expression by parsing the input + string. Symbols and numbers are automatically converted to Exprs. + In addition you can use alternative spellings of these operators: + 'x ==> y' parses as (x >> y) # Implication + 'x <== y' parses as (x << y) # Reverse implication + 'x <=> y' parses as (x % y) # Logical equivalence + 'x =/= y' parses as (x ^ y) # Logical disequality (xor) + But BE CAREFUL; precedence of implication is wrong. expr('P & Q ==> R & S') + is ((P & (Q >> R)) & S); so you must use expr('(P & Q) ==> (R & S)'). + >>> expr('P <=> Q(1)') + (P <=> Q(1)) + >>> expr('P & Q | ~R(x, F(x))') + ((P & Q) | ~R(x, F(x))) + """ + if isinstance(s, Expr): return s + if isnumber(s): return Expr(s) + ## Replace the alternative spellings of operators with canonical spellings + s = s.replace('==>', '>>').replace('<==', '<<') + s = s.replace('<=>', '%').replace('=/=', '^') + ## Replace a symbol or number, such as 'P' with 'Expr("P")' + s = re.sub(r'([a-zA-Z0-9_.]+)', r'Expr("\1")', s) + ## Now eval the string. (A security hole; do not use with an adversary.) + return eval(s, {'Expr':Expr}) + +def is_symbol(s): + "A string s is a symbol if it starts with an alphabetic char." + return isinstance(s, str) and s[0].isalpha() + +def is_var_symbol(s): + "A logic variable symbol is an initial-lowercase string." + return is_symbol(s) and s[0].islower() + +def is_prop_symbol(s): + """A proposition logic symbol is an initial-uppercase string other than + TRUE or FALSE.""" + return is_symbol(s) and s[0].isupper() and s != 'TRUE' and s != 'FALSE' + + +## Useful constant Exprs used in examples and code: +TRUE, FALSE, ZERO, ONE, TWO = map(Expr, ['TRUE', 'FALSE', 0, 1, 2]) +A, B, C, F, G, P, Q, x, y, z = map(Expr, 'ABCFGPQxyz') + +#______________________________________________________________________________ + +def tt_entails(kb, alpha): + """Use truth tables to determine if KB entails sentence alpha. [Fig. 7.10] + >>> tt_entails(expr('P & Q'), expr('Q')) + True + """ + return tt_check_all(kb, alpha, prop_symbols(kb & alpha), {}) + +def tt_check_all(kb, alpha, symbols, model): + "Auxiliary routine to implement tt_entails." + if not symbols: + if pl_true(kb, model): return pl_true(alpha, model) + else: return True + assert result != None + else: + P, rest = symbols[0], symbols[1:] + return (tt_check_all(kb, alpha, rest, extend(model, P, True)) and + tt_check_all(kb, alpha, rest, extend(model, P, False))) + +def prop_symbols(x): + "Return a list of all propositional symbols in x." + if not isinstance(x, Expr): + return [] + elif is_prop_symbol(x.op): + return [x] + else: + s = set(()) + for arg in x.args: + for symbol in prop_symbols(arg): + s.add(symbol) + return list(s) + +def tt_true(alpha): + """Is the sentence alpha a tautology? (alpha will be coerced to an expr.) + >>> tt_true(expr("(P >> Q) <=> (~P | Q)")) + True + """ + return tt_entails(TRUE, expr(alpha)) + +def pl_true(exp, model={}): + """Return True if the propositional logic expression is true in the model, + and False if it is false. If the model does not specify the value for + every proposition, this may return None to indicate 'not obvious'; + this may happen even when the expression is tautological.""" + op, args = exp.op, exp.args + if exp == TRUE: + return True + elif exp == FALSE: + return False + elif is_prop_symbol(op): + return model.get(exp) + elif op == '~': + p = pl_true(args[0], model) + if p == None: return None + else: return not p + elif op == '|': + result = False + for arg in args: + p = pl_true(arg, model) + if p == True: return True + if p == None: result = None + return result + elif op == '&': + result = True + for arg in args: + p = pl_true(arg, model) + if p == False: return False + if p == None: result = None + return result + p, q = args + if op == '>>': + return pl_true(~p | q, model) + elif op == '<<': + return pl_true(p | ~q, model) + pt = pl_true(p, model) + if pt == None: return None + qt = pl_true(q, model) + if qt == None: return None + if op == '<=>': + return pt == qt + elif op == '^': + return pt != qt + else: + raise ValueError, "illegal operator in logic expression" + str(exp) + +#______________________________________________________________________________ + +## Convert to Conjunctive Normal Form (CNF) + +def to_cnf(s): + """Convert a propositional logical sentence s to conjunctive normal form. + That is, of the form ((A | ~B | ...) & (B | C | ...) & ...) [p. 215] + >>> to_cnf("~(B|C)") + (~B & ~C) + >>> to_cnf("B <=> (P1|P2)") + ((~P1 | B) & (~P2 | B) & (P1 | P2 | ~B)) + >>> to_cnf("a | (b & c) | d") + ((b | a | d) & (c | a | d)) + >>> to_cnf("A & (B | (D & E))") + (A & (D | B) & (E | B)) + """ + if isinstance(s, str): s = expr(s) + s = eliminate_implications(s) # Steps 1, 2 from p. 215 + s = move_not_inwards(s) # Step 3 + return distribute_and_over_or(s) # Step 4 + +def eliminate_implications(s): + """Change >>, <<, and <=> into &, |, and ~. That is, return an Expr + that is equivalent to s, but has only &, |, and ~ as logical operators. + >>> eliminate_implications(A >> (~B << C)) + ((~B | ~C) | ~A) + """ + if not s.args or is_symbol(s.op): return s ## (Atoms are unchanged.) + args = map(eliminate_implications, s.args) + a, b = args[0], args[-1] + if s.op == '>>': + return (b | ~a) + elif s.op == '<<': + return (a | ~b) + elif s.op == '<=>': + return (a | ~b) & (b | ~a) + else: + return Expr(s.op, *args) + +def move_not_inwards(s): + """Rewrite sentence s by moving negation sign inward. + >>> move_not_inwards(~(A | B)) + (~A & ~B) + >>> move_not_inwards(~(A & B)) + (~A | ~B) + >>> move_not_inwards(~(~(A | ~B) | ~~C)) + ((A | ~B) & ~C) + """ + if s.op == '~': + NOT = lambda b: move_not_inwards(~b) + a = s.args[0] + if a.op == '~': return move_not_inwards(a.args[0]) # ~~A ==> A + if a.op =='&': return NaryExpr('|', *map(NOT, a.args)) + if a.op =='|': return NaryExpr('&', *map(NOT, a.args)) + return s + elif is_symbol(s.op) or not s.args: + return s + else: + return Expr(s.op, *map(move_not_inwards, s.args)) + +def distribute_and_over_or(s): + """Given a sentence s consisting of conjunctions and disjunctions + of literals, return an equivalent sentence in CNF. + >>> distribute_and_over_or((A & B) | C) + ((A | C) & (B | C)) + """ + if s.op == '|': + s = NaryExpr('|', *s.args) + if len(s.args) == 0: + return FALSE + if len(s.args) == 1: + return distribute_and_over_or(s.args[0]) + conj = find_if((lambda d: d.op == '&'), s.args) + if not conj: + return NaryExpr(s.op, *s.args) + others = [a for a in s.args if a is not conj] + if len(others) == 1: + rest = others[0] + else: + rest = NaryExpr('|', *others) + return NaryExpr('&', *map(distribute_and_over_or, + [(c|rest) for c in conj.args])) + elif s.op == '&': + return NaryExpr('&', *map(distribute_and_over_or, s.args)) + else: + return s + +_NaryExprTable = {'&':TRUE, '|':FALSE, '+':ZERO, '*':ONE} + +def NaryExpr(op, *args): + """Create an Expr, but with an nary, associative op, so we can promote + nested instances of the same op up to the top level. + >>> NaryExpr('&', (A&B),(B|C),(B&C)) + (A & B & (B | C) & B & C) + """ + arglist = [] + for arg in args: + if arg.op == op: arglist.extend(arg.args) + else: arglist.append(arg) + if len(args) == 1: + return args[0] + elif len(args) == 0: + return _NaryExprTable[op] + else: + return Expr(op, *arglist) + +def conjuncts(s): + """Return a list of the conjuncts in the sentence s. + >>> conjuncts(A & B) + [A, B] + >>> conjuncts(A | B) + [(A | B)] + """ + if isinstance(s, Expr) and s.op == '&': + return s.args + else: + return [s] + +def disjuncts(s): + """Return a list of the disjuncts in the sentence s. + >>> disjuncts(A | B) + [A, B] + >>> disjuncts(A & B) + [(A & B)] + """ + if isinstance(s, Expr) and s.op == '|': + return s.args + else: + return [s] + +#______________________________________________________________________________ + +def pl_resolution(KB, alpha): + "Propositional Logic Resolution: say if alpha follows from KB. [Fig. 7.12]" + clauses = KB.clauses + conjuncts(to_cnf(~alpha)) + new = set() + while True: + n = len(clauses) + pairs = [(clauses[i], clauses[j]) for i in range(n) for j in range(i+1, n)] + for (ci, cj) in pairs: + resolvents = pl_resolve(ci, cj) + if FALSE in resolvents: return True + new.union_update(set(resolvents)) + if new.issubset(set(clauses)): return False + for c in new: + if c not in clauses: clauses.append(c) + +def pl_resolve(ci, cj): + """Return all clauses that can be obtained by resolving clauses ci and cj. + >>> pl_resolve(to_cnf(A|B|C), to_cnf(~B|~C|F)) + [(A | C | ~C | F), (A | B | ~B | F)] + """ + clauses = [] + for di in disjuncts(ci): + for dj in disjuncts(cj): + if di == ~dj or ~di == dj: + dnew = unique(removeall(di, disjuncts(ci)) + + removeall(dj, disjuncts(cj))) + clauses.append(NaryExpr('|', *dnew)) + return clauses + +#______________________________________________________________________________ + +class PropHornKB(PropKB): + "A KB of Propositional Horn clauses." + + def tell(self, sentence): + "Add a Horn Clauses to this KB." + op = sentence.op + assert op == '>>' or is_prop_symbol(op), "Must be Horn Clause" + self.clauses.append(sentence) + + def ask_generator(self, query): + "Yield the empty substitution if KB implies query; else False" + if not pl_fc_entails(self.clauses, query): + return + yield {} + + def retract(self, sentence): + "Remove the sentence's clauses from the KB" + for c in conjuncts(to_cnf(sentence)): + if c in self.clauses: + self.clauses.remove(c) + + def clauses_with_premise(self, p): + """The list of clauses in KB that have p in the premise. + This could be cached away for O(1) speed, but we'll recompute it.""" + return [c for c in self.clauses + if c.op == '>>' and p in conjuncts(c.args[0])] + +def pl_fc_entails(KB, q): + """Use forward chaining to see if a HornKB entails symbol q. [Fig. 7.14] + >>> pl_fc_entails(Fig[7,15], expr('Q')) + True + """ + count = dict([(c, len(conjuncts(c.args[0]))) for c in KB.clauses + if c.op == '>>']) + inferred = DefaultDict(False) + agenda = [s for s in KB.clauses if is_prop_symbol(s.op)] + if q in agenda: return True + while agenda: + p = agenda.pop() + if not inferred[p]: + inferred[p] = True + for c in KB.clauses_with_premise(p): + count[c] -= 1 + if count[c] == 0: + if c.args[1] == q: return True + agenda.append(c.args[1]) + return False + +## Wumpus World example [Fig. 7.13] +Fig[7,13] = expr("(B11 <=> (P12 | P21)) & ~B11") + +## Propositional Logic Forward Chanining example [Fig. 7.15] +Fig[7,15] = PropHornKB() +for s in "P>>Q (L&M)>>P (B&L)>>M (A&P)>>L (A&B)>>L A B".split(): + Fig[7,15].tell(expr(s)) + +#______________________________________________________________________________ + +# DPLL-Satisfiable [Fig. 7.16] + +def dpll_satisfiable(s): + """Check satisfiability of a propositional sentence. + This differs from the book code in two ways: (1) it returns a model + rather than True when it succeeds; this is more useful. (2) The + function find_pure_symbol is passed a list of unknown clauses, rather + than a list of all clauses and the model; this is more efficient. + >>> dpll_satisfiable(A&~B) + {A: True, B: False} + >>> dpll_satisfiable(P&~P) + False + """ + clauses = conjuncts(to_cnf(s)) + symbols = prop_symbols(s) + return dpll(clauses, symbols, {}) + +def dpll(clauses, symbols, model): + "See if the clauses are true in a partial model." + unknown_clauses = [] ## clauses with an unknown truth value + for c in clauses: + val = pl_true(c, model) + if val == False: + return False + if val != True: + unknown_clauses.append(c) + if not unknown_clauses: + return model + P, value = find_pure_symbol(symbols, unknown_clauses) + if P: + return dpll(clauses, removeall(P, symbols), extend(model, P, value)) + P, value = find_unit_clause(clauses, model) + if P: + return dpll(clauses, removeall(P, symbols), extend(model, P, value)) + P = symbols.pop() + return (dpll(clauses, symbols, extend(model, P, True)) or + dpll(clauses, symbols, extend(model, P, False))) + +def find_pure_symbol(symbols, unknown_clauses): + """Find a symbol and its value if it appears only as a positive literal + (or only as a negative) in clauses. + >>> find_pure_symbol([A, B, C], [A|~B,~B|~C,C|A]) + (A, True) + """ + for s in symbols: + found_pos, found_neg = False, False + for c in unknown_clauses: + if not found_pos and s in disjuncts(c): found_pos = True + if not found_neg and ~s in disjuncts(c): found_neg = True + if found_pos != found_neg: return s, found_pos + return None, None + +def find_unit_clause(clauses, model): + """A unit clause has only 1 variable that is not bound in the model. + >>> find_unit_clause([A|B|C, B|~C, A|~B], {A:True}) + (B, False) + """ + for clause in clauses: + num_not_in_model = 0 + for literal in disjuncts(clause): + sym = literal_symbol(literal) + if sym not in model: + num_not_in_model += 1 + P, value = sym, (literal.op != '~') + if num_not_in_model == 1: + return P, value + return None, None + + +def literal_symbol(literal): + """The symbol in this literal (without the negation). + >>> literal_symbol(P) + P + >>> literal_symbol(~P) + P + """ + if literal.op == '~': + return literal.args[0] + else: + return literal + + +#______________________________________________________________________________ +# Walk-SAT [Fig. 7.17] + +def WalkSAT(clauses, p=0.5, max_flips=10000): + ## model is a random assignment of true/false to the symbols in clauses + ## See ~/aima1e/print1/manual/knowledge+logic-answers.tex ??? + model = dict([(s, random.choice([True, False])) + for s in prop_symbols(clauses)]) + for i in range(max_flips): + satisfied, unsatisfied = [], [] + for clause in clauses: + if_(pl_true(clause, model), satisfied, unsatisfied).append(clause) + if not unsatisfied: ## if model satisfies all the clauses + return model + clause = random.choice(unsatisfied) + if probability(p): + sym = random.choice(prop_symbols(clause)) + else: + ## Flip the symbol in clause that miximizes number of sat. clauses + raise NotImplementedError + model[sym] = not model[sym] + + +# PL-Wumpus-Agent [Fig. 7.19] +class PLWumpusAgent(agents.Agent): + "An agent for the wumpus world that does logical inference. [Fig. 7.19]""" + def __init__(self): + KB = FOLKB() + x, y, orientation = 1, 1, (1, 0) + visited = set() ## squares already visited + action = None + plan = [] + + def program(percept): + stench, breeze, glitter = percept + x, y, orientation = update_position(x, y, orientation, action) + KB.tell('%sS_%d,%d' % (if_(stench, '', '~'), x, y)) + KB.tell('%sB_%d,%d' % (if_(breeze, '', '~'), x, y)) + if glitter: action = 'Grab' + elif plan: action = plan.pop() + else: + for [i, j] in fringe(visited): + if KB.ask('~P_%d,%d & ~W_%d,%d' % (i, j, i, j)) != False: + raise NotImplementedError + KB.ask('~P_%d,%d | ~W_%d,%d' % (i, j, i, j)) != False + if action == None: + action = random.choice(['Forward', 'Right', 'Left']) + return action + + self.program = program + +def update_position(x, y, orientation, action): + if action == 'TurnRight': + orientation = turn_right(orientation) + elif action == 'TurnLeft': + orientation = turn_left(orientation) + elif action == 'Forward': + x, y = x + vector_add((x, y), orientation) + return x, y, orientation + +#______________________________________________________________________________ + +def unify(x, y, s): + """Unify expressions x,y with substitution s; return a substitution that + would make x,y equal, or None if x,y can not unify. x and y can be + variables (e.g. Expr('x')), constants, lists, or Exprs. [Fig. 9.1] + >>> unify(x + y, y + C, {}) + {y: C, x: y} + """ + if s == None: + return None + elif x == y: + return s + elif is_variable(x): + return unify_var(x, y, s) + elif is_variable(y): + return unify_var(y, x, s) + elif isinstance(x, Expr) and isinstance(y, Expr): + return unify(x.args, y.args, unify(x.op, y.op, s)) + elif isinstance(x, str) or isinstance(y, str) or not x or not y: + return if_(x == y, s, None) + elif issequence(x) and issequence(y) and len(x) == len(y): + return unify(x[1:], y[1:], unify(x[0], y[0], s)) + else: + return None + +def is_variable(x): + "A variable is an Expr with no args and a lowercase symbol as the op." + return isinstance(x, Expr) and not x.args and is_var_symbol(x.op) + +def unify_var(var, x, s): + if var in s: + return unify(s[var], x, s) + elif occur_check(var, x): + return None + else: + return extend(s, var, x) + +def occur_check(var, x): + "Return true if var occurs anywhere in x." + if var == x: + return True + elif isinstance(x, Expr): + return var.op == x.op or occur_check(var, x.args) + elif not isinstance(x, str) and issequence(x): + for xi in x: + if occur_check(var, xi): return True + return False + +def extend(s, var, val): + """Copy the substitution s and extend it by setting var to val; return copy. + >>> extend({x: 1}, y, 2) + {y: 2, x: 1} + """ + s2 = s.copy() + s2[var] = val + return s2 + +def subst(s, x): + """Substitute the substitution s into the expression x. + >>> subst({x: 42, y:0}, F(x) + y) + (F(42) + 0) + """ + if isinstance(x, list): + return [subst(s, xi) for xi in x] + elif isinstance(x, tuple): + return tuple([subst(s, xi) for xi in x]) + elif not isinstance(x, Expr): + return x + elif is_var_symbol(x.op): + return s.get(x, x) + else: + return Expr(x.op, *[subst(s, arg) for arg in x.args]) + +def fol_fc_ask(KB, alpha): + """Inefficient forward chaining for first-order logic. [Fig. 9.3] + KB is an FOLHornKB and alpha must be an atomic sentence.""" + while True: + new = {} + for r in KB.clauses: + r1 = standardize_apart(r) + ps, q = conjuncts(r.args[0]), r.args[1] + raise NotImplementedError + +def standardize_apart(sentence, dic): + """Replace all the variables in sentence with new variables.""" + if not isinstance(sentence, Expr): + return sentence + elif is_var_symbol(sentence.op): + if sentence in dic: + return dic[sentence] + else: + standardize_apart.counter += 1 + dic[sentence] = Expr('V_%d' % standardize-apart.counter) + return dic[sentence] + else: + return Expr(sentence.op, *[standardize-apart(a, dic) for a in sentence.args]) + +standardize_apart.counter = 0 + +def fol_bc_ask(KB, goals, theta): + "A simple backward-chaining algorithm for first-order logic. [Fig. 9.6]" + if not goals: + yield theta + q1 = subst(theta, goals[0]) + raise NotImplementedError + +#______________________________________________________________________________ + +# Example application (not in the book). +# You can use the Expr class to do symbolic differentiation. This used to be +# a part of AI; now it is considered a separate field, Symbolic Algebra. + +def diff(y, x): + """Return the symbolic derivative, dy/dx, as an Expr. + However, you probably want to simplify the results with simp. + >>> diff(x * x, x) + ((x * 1) + (x * 1)) + >>> simp(diff(x * x, x)) + (2 * x) + """ + if y == x: return ONE + elif not y.args: return ZERO + else: + u, op, v = y.args[0], y.op, y.args[-1] + if op == '+': return diff(u, x) + diff(v, x) + elif op == '-' and len(args) == 1: return -diff(u, x) + elif op == '-': return diff(u, x) - diff(v, x) + elif op == '*': return u * diff(v, x) + v * diff(u, x) + elif op == '/': return (v*diff(u, x) - u*diff(v, x)) / (v * v) + elif op == '**' and isnumber(x.op): + return (v * u ** (v - 1) * diff(u, x)) + elif op == '**': return (v * u ** (v - 1) * diff(u, x) + + u ** v * Expr('log')(u) * diff(v, x)) + elif op == 'log': return diff(u, x) / u + else: raise ValueError("Unknown op: %s in diff(%s, %s)" % (op, y, x)) + +def simp(x): + if not x.args: return x + args = map(simp, x.args) + u, op, v = args[0], x.op, args[-1] + if op == '+': + if v == ZERO: return u + if u == ZERO: return v + if u == v: return TWO * u + if u == -v or v == -u: return ZERO + elif op == '-' and len(args) == 1: + if u.op == '-' and len(u.args) == 1: return u.args[0] ## --y ==> y + elif op == '-': + if v == ZERO: return u + if u == ZERO: return -v + if u == v: return ZERO + if u == -v or v == -u: return ZERO + elif op == '*': + if u == ZERO or v == ZERO: return ZERO + if u == ONE: return v + if v == ONE: return u + if u == v: return u ** 2 + elif op == '/': + if u == ZERO: return ZERO + if v == ZERO: return Expr('Undefined') + if u == v: return ONE + if u == -v or v == -u: return ZERO + elif op == '**': + if u == ZERO: return ZERO + if v == ZERO: return ONE + if u == ONE: return ONE + if v == ONE: return u + elif op == 'log': + if u == ONE: return ZERO + else: raise ValueError("Unknown op: " + op) + ## If we fall through to here, we can not simplify further + return Expr(op, *args) + +def d(y, x): + "Differentiate and then simplify." + return simp(diff(y, x)) + diff --git a/csp/aima/logic.txt b/csp/aima/logic.txt new file mode 100644 index 00000000..18b2d856 --- /dev/null +++ b/csp/aima/logic.txt @@ -0,0 +1,78 @@ +### PropKB +>>> kb = PropKB() +>>> kb.tell(A & B) +>>> kb.tell(B >> C) +>>> kb.ask(C) ## The result {} means true, with no substitutions +{} +>>> kb.ask(P) +False +>>> kb.retract(B) +>>> kb.ask(C) +False + +>>> pl_true(P, {}) +>>> pl_true(P | Q, {P: True}) +True + +# Notice that the function pl_true cannot reason by cases: +>>> pl_true(P | ~P) + +# However, tt_true can: +>>> tt_true(P | ~P) +True + +# The following are tautologies from [Fig. 7.11]: +>>> tt_true("(A & B) <=> (B & A)") +True +>>> tt_true("(A | B) <=> (B | A)") +True +>>> tt_true("((A & B) & C) <=> (A & (B & C))") +True +>>> tt_true("((A | B) | C) <=> (A | (B | C))") +True +>>> tt_true("~~A <=> A") +True +>>> tt_true("(A >> B) <=> (~B >> ~A)") +True +>>> tt_true("(A >> B) <=> (~A | B)") +True +>>> tt_true("(A <=> B) <=> ((A >> B) & (B >> A))") +True +>>> tt_true("~(A & B) <=> (~A | ~B)") +True +>>> tt_true("~(A | B) <=> (~A & ~B)") +True +>>> tt_true("(A & (B | C)) <=> ((A & B) | (A & C))") +True +>>> tt_true("(A | (B & C)) <=> ((A | B) & (A | C))") +True + +# The following are not tautologies: +>>> tt_true(A & ~A) +False +>>> tt_true(A & B) +False + +### [Fig. 7.13] +>>> alpha = expr("~P12") +>>> to_cnf(Fig[7,13] & ~alpha) +((~P12 | B11) & (~P21 | B11) & (P12 | P21 | ~B11) & ~B11 & P12) +>>> tt_entails(Fig[7,13], alpha) +True +>>> pl_resolution(PropKB(Fig[7,13]), alpha) +True + +### [Fig. 7.15] +>>> pl_fc_entails(Fig[7,15], expr('SomethingSilly')) +False + +### Unification: +>>> unify(x, x, {}) +{} +>>> unify(x, 3, {}) +{x: 3} + + +>>> to_cnf((P&Q) | (~P & ~Q)) +((~P | P) & (~Q | P) & (~P | Q) & (~Q | Q)) + diff --git a/csp/aima/mdp.py b/csp/aima/mdp.py new file mode 100644 index 00000000..8bd410b1 --- /dev/null +++ b/csp/aima/mdp.py @@ -0,0 +1,142 @@ +"""Markov Decision Processes (Chapter 17) + +First we define an MDP, and the special case of a GridMDP, in which +states are laid out in a 2-dimensional grid. We also represent a policy +as a dictionary of {state:action} pairs, and a Utility function as a +dictionary of {state:number} pairs. We then define the value_iteration +and policy_iteration algorithms.""" + +from utils import * + +class MDP: + """A Markov Decision Process, defined by an initial state, transition model, + and reward function. We also keep track of a gamma value, for use by + algorithms. The transition model is represented somewhat differently from + the text. Instead of T(s, a, s') being probability number for each + state/action/state triplet, we instead have T(s, a) return a list of (p, s') + pairs. We also keep track of the possible states, terminal states, and + actions for each state. [page 615]""" + + def __init__(self, init, actlist, terminals, gamma=.9): + update(self, init=init, actlist=actlist, terminals=terminals, + gamma=gamma, states=set(), reward={}) + + def R(self, state): + "Return a numeric reward for this state." + return self.reward[state] + + def T(state, action): + """Transition model. From a state and an action, return a list + of (result-state, probability) pairs.""" + abstract + + def actions(self, state): + """Set of actions that can be performed in this state. By default, a + fixed list of actions, except for terminal states. Override this + method if you need to specialize by state.""" + if state in self.terminals: + return [None] + else: + return self.actlist + +class GridMDP(MDP): + """A two-dimensional grid MDP, as in [Figure 17.1]. All you have to do is + specify the grid as a list of lists of rewards; use None for an obstacle + (unreachable state). Also, you should specify the terminal states. + An action is an (x, y) unit vector; e.g. (1, 0) means move east.""" + def __init__(self, grid, terminals, init=(0, 0), gamma=.9): + grid.reverse() ## because we want row 0 on bottom, not on top + MDP.__init__(self, init, actlist=orientations, + terminals=terminals, gamma=gamma) + update(self, grid=grid, rows=len(grid), cols=len(grid[0])) + for x in range(self.cols): + for y in range(self.rows): + self.reward[x, y] = grid[y][x] + if grid[y][x] is not None: + self.states.add((x, y)) + + def T(self, state, action): + if action == None: + return [(0.0, state)] + else: + return [(0.8, self.go(state, action)), + (0.1, self.go(state, turn_right(action))), + (0.1, self.go(state, turn_left(action)))] + + def go(self, state, direction): + "Return the state that results from going in this direction." + state1 = vector_add(state, direction) + return if_(state1 in self.states, state1, state) + + def to_grid(self, mapping): + """Convert a mapping from (x, y) to v into a [[..., v, ...]] grid.""" + return list(reversed([[mapping.get((x,y), None) + for x in range(self.cols)] + for y in range(self.rows)])) + + def to_arrows(self, policy): + chars = {(1, 0):'>', (0, 1):'^', (-1, 0):'<', (0, -1):'v', None: '.'} + return self.to_grid(dict([(s, chars[a]) for (s, a) in policy.items()])) + +#______________________________________________________________________________ + +Fig[17,1] = GridMDP([[-0.04, -0.04, -0.04, +1], + [-0.04, None, -0.04, -1], + [-0.04, -0.04, -0.04, -0.04]], + terminals=[(3, 2), (3, 1)]) + +#______________________________________________________________________________ + +def value_iteration(mdp, epsilon=0.001): + "Solving an MDP by value iteration. [Fig. 17.4]" + U1 = dict([(s, 0) for s in mdp.states]) + R, T, gamma = mdp.R, mdp.T, mdp.gamma + while True: + U = U1.copy() + delta = 0 + for s in mdp.states: + U1[s] = R(s) + gamma * max([sum([p * U[s1] for (p, s1) in T(s, a)]) + for a in mdp.actions(s)]) + delta = max(delta, abs(U1[s] - U[s])) + if delta < epsilon * (1 - gamma) / gamma: + return U + +def best_policy(mdp, U): + """Given an MDP and a utility function U, determine the best policy, + as a mapping from state to action. (Equation 17.4)""" + pi = {} + for s in mdp.states: + pi[s] = argmax(mdp.actions(s), lambda a:expected_utility(a, s, U, mdp)) + return pi + +def expected_utility(a, s, U, mdp): + "The expected utility of doing a in state s, according to the MDP and U." + return sum([p * U[s1] for (p, s1) in mdp.T(s, a)]) + +#______________________________________________________________________________ + +def policy_iteration(mdp): + "Solve an MDP by policy iteration [Fig. 17.7]" + U = dict([(s, 0) for s in mdp.states]) + pi = dict([(s, random.choice(mdp.actions(s))) for s in mdp.states]) + while True: + U = policy_evaluation(pi, U, mdp) + unchanged = True + for s in mdp.states: + a = argmax(mdp.actions(s), lambda a: expected_utility(a,s,U,mdp)) + if a != pi[s]: + pi[s] = a + unchanged = False + if unchanged: + return pi + +def policy_evaluation(pi, U, mdp, k=20): + """Return an updated utility mapping U from each state in the MDP to its + utility, using an approximation (modified policy iteration).""" + R, T, gamma = mdp.R, mdp.T, mdp.gamma + for i in range(k): + for s in mdp.states: + U[s] = R(s) + gamma * sum([p * U[s] for (p, s1) in T(s, pi[s])]) + return U + + diff --git a/csp/aima/mdp.txt b/csp/aima/mdp.txt new file mode 100644 index 00000000..a12c11f7 --- /dev/null +++ b/csp/aima/mdp.txt @@ -0,0 +1,27 @@ +### demo + +>>> m = Fig[17,1] + +>>> pi = best_policy(m, value_iteration(m, .01)) + +>>> pi +{(3, 2): None, (3, 1): None, (3, 0): (-1, 0), (2, 1): (0, 1), (0, 2): (1, 0), (1, 0): (1, 0), (0, 0): (0, 1), (1, 2): (1, 0), (2, 0): (0, 1), (0, 1): (0, 1), (2, 2): (1, 0)} + +>>> m.to_arrows(pi) +[['>', '>', '>', '.'], ['^', None, '^', '.'], ['^', '>', '^', '<']] + +>>> print_table(m.to_arrows(pi)) +> > > . +^ None ^ . +^ > ^ < + +>>> value_iteration(m, .01) +{(3, 2): 1.0, (3, 1): -1.0, (3, 0): 0.12958868267972745, (0, 1): 0.39810203830605462, (0, 2): 0.50928545646220924, (1, 0): 0.25348746162470537, (0, 0): 0.29543540628363629, (1, 2): 0.64958064617168676, (2, 0): 0.34461306281476806, (2, 1): 0.48643676237737926, (2, 2): 0.79536093684710951} + +>>> policy_iteration(m) +{(3, 2): None, (3, 1): None, (3, 0): (0, -1), (2, 1): (-1, 0), (0, 2): (1, 0), (1, 0): (1, 0), (0, 0): (1, 0), (1, 2): (1, 0), (2, 0): (1, 0), (0, 1): (1, 0), (2, 2): (1, 0)} + +>>> print_table(m.to_arrows(policy_iteration(m))) +> > > . +> None < . +> > > v diff --git a/csp/aima/nlp.py b/csp/aima/nlp.py new file mode 100644 index 00000000..c7880c46 --- /dev/null +++ b/csp/aima/nlp.py @@ -0,0 +1,170 @@ +"""A chart parser and some grammars. (Chapter 22)""" + +from utils import * + +#______________________________________________________________________________ +# Grammars and Lexicons + +def Rules(**rules): + """Create a dictionary mapping symbols to alternative sequences. + >>> Rules(A = "B C | D E") + {'A': [['B', 'C'], ['D', 'E']]} + """ + for (lhs, rhs) in rules.items(): + rules[lhs] = [alt.strip().split() for alt in rhs.split('|')] + return rules + +def Lexicon(**rules): + """Create a dictionary mapping symbols to alternative words. + >>> Lexicon(Art = "the | a | an") + {'Art': ['the', 'a', 'an']} + """ + for (lhs, rhs) in rules.items(): + rules[lhs] = [word.strip() for word in rhs.split('|')] + return rules + +class Grammar: + def __init__(self, name, rules, lexicon): + "A grammar has a set of rules and a lexicon." + update(self, name=name, rules=rules, lexicon=lexicon) + self.categories = DefaultDict([]) + for lhs in lexicon: + for word in lexicon[lhs]: + self.categories[word].append(lhs) + + def rewrites_for(self, cat): + "Return a sequence of possible rhs's that cat can be rewritten as." + return self.rules.get(cat, ()) + + def isa(self, word, cat): + "Return True iff word is of category cat" + return cat in self.categories[word] + + def __repr__(self): + return '' % self.name + +E0 = Grammar('E0', + Rules( # Grammar for E_0 [Fig. 22.4] + S = 'NP VP | S Conjunction S', + NP = 'Pronoun | Noun | Article Noun | Digit Digit | NP PP | NP RelClause', + VP = 'Verb | VP NP | VP Adjective | VP PP | VP Adverb', + PP = 'Preposition NP', + RelClause = 'That VP'), + + Lexicon( # Lexicon for E_0 [Fig. 22.3] + Noun = "stench | breeze | glitter | nothing | wumpus | pit | pits | gold | east", + Verb = "is | see | smell | shoot | fell | stinks | go | grab | carry | kill | turn | feel", + Adjective = "right | left | east | south | back | smelly", + Adverb = "here | there | nearby | ahead | right | left | east | south | back", + Pronoun = "me | you | I | it", + Name = "John | Mary | Boston | Aristotle", + Article = "the | a | an", + Preposition = "to | in | on | near", + Conjunction = "and | or | but", + Digit = "0 | 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9", + That = "that" + )) + +E_ = Grammar('E_', # Trivial Grammar and lexicon for testing + Rules( + S = 'NP VP', + NP = 'Art N | Pronoun', + VP = 'V NP'), + + Lexicon( + Art = 'the | a', + N = 'man | woman | table | shoelace | saw', + Pronoun = 'I | you | it', + V = 'saw | liked | feel' + )) + +def generate_random(grammar=E_, s='S'): + """Replace each token in s by a random entry in grammar (recursively). + This is useful for testing a grammar, e.g. generate_random(E_)""" + import random + + def rewrite(tokens, into): + for token in tokens: + if token in grammar.rules: + rewrite(random.choice(grammar.rules[token]), into) + elif token in grammar.lexicon: + into.append(random.choice(grammar.lexicon[token])) + else: + into.append(token) + return into + + return ' '.join(rewrite(s.split(), [])) + +#______________________________________________________________________________ +# Chart Parsing + + +class Chart: + """Class for parsing sentences using a chart data structure. [Fig 22.7] + >>> chart = Chart(E0); + >>> len(chart.parses('the stench is in 2 2')) + 1 + """ + + def __init__(self, grammar, trace=False): + """A datastructure for parsing a string; and methods to do the parse. + self.chart[i] holds the edges that end just before the i'th word. + Edges are 5-element lists of [start, end, lhs, [found], [expects]].""" + update(self, grammar=grammar, trace=trace) + + def parses(self, words, S='S'): + """Return a list of parses; words can be a list or string.""" + if isinstance(words, str): + words = words.split() + self.parse(words, S) + # Return all the parses that span the whole input + return [[i, j, S, found, []] + for (i, j, lhs, found, expects) in self.chart[len(words)] + if lhs == S and expects == []] + + def parse(self, words, S='S'): + """Parse a list of words; according to the grammar. + Leave results in the chart.""" + self.chart = [[] for i in range(len(words)+1)] + self.add_edge([0, 0, 'S_', [], [S]]) + for i in range(len(words)): + self.scanner(i, words[i]) + return self.chart + + def add_edge(self, edge): + "Add edge to chart, and see if it extends or predicts another edge." + start, end, lhs, found, expects = edge + if edge not in self.chart[end]: + self.chart[end].append(edge) + if self.trace: + print '%10s: added %s' % (caller(2), edge) + if not expects: + self.extender(edge) + else: + self.predictor(edge) + + def scanner(self, j, word): + "For each edge expecting a word of this category here, extend the edge." + for (i, j, A, alpha, Bb) in self.chart[j]: + if Bb and self.grammar.isa(word, Bb[0]): + self.add_edge([i, j+1, A, alpha + [(Bb[0], word)], Bb[1:]]) + + def predictor(self, (i, j, A, alpha, Bb)): + "Add to chart any rules for B that could help extend this edge." + B = Bb[0] + if B in self.grammar.rules: + for rhs in self.grammar.rewrites_for(B): + self.add_edge([j, j, B, [], rhs]) + + def extender(self, edge): + "See what edges can be extended by this edge." + (j, k, B, _, _) = edge + for (i, j, A, alpha, B1b) in self.chart[j]: + if B1b and B == B1b[0]: + self.add_edge([i, k, A, alpha + [edge], B1b[1:]]) + + + +#### TODO: +#### 1. Parsing with augmentations -- requires unification, etc. +#### 2. Sequitor diff --git a/csp/aima/nlp.txt b/csp/aima/nlp.txt new file mode 100644 index 00000000..9c08a359 --- /dev/null +++ b/csp/aima/nlp.txt @@ -0,0 +1,23 @@ +>>> chart = Chart(E0) + +>>> chart.parses('the wumpus that is smelly is near 2 2') +[[0, 9, 'S', [[0, 5, 'NP', [[0, 2, 'NP', [('Article', 'the'), ('Noun', 'wumpus')], []], [2, 5, 'RelClause', [('That', 'that'), [3, 5, 'VP', [[3, 4, 'VP', [('Verb', 'is')], []], ('Adjective', 'smelly')], []]], []]], []], [5, 9, 'VP', [[5, 6, 'VP', [('Verb', 'is')], []], [6, 9, 'PP', [('Preposition', 'near'), [7, 9, 'NP', [('Digit', '2'), ('Digit', '2')], []]], []]], []]], []]] + +### There is a built-in trace facility (compare [Fig. 22.9]) +>>> Chart(E_, trace=True).parses('I feel it') + parse: added [0, 0, 'S_', [], ['S']] + predictor: added [0, 0, 'S', [], ['NP', 'VP']] + predictor: added [0, 0, 'NP', [], ['Art', 'N']] + predictor: added [0, 0, 'NP', [], ['Pronoun']] + scanner: added [0, 1, 'NP', [('Pronoun', 'I')], []] + extender: added [0, 1, 'S', [[0, 1, 'NP', [('Pronoun', 'I')], []]], ['VP']] + predictor: added [1, 1, 'VP', [], ['V', 'NP']] + scanner: added [1, 2, 'VP', [('V', 'feel')], ['NP']] + predictor: added [2, 2, 'NP', [], ['Art', 'N']] + predictor: added [2, 2, 'NP', [], ['Pronoun']] + scanner: added [2, 3, 'NP', [('Pronoun', 'it')], []] + extender: added [1, 3, 'VP', [('V', 'feel'), [2, 3, 'NP', [('Pronoun', 'it')], []]], []] + extender: added [0, 3, 'S', [[0, 1, 'NP', [('Pronoun', 'I')], []], [1, 3, 'VP', [('V', 'feel'), [2, 3, 'NP', [('Pronoun', 'it')], []]], []]], []] + extender: added [0, 3, 'S_', [[0, 3, 'S', [[0, 1, 'NP', [('Pronoun', 'I')], []], [1, 3, 'VP', [('V', 'feel'), [2, 3, 'NP', [('Pronoun', 'it')], []]], []]], []]], []] +[[0, 3, 'S', [[0, 1, 'NP', [('Pronoun', 'I')], []], [1, 3, 'VP', [('V', 'feel'), [2, 3, 'NP', [('Pronoun', 'it')], []]], []]], []]] + diff --git a/csp/aima/planning.py b/csp/aima/planning.py new file mode 100644 index 00000000..13dff603 --- /dev/null +++ b/csp/aima/planning.py @@ -0,0 +1,7 @@ +"""Planning (Chapters 11-12) +""" + +from __future__ import generators +from utils import * +import agents +import math, random, sys, time, bisect, string diff --git a/csp/aima/probability.py b/csp/aima/probability.py new file mode 100644 index 00000000..d94955c6 --- /dev/null +++ b/csp/aima/probability.py @@ -0,0 +1,171 @@ +"""Probability models. (Chapter 13-15) +""" + +from utils import * +from logic import extend +import agents +import bisect, random + +#______________________________________________________________________________ + +class DTAgent(agents.Agent): + "A decision-theoretic agent. [Fig. 13.1]" + + def __init__(self, belief_state): + agents.Agent.__init__(self) + + def program(percept): + belief_state.observe(action, percept) + program.action = argmax(belief_state.actions(), + belief_state.expected_outcome_utility) + return program.action + + program.action = None + self.program = program + +#______________________________________________________________________________ + +class ProbDist: + """A discrete probability distribution. You name the random variable + in the constructor, then assign and query probability of values. + >>> P = ProbDist('Flip'); P['H'], P['T'] = 0.5, 0.5; P['H'] + 0.5 + """ + def __init__(self, varname='?'): + update(self, prob={}, varname=varname, values=[]) + + def __getitem__(self, val): + "Given a value, return P(value)." + return self.prob[val] + + def __setitem__(self, val, p): + "Set P(val) = p" + if val not in self.values: + self.values.append(val) + self.prob[val] = p + + def normalize(self): + "Make sure the probabilities of all values sum to 1." + total = sum(self.prob.values()) + if not (1.0-epsilon < total < 1.0+epsilon): + for val in self.prob: + self.prob[val] /= total + return self + +epsilon = 0.001 + +class JointProbDist(ProbDist): + """A discrete probability distribute over a set of variables. + >>> P = JointProbDist(['X', 'Y']); P[1, 1] = 0.25 + >>> P[1, 1] + 0.25 + """ + def __init__(self, variables): + update(self, prob={}, variables=variables, vals=DefaultDict([])) + + def __getitem__(self, values): + "Given a tuple or dict of values, return P(values)." + if isinstance(values, dict): + values = tuple([values[var] for var in self.variables]) + return self.prob[values] + + def __setitem__(self, values, p): + """Set P(values) = p. Values can be a tuple or a dict; it must + have a value for each of the variables in the joint. Also keep track + of the values we have seen so far for each variable.""" + if isinstance(values, dict): + values = [values[var] for var in self.variables] + self.prob[values] = p + for var,val in zip(self.variables, values): + if val not in self.vals[var]: + self.vals[var].append(val) + + def values(self, var): + "Return the set of possible values for a variable." + return self.vals[var] + + def __repr__(self): + return "P(%s)" % self.variables + +#______________________________________________________________________________ + +def enumerate_joint_ask(X, e, P): + """Return a probability distribution over the values of the variable X, + given the {var:val} observations e, in the JointProbDist P. + Works for Boolean variables only. [Fig. 13.4]""" + Q = ProbDist(X) ## A probability distribution for X, initially empty + Y = [v for v in P.variables if v != X and v not in e] + for xi in P.values(X): + Q[xi] = enumerate_joint(Y, extend(e, X, xi), P) + return Q.normalize() + +def enumerate_joint(vars, values, P): + "As in Fig 13.4, except x and e are already incorporated in values." + if not vars: + return P[values] + Y = vars[0]; rest = vars[1:] + return sum([enumerate_joint(rest, extend(values, Y, y), P) + for y in P.values(Y)]) + +#______________________________________________________________________________ + +class BayesNet: + def __init__(self, nodes=[]): + update(self, nodes=[], vars=[]) + for node in nodes: + self.add(node) + + def add(self, node): + self.nodes.append(node) + self.vars.append(node.variable) + + def observe(self, var, val): + self.evidence[var] = val + +class BayesNode: + def __init__(self, variable, parents, cpt): + if isinstance(parents, str): parents = parents.split() + update(self, variable=variable, parents=parents, cpt=cpt) + +node = BayesNode + + +T, F = True, False + +burglary = BayesNet([ + node('Burglary', '', .001), + node('Earthquake', '', .002), + node('Alarm', 'Burglary Earthquake', { + (T, T):.95, + (T, F):.94, + (F, T):.29, + (F, F):.001}), + node('JohnCalls', 'Alarm', {T:.90, F:.05}), + node('MaryCalls', 'Alarm', {T:.70, F:.01}) + ]) +#______________________________________________________________________________ + +def elimination_ask(X, e, bn): + "[Fig. 14.10]" + factors = [] + for var in reverse(bn.vars): + factors.append(Factor(var, e)) + if is_hidden(var, X, e): + factors = sum_out(var, factors) + return pointwise_product(factors).normalize() + +def pointwise_product(factors): + pass + +def sum_out(var, factors): + pass + +#______________________________________________________________________________ + +def prior_sample(bn): + x = {} + for xi in bn.vars: + x[xi.var] = xi.sample([x]) + +#______________________________________________________________________________ + diff --git a/csp/aima/probability.txt b/csp/aima/probability.txt new file mode 100644 index 00000000..5dfa8558 --- /dev/null +++ b/csp/aima/probability.txt @@ -0,0 +1,32 @@ +## We can build up a probability distribution like this (p. 469): +>>> P = ProbDist() +>>> P['sunny'] = 0.7 +>>> P['rain'] = 0.2 +>>> P['cloudy'] = 0.08 +>>> P['snow'] = 0.02 + +## and query it like this: +>>> P['rain'] +0.20000000000000001 + +## A Joint Probability Distribution is dealt with like this (p. 475): +>>> P = JointProbDist(['Toothache', 'Cavity', 'Catch']) +>>> T, F = True, False +>>> P[T, T, T] = 0.108; P[T, T, F] = 0.012; P[F, T, T] = 0.072; P[F, T, F] = 0.008 +>>> P[T, F, T] = 0.016; P[T, F, F] = 0.064; P[F, F, T] = 0.144; P[F, F, F] = 0.576 + +>>> P[T, T, T] +0.108 + +## Ask for P(Cavity|Toothache=T) +>>> PC = enumerate_joint_ask('Cavity', {'Toothache': T}, P) +>>> PC.prob +{False: 0.39999999999999997, True: 0.59999999999999998} + +>>> 0.6-epsilon < PC[T] < 0.6+epsilon +True + +>>> 0.4-epsilon < PC[F] < 0.4+epsilon +True + + diff --git a/csp/aima/rl.py b/csp/aima/rl.py new file mode 100644 index 00000000..51e3a5a9 --- /dev/null +++ b/csp/aima/rl.py @@ -0,0 +1,15 @@ +"""Reinforcement Learning (Chapter 21) +""" + +from utils import * +import agents + +class PassiveADPAgent(agents.Agent): + """Passive (non-learning) agent that uses adaptive dynamic programming + on a given MDP and policy. [Fig. 21.2]""" + NotImplementedError + +class PassiveTDAgent(agents.Agent): + """Passive (non-learning) agent that uses temporal differences to learn + utility estimates. [Fig. 21.4]""" + NotImplementedError diff --git a/csp/search.py b/csp/aima/search.py similarity index 100% rename from csp/search.py rename to csp/aima/search.py diff --git a/csp/aima/search.txt b/csp/aima/search.txt new file mode 100644 index 00000000..a58fdf22 --- /dev/null +++ b/csp/aima/search.txt @@ -0,0 +1,68 @@ + +>>> ab = GraphProblem('A', 'B', romania) +>>> breadth_first_tree_search(ab).state +'B' +>>> breadth_first_graph_search(ab).state +'B' +>>> depth_first_graph_search(ab).state +'B' +>>> iterative_deepening_search(ab).state +'B' +>>> depth_limited_search(ab).state +'B' +>>> astar_search(ab).state +'B' +>>> [node.state for node in astar_search(ab).path()] +['B', 'P', 'R', 'S', 'A'] + + +### demo + +>>> compare_graph_searchers() +Searcher Romania(A,B) Romania(O, N) Australia +breadth_first_tree_search < 21/ 22/ 59/B> <1158/1159/3288/N> < 7/ 8/ 22/WA> +breadth_first_graph_search < 10/ 19/ 26/B> < 19/ 45/ 45/N> < 5/ 8/ 16/WA> +depth_first_graph_search < 9/ 15/ 23/B> < 16/ 27/ 39/N> < 4/ 7/ 13/WA> +iterative_deepening_search < 11/ 33/ 31/B> < 656/1815/1812/N> < 3/ 11/ 11/WA> +depth_limited_search < 54/ 65/ 185/B> < 387/1012/1125/N> < 50/ 54/ 200/WA> +astar_search < 3/ 4/ 9/B> < 8/ 10/ 22/N> < 2/ 3/ 6/WA> + +>>> board = list('SARTELNID') +>>> print_boggle(board) +S A R +T E L +N I D + +>>> f = BoggleFinder(board) + +>>> len(f) +206 + +>>> ' '.join(f.words()) +'LID LARES DEAL LIE DIETS LIN LINT TIL TIN RATED ERAS LATEN DEAR TIE LINE INTER STEAL LATED LAST TAR SAL DITES RALES SAE RETS TAE RAT RAS SAT IDLE TILDES LEAST IDEAS LITE SATED TINED LEST LIT RASE RENTS TINEA EDIT EDITS NITES ALES LATE LETS RELIT TINES LEI LAT ELINT LATI SENT TARED DINE STAR SEAR NEST LITAS TIED SEAT SERAL RATE DINT DEL DEN SEAL TIER TIES NET SALINE DILATE EAST TIDES LINTER NEAR LITS ELINTS DENI RASED SERA TILE NEAT DERAT IDLEST NIDE LIEN STARED LIER LIES SETA NITS TINE DITAS ALINE SATIN TAS ASTER LEAS TSAR LAR NITE RALE LAS REAL NITER ATE RES RATEL IDEA RET IDEAL REI RATS STALE DENT RED IDES ALIEN SET TEL SER TEN TEA TED SALE TALE STILE ARES SEA TILDE SEN SEL ALINES SEI LASE DINES ILEA LINES ELD TIDE RENT DIEL STELA TAEL STALED EARL LEA TILES TILER LED ETA TALI ALE LASED TELA LET IDLER REIN ALIT ITS NIDES DIN DIE DENTS STIED LINER LASTED RATINE ERA IDLES DIT RENTAL DINER SENTI TINEAL DEIL TEAR LITER LINTS TEAL DIES EAR EAT ARLES SATE STARE DITS DELI DENTAL REST DITE DENTIL DINTS DITA DIET LENT NETS NIL NIT SETAL LATS TARE ARE SATI' + +>>> boggle_hill_climbing(list('ABCDEFGHI')) +30 1 ['A', 'B', 'C', 'D', 'E', 'F', 'G', 'S', 'I'] +35 2 ['A', 'B', 'S', 'D', 'E', 'F', 'G', 'S', 'I'] +36 10 ['A', 'B', 'O', 'D', 'E', 'F', 'G', 'S', 'I'] +41 11 ['A', 'B', 'O', 'D', 'O', 'F', 'G', 'S', 'I'] +46 13 ['A', 'B', 'O', 'D', 'O', 'C', 'G', 'S', 'I'] +48 14 ['A', 'M', 'O', 'D', 'O', 'C', 'G', 'S', 'I'] +55 16 ['A', 'M', 'L', 'D', 'O', 'C', 'G', 'S', 'I'] +60 17 ['A', 'M', 'L', 'D', 'O', 'C', 'G', 'S', 'E'] +67 23 ['A', 'M', 'L', 'D', 'O', 'A', 'G', 'S', 'E'] +70 29 ['A', 'B', 'L', 'D', 'O', 'A', 'G', 'S', 'E'] +73 33 ['A', 'N', 'L', 'D', 'O', 'A', 'G', 'S', 'E'] +80 55 ['A', 'N', 'L', 'D', 'O', 'A', 'G', 'S', 'W'] +84 115 ['A', 'N', 'R', 'D', 'O', 'A', 'G', 'S', 'W'] +100 116 ['A', 'N', 'R', 'D', 'O', 'A', 'G', 'S', 'T'] +111 140 ['E', 'N', 'R', 'D', 'O', 'A', 'G', 'S', 'T'] +123 169 ['E', 'P', 'R', 'D', 'O', 'A', 'G', 'S', 'T'] + +E P R +D O A +G S T +(['E', 'P', 'R', 'D', 'O', 'A', 'G', 'S', 'T'], 123) + +>>> random_weighted_selection(range(10), 3, lambda x: x * x) +[8, 9, 6] \ No newline at end of file diff --git a/csp/aima/text.py b/csp/aima/text.py new file mode 100644 index 00000000..5ccc1023 --- /dev/null +++ b/csp/aima/text.py @@ -0,0 +1,365 @@ +"""Statistical Language Processing tools. (Chapter 23) +We define Unigram and Ngram text models, use them to generate random text, +and show the Viterbi algorithm for segmentatioon of letters into words. +Then we show a very simple Information Retrieval system, and an example +working on a tiny sample of Unix manual pages.""" + +from utils import * +from math import log, exp +import re, probability, string, search + +class CountingProbDist(probability.ProbDist): + """A probability distribution formed by observing and counting examples. + If P is an instance of this class and o + is an observed value, then there are 3 main operations: + p.add(o) increments the count for observation o by 1. + p.sample() returns a random element from the distribution. + p[o] returns the probability for o (as in a regular ProbDist).""" + + def __init__(self, observations=[], default=0): + """Create a distribution, and optionally add in some observations. + By default this is an unsmoothed distribution, but saying default=1, + for example, gives you add-one smoothing.""" + update(self, dictionary=DefaultDict(default), needs_recompute=False, + table=[], n_obs=0) + for o in observations: + self.add(o) + + def add(self, o): + """Add an observation o to the distribution.""" + self.dictionary[o] += 1 + self.n_obs += 1 + self.needs_recompute = True + + def sample(self): + """Return a random sample from the distribution.""" + if self.needs_recompute: self._recompute() + if self.n_obs == 0: + return None + i = bisect.bisect_left(self.table, (1 + random.randrange(self.n_obs),)) + (count, o) = self.table[i] + return o + + def __getitem__(self, item): + """Return an estimate of the probability of item.""" + if self.needs_recompute: self._recompute() + return self.dictionary[item] / self.n_obs + + def __len__(self): + if self.needs_recompute: self._recompute() + return self.n_obs + + def top(self, n): + "Return (count, obs) tuples for the n most frequent observations." + items = [(v, k) for (k, v) in self.dictionary.items()] + items.sort(); items.reverse() + return items[0:n] + + def _recompute(self): + """Recompute the total count n_obs and the table of entries.""" + n_obs = 0 + table = [] + for (o, count) in self.dictionary.items(): + n_obs += count + table.append((n_obs, o)) + update(self, n_obs=float(n_obs), table=table, needs_recompute=False) + +#______________________________________________________________________________ + +class UnigramTextModel(CountingProbDist): + """This is a discrete probability distribution over words, so you + can add, sample, or get P[word], just like with CountingProbDist. You can + also generate a random text n words long with P.samples(n)""" + + def samples(self, n): + "Return a string of n words, random according to the model." + return ' '.join([self.sample() for i in range(n)]) + +class NgramTextModel(CountingProbDist): + """This is a discrete probability distribution over n-tuples of words. + You can add, sample or get P[(word1, ..., wordn)]. The method P.samples(n) + builds up an n-word sequence; P.add_text and P.add_sequence add data.""" + + def __init__(self, n, observation_sequence=[]): + ## In addition to the dictionary of n-tuples, cond_prob is a + ## mapping from (w1, ..., wn-1) to P(wn | w1, ... wn-1) + CountingProbDist.__init__(self) + self.n = n + self.cond_prob = DefaultDict(CountingProbDist()) + self.add_sequence(observation_sequence) + + ## sample, __len__, __getitem__ inherited from CountingProbDist + ## Note they deal with tuples, not strings, as inputs + + def add(self, ngram): + """Count 1 for P[(w1, ..., wn)] and for P(wn | (w1, ..., wn-1)""" + CountingProbDist.add(self, ngram) + self.cond_prob[ngram[:-1]].add(ngram[-1]) + + def add_sequence(self, words): + """Add each of the tuple words[i:i+n], using a sliding window. + Prefix some copies of the empty word, '', to make the start work.""" + n = self.n + words = ['',] * (n-1) + words + for i in range(len(words)-n): + self.add(tuple(words[i:i+n])) + + def samples(self, nwords): + """Build up a random sample of text n words long, using the""" + n = self.n + nminus1gram = ('',) * (n-1) + output = [] + while len(output) < nwords: + wn = self.cond_prob[nminus1gram].sample() + if wn: + output.append(wn) + nminus1gram = nminus1gram[1:] + (wn,) + else: ## Cannot continue, so restart. + nminus1gram = ('',) * (n-1) + return ' '.join(output) + +#______________________________________________________________________________ + + +def viterbi_segment(text, P): + """Find the best segmentation of the string of characters, given the + UnigramTextModel P.""" + # best[i] = best probability for text[0:i] + # words[i] = best word ending at position i + n = len(text) + words = [''] + list(text) + best = [1.0] + [0.0] * n + ## Fill in the vectors best, words via dynamic programming + for i in range(n+1): + for j in range(0, i): + w = text[j:i] + if P[w] * best[i - len(w)] >= best[i]: + best[i] = P[w] * best[i - len(w)] + words[i] = w + ## Now recover the sequence of best words + sequence = []; i = len(words)-1 + while i > 0: + sequence[0:0] = [words[i]] + i = i - len(words[i]) + ## Return sequence of best words and overall probability + return sequence, best[-1] + + +#______________________________________________________________________________ + + +class IRSystem: + """A very simple Information Retrieval System, as discussed in Sect. 23.2. + The constructor s = IRSystem('the a') builds an empty system with two + stopwords. Next, index several documents with s.index_document(text, url). + Then ask queries with s.query('query words', n) to retrieve the top n + matching documents. Queries are literal words from the document, + except that stopwords are ignored, and there is one special syntax: + The query "learn: man cat", for example, runs "man cat" and indexes it.""" + + def __init__(self, stopwords='the a of'): + """Create an IR System. Optionally specify stopwords.""" + ## index is a map of {word: {docid: count}}, where docid is an int, + ## indicating the index into the documents list. + update(self, index=DefaultDict(DefaultDict(0)), + stopwords=set(words(stopwords)), documents=[]) + + def index_collection(self, filenames): + "Index a whole collection of files." + for filename in filenames: + self.index_document(open(filename).read(), filename) + + def index_document(self, text, url): + "Index the text of a document." + ## For now, use first line for title + title = text[:text.index('\n')].strip() + docwords = words(text) + docid = len(self.documents) + self.documents.append(Document(title, url, len(docwords))) + for word in docwords: + if word not in self.stopwords: + self.index[word][docid] += 1 + + def query(self, query_text, n=10): + """Return a list of n (score, docid) pairs for the best matches. + Also handle the special syntax for 'learn: command'.""" + if query_text.startswith("learn:"): + doctext = os.popen(query_text[len("learn:"):], 'r').read() + self.index_document(doctext, query_text) + return [] + qwords = [w for w in words(query_text) if w not in self.stopwords] + shortest = argmin(qwords, lambda w: len(self.index[w])) + docs = self.index[shortest] + results = [(sum([self.score(w, d) for w in qwords]), d) for d in docs] + results.sort(); results.reverse() + return results[:n] + + def score(self, word, docid): + "Compute a score for this word on this docid." + ## There are many options; here we take a very simple approach + return (math.log(1 + self.index[word][docid]) + / math.log(1 + self.documents[docid].nwords)) + + def present(self, results): + "Present the results as a list." + for (score, d) in results: + doc = self.documents[d] + print "%5.2f|%25s | %s" % (100 * score, doc.url, doc.title[:45]) + + def present_results(self, query_text, n=10): + "Get results for the query and present them." + self.present(self.query(query_text, n)) + +class UnixConsultant(IRSystem): + """A trivial IR system over a small collection of Unix man pages.""" + def __init__(self): + IRSystem.__init__(self, stopwords="how do i the a of") + import os + mandir = '../data/man/' + man_files = [mandir + f for f in os.listdir(mandir)] + self.index_collection(man_files) + +class Document: + """Metadata for a document: title and url; maybe add others later.""" + def __init__(self, title, url, nwords): + update(self, title=title, url=url, nwords=nwords) + +def words(text, reg=re.compile('[a-z0-9]+')): + """Return a list of the words in text, ignoring punctuation and + converting everything to lowercase (to canonicalize). + >>> words("``EGAD!'' Edgar cried.") + ['egad', 'edgar', 'cried'] + """ + return reg.findall(text.lower()) + +def canonicalize(text): + """Return a canonical text: only lowercase letters and blanks. + >>> canonicalize("``EGAD!'' Edgar cried.") + 'egad edgar cried' + """ + return ' '.join(words(text)) + + +#______________________________________________________________________________ + +## Example application (not in book): decode a cipher. +## A cipher is a code that substitutes one character for another. +## A shift cipher is a rotation of the letters in the alphabet, +## such as the famous rot13, which maps A to N, B to M, etc. + +#### Encoding + +def shift_encode(plaintext, n): + """Encode text with a shift cipher that moves each letter up by n letters. + >>> shift_encode('abc z', 1) + 'bcd a' + """ + return encode(plaintext, alphabet[n:] + alphabet[:n]) + +def rot13(plaintext): + """Encode text by rotating letters by 13 spaces in the alphabet. + >>> rot13('hello') + 'uryyb' + >>> rot13(rot13('hello')) + 'hello' + """ + return shift_encode(plaintext, 13) + +def encode(plaintext, code): + "Encodes text, using a code which is a permutation of the alphabet." + from string import maketrans + trans = maketrans(alphabet + alphabet.upper(), code + code.upper()) + return plaintext.translate(trans) + +alphabet = 'abcdefghijklmnopqrstuvwxyz' + +def bigrams(text): + """Return a list of pairs in text (a sequence of letters or words). + >>> bigrams('this') + ['th', 'hi', 'is'] + >>> bigrams(['this', 'is', 'a', 'test']) + [['this', 'is'], ['is', 'a'], ['a', 'test']] + """ + return [text[i:i+2] for i in range(len(text) - 1)] + +#### Decoding a Shift (or Caesar) Cipher + +class ShiftDecoder: + """There are only 26 possible encodings, so we can try all of them, + and return the one with the highest probability, according to a + bigram probability distribution.""" + def __init__(self, training_text): + training_text = canonicalize(training_text) + self.P2 = CountingProbDist(bigrams(training_text), default=1) + + def score(self, plaintext): + "Return a score for text based on how common letters pairs are." + s = 1.0 + for bi in bigrams(plaintext): + s = s * self.P2[bi] + return s + + def decode(self, ciphertext): + "Return the shift decoding of text with the best score." + return argmax(all_shifts(ciphertext), self.score) + +def all_shifts(text): + "Return a list of all 26 possible encodings of text by a shift cipher." + return [shift_encode(text, n) for n in range(len(alphabet))] + +#### Decoding a General Permutation Cipher + +class PermutationDecoder: + """This is a much harder problem than the shift decoder. There are 26! + permutations, so we can't try them all. Instead we have to search. + We want to search well, but there are many things to consider: + Unigram probabilities (E is the most common letter); Bigram probabilities + (TH is the most common bigram); word probabilities (I and A are the most + common one-letter words, etc.); etc. + We could represent a search state as a permutation of the 26 letters, + and alter the solution through hill climbing. With an initial guess + based on unigram probabilities, this would probably fair well. However, + I chose instead to have an incremental representation. A state is + represented as a letter-to-letter map; for example {'z': 'e'} to + represent that 'z' will be translated to 'e' + """ + def __init__(self, training_text, ciphertext=None): + self.Pwords = UnigramTextModel(words(training_text)) + self.P1 = UnigramTextModel(training_text) # By letter + self.P2 = NgramTextModel(2, training_text) # By letter pair + if ciphertext: + return self.decode(ciphertext) + + def decode(self, ciphertext): + "Search for a decoding of the ciphertext." + self.ciphertext = ciphertext + problem = PermutationDecoderProblem(decoder=self) + return search.best_first_tree_search(problem, self.score) + + def score(self, ciphertext, code): + """Score is product of word scores, unigram scores, and bigram scores. + This can get very small, so we use logs and exp.""" + text = decode(ciphertext, code) + logP = (sum([log(self.Pwords[word]) for word in words(text)]) + + sum([log(self.P1[c]) for c in text]) + + sum([log(self.P2[b]) for b in bigrams(text)])) + return exp(logP) + +class PermutationDecoderProblem(search.Problem): + def __init__(self, initial=None, goal=None, decoder=None): + self.initial = initial or {} + self.decoder = decoder + + def successors(self, state): + ## Find the best + p, plainchar = max([(self.decoder.P1[c], c) + for c in alphabet if c not in state]) + succs = [extend(state, plainchar, cipherchar)] #???? + + def goal_test(self, state): + "We're done when we get all 26 letters assigned." + return len(state) >= 26 + + +#______________________________________________________________________________ + diff --git a/csp/aima/text.txt b/csp/aima/text.txt new file mode 100644 index 00000000..b792764f --- /dev/null +++ b/csp/aima/text.txt @@ -0,0 +1,122 @@ +## Create a Unigram text model from the words in the book "Flatland". +>>> flatland = DataFile("flat11.txt").read() +>>> wordseq = words(flatland) +>>> P = UnigramTextModel(wordseq) + +## Now do segmentation, using the text model as a prior. +>>> s, p = viterbi_segment('itiseasytoreadwordswithoutspaces', P) +>>> s +['it', 'is', 'easy', 'to', 'read', 'words', 'without', 'spaces'] +>>> 1e-30 < p < 1e-20 +True +>>> s, p = viterbi_segment('wheninthecourseofhumaneventsitbecomesnecessary', P) +>>> s +['when', 'in', 'the', 'course', 'of', 'human', 'events', 'it', 'becomes', 'necessary'] + +## Test the decoding system +>>> shift_encode("This is a secret message.", 17) +'Kyzj zj r jvtivk dvjjrxv.' + +>>> ring = ShiftDecoder(flatland) +>>> ring.decode('Kyzj zj r jvtivk dvjjrxv.') +'This is a secret message.' +>>> ring.decode(rot13('Hello, world!')) +'Hello, world!' + +## CountingProbDist +## Add a thousand samples of a roll of a die to D. +>>> D = CountingProbDist() +>>> for i in range(10000): +... D.add(random.choice('123456')) +>>> ps = [D[n] for n in '123456'] +>>> 1./7. <= min(ps) <= max(ps) <= 1./5. +True + +## demo + +## Compare 1-, 2-, and 3-gram word models of the same text. +>>> flatland = DataFile("flat11.txt").read() +>>> wordseq = words(flatland) +>>> P1 = UnigramTextModel(wordseq) +>>> P2 = NgramTextModel(2, wordseq) +>>> P3 = NgramTextModel(3, wordseq) + +## Generate random text from the N-gram models +>>> P1.samples(20) +'you thought known but were insides of see in depend by us dodecahedrons just but i words are instead degrees' + +>>> P2.samples(20) +'flatland well then can anything else more into the total destruction and circles teach others confine women must be added' + +>>> P3.samples(20) +'flatland by edwin a abbott 1884 to the wake of a certificate from nature herself proving the equal sided triangle' + +## The most frequent entries in each model +>>> P1.top(10) +[(2081, 'the'), (1479, 'of'), (1021, 'and'), (1008, 'to'), (850, 'a'), (722, 'i'), (640, 'in'), (478, 'that'), (399, 'is'), (348, 'you')] + +>>> P2.top(10) +[(368, ('of', 'the')), (152, ('to', 'the')), (152, ('in', 'the')), (86, ('of', 'a')), (80, ('it', 'is')), (71, ('by', 'the')), (68, ('for', 'the')), (68, ('and', 'the')), (62, ('on', 'the')), (60, ('to', 'be'))] + +>>> P3.top(10) +[(30, ('a', 'straight', 'line')), (19, ('of', 'three', 'dimensions')), (16, ('the', 'sense', 'of')), (13, ('by', 'the', 'sense')), (13, ('as', 'well', 'as')), (12, ('of', 'the', 'circles')), (12, ('of', 'sight', 'recognition')), (11, ('the', 'number', 'of')), (11, ('that', 'i', 'had')), (11, ('so', 'as', 'to'))] + +## Probabilities of some common n-grams +>>> P1['the'] +0.061139348356200607 + +>>> P2[('of', 'the')] +0.010812081325655188 + +>>> P3[('', '', 'but')] +0.0 + +>>> P3[('so', 'as', 'to')] +0.00032318721353860618 + +## Distributions given the previous n-1 words +>>> P2.cond_prob['went',].dictionary +>>> P3.cond_prob['in', 'order'].dictionary +{'to': 6} + +## Build and test an IR System +>>> uc = UnixConsultant() +>>> uc.present_results("how do I remove a file") +76.83| ../data/man/rm.txt | RM(1) FSF RM(1) +67.83| ../data/man/tar.txt | TAR(1) TAR(1) +67.79| ../data/man/cp.txt | CP(1) FSF CP(1) +66.58| ../data/man/zip.txt | ZIP(1L) ZIP(1L) +64.58| ../data/man/gzip.txt | GZIP(1) GZIP(1) +63.74| ../data/man/pine.txt | pine(1) pine(1) +62.95| ../data/man/shred.txt | SHRED(1) FSF SHRED(1) +57.46| ../data/man/pico.txt | pico(1) pico(1) +43.38| ../data/man/login.txt | LOGIN(1) Linux Programmer's Manual +41.93| ../data/man/ln.txt | LN(1) FSF LN(1) + +>>> uc.present_results("how do I delete a file") +75.47| ../data/man/diff.txt | DIFF(1) GNU Tools DIFF(1) +69.12| ../data/man/pine.txt | pine(1) pine(1) +63.56| ../data/man/tar.txt | TAR(1) TAR(1) +60.63| ../data/man/zip.txt | ZIP(1L) ZIP(1L) +57.46| ../data/man/pico.txt | pico(1) pico(1) +51.28| ../data/man/shred.txt | SHRED(1) FSF SHRED(1) +26.72| ../data/man/tr.txt | TR(1) User Commands TR(1) + +>>> uc.present_results("email") +18.39| ../data/man/pine.txt | pine(1) pine(1) +12.01| ../data/man/info.txt | INFO(1) FSF INFO(1) + 9.89| ../data/man/pico.txt | pico(1) pico(1) + 8.73| ../data/man/grep.txt | GREP(1) GREP(1) + 8.07| ../data/man/zip.txt | ZIP(1L) ZIP(1L) + +>>> uc.present_results("word counts for files") +112.38| ../data/man/grep.txt | GREP(1) GREP(1) +101.84| ../data/man/wc.txt | WC(1) User Commands WC(1) +82.46| ../data/man/find.txt | FIND(1L) FIND(1L) +74.64| ../data/man/du.txt | DU(1) FSF DU(1) + +>>> uc.present_results("learn: date") +>>> uc.present_results("2003") +14.58| ../data/man/pine.txt | pine(1) pine(1) +11.62| ../data/man/jar.txt | FASTJAR(1) GNU FASTJAR(1) + diff --git a/csp/utils.py b/csp/aima/utils.py similarity index 100% rename from csp/utils.py rename to csp/aima/utils.py diff --git a/csp/aima/utils.txt b/csp/aima/utils.txt new file mode 100644 index 00000000..8caeb66f --- /dev/null +++ b/csp/aima/utils.txt @@ -0,0 +1,169 @@ +>>> d = DefaultDict(0) +>>> d['x'] += 1 +>>> d['x'] +1 + +>>> d = DefaultDict([]) +>>> d['x'] += [1] +>>> d['y'] += [2] +>>> d['x'] +[1] + +>>> s = Struct(a=1, b=2) +>>> s.a +1 +>>> s.a = 3 +>>> s +Struct(a=3, b=2) + +>>> def is_even(x): +... return x % 2 == 0 +>>> sorted([1, 2, -3]) +[-3, 1, 2] +>>> sorted(range(10), key=is_even) +[1, 3, 5, 7, 9, 0, 2, 4, 6, 8] +>>> sorted(range(10), lambda x,y: y-x) +[9, 8, 7, 6, 5, 4, 3, 2, 1, 0] + +>>> removeall(4, []) +[] +>>> removeall('s', 'This is a test. Was a test.') +'Thi i a tet. Wa a tet.' +>>> removeall('s', 'Something') +'Something' +>>> removeall('s', '') +'' + +>>> list(reversed([])) +[] + +>>> count_if(is_even, [1, 2, 3, 4]) +2 +>>> count_if(is_even, []) +0 + +>>> argmax([1], lambda x: x*x) +1 +>>> argmin([1], lambda x: x*x) +1 + + +# Test of memoize with slots in structures +>>> countries = [Struct(name='united states'), Struct(name='canada')] + +# Pretend that 'gnp' was some big hairy operation: +>>> def gnp(country): +... print 'calculating gnp ...' +... return len(country.name) * 1e10 + +>>> gnp = memoize(gnp, '_gnp') +>>> map(gnp, countries) +calculating gnp ... +calculating gnp ... +[130000000000.0, 60000000000.0] +>>> countries +[Struct(_gnp=130000000000.0, name='united states'), Struct(_gnp=60000000000.0, name='canada')] + +# This time we avoid re-doing the calculation +>>> map(gnp, countries) +[130000000000.0, 60000000000.0] + +# Test Queues: +>>> nums = [1, 8, 2, 7, 5, 6, -99, 99, 4, 3, 0] +>>> def qtest(q): +... return [q.extend(nums), [q.pop() for i in range(len(q))]][1] + +>>> qtest(Stack()) +[0, 3, 4, 99, -99, 6, 5, 7, 2, 8, 1] + +>>> qtest(FIFOQueue()) +[1, 8, 2, 7, 5, 6, -99, 99, 4, 3, 0] + +>>> qtest(PriorityQueue(min)) +[-99, 0, 1, 2, 3, 4, 5, 6, 7, 8, 99] + +>>> qtest(PriorityQueue(max)) +[99, 8, 7, 6, 5, 4, 3, 2, 1, 0, -99] + +>>> qtest(PriorityQueue(min, abs)) +[0, 1, 2, 3, 4, 5, 6, 7, 8, -99, 99] + +>>> qtest(PriorityQueue(max, abs)) +[99, -99, 8, 7, 6, 5, 4, 3, 2, 1, 0] + +>>> vals = [100, 110, 160, 200, 160, 110, 200, 200, 220] +>>> histogram(vals) +[(100, 1), (110, 2), (160, 2), (200, 3), (220, 1)] +>>> histogram(vals, 1) +[(200, 3), (110, 2), (160, 2), (220, 1), (100, 1)] +>>> histogram(vals, 1, lambda v: round(v, -2)) +[(200.0, 6), (100.0, 3)] + +>>> log2(1.0) +0.0 + +>>> def fib(n): +... return (n<=1 and 1) or (fib(n-1) + fib(n-2)) + +>>> fib(9) +55 + +# Now we make it faster: +>>> fib = memoize(fib) +>>> fib(9) +55 + +>>> q = Stack() +>>> q.append(1) +>>> q.append(2) +>>> q.pop(), q.pop() +(2, 1) + +>>> q = FIFOQueue() +>>> q.append(1) +>>> q.append(2) +>>> q.pop(), q.pop() +(1, 2) + + +>>> abc = set('abc') +>>> bcd = set('bcd') +>>> 'a' in abc +True +>>> 'a' in bcd +False +>>> list(abc.intersection(bcd)) +['c', 'b'] +>>> list(abc.union(bcd)) +['a', 'c', 'b', 'd'] + +## From "What's new in Python 2.4", but I added calls to sl + +>>> def sl(x): +... return sorted(list(x)) + + +>>> a = set('abracadabra') # form a set from a string +>>> 'z' in a # fast membership testing +False +>>> sl(a) # unique letters in a +['a', 'b', 'c', 'd', 'r'] + +>>> b = set('alacazam') # form a second set +>>> sl(a - b) # letters in a but not in b +['b', 'd', 'r'] +>>> sl(a | b) # letters in either a or b +['a', 'b', 'c', 'd', 'l', 'm', 'r', 'z'] +>>> sl(a & b) # letters in both a and b +['a', 'c'] +>>> sl(a ^ b) # letters in a or b but not both +['b', 'd', 'l', 'm', 'r', 'z'] + + +>>> a.add('z') # add a new element +>>> a.update('wxy') # add multiple new elements +>>> sl(a) +['a', 'b', 'c', 'd', 'r', 'w', 'x', 'y', 'z'] +>>> a.remove('x') # take one element out +>>> sl(a) +['a', 'b', 'c', 'd', 'r', 'w', 'y', 'z'] From 2d5396b2492d9ba414e4b0c04f74ad21739928cb Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Sat, 27 Sep 2014 17:23:44 -0700 Subject: [PATCH 005/246] start --- csp/csp.rkt | 164 ++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 164 insertions(+) create mode 100644 csp/csp.rkt diff --git a/csp/csp.rkt b/csp/csp.rkt new file mode 100644 index 00000000..c6c0cbde --- /dev/null +++ b/csp/csp.rkt @@ -0,0 +1,164 @@ +#lang racket/base + +;; Adapted from work by Peter Norvig +;; http://aima-python.googlecode.com/svn/trunk/csp.py + +(require racket/list racket/bool racket/contract) +(require "csp-utils.rkt" "csp-search.rkt") + +#| + +class CSP(search.Problem): + """This class describes finite-domain Constraint Satisfaction Problems. + A CSP is specified by the following inputs: + vars A list of variables; each is atomic (e.g. int or string). + domains A dict of {var:[possible_value, ...]} entries. + neighbors A dict of {var:[var,...]} that for each variable lists + the other variables that participate in constraints. + constraints A function f(A, a, B, b) that returns true if neighbors + A, B satisfy the constraint when they have values A=a, B=b + In the textbook and in most mathematical definitions, the + constraints are specified as explicit pairs of allowable values, + but the formulation here is easier to express and more compact for + most cases. (For example, the n-Queens problem can be represented + in O(n) space using this notation, instead of O(N^4) for the + explicit representation.) In terms of describing the CSP as a + problem, that's all there is. + + However, the class also supports data structures and methods that help you + solve CSPs by calling a search function on the CSP. Methods and slots are + as follows, where the argument 'a' represents an assignment, which is a + dict of {var:val} entries: + assign(var, val, a) Assign a[var] = val; do other bookkeeping + unassign(var, a) Do del a[var], plus other bookkeeping + nconflicts(var, val, a) Return the number of other variables that + conflict with var=val + curr_domains[var] Slot: remaining consistent values for var + Used by constraint propagation routines. + The following methods are used only by graph_search and tree_search: + actions(state) Return a list of actions + result(state, action) Return a successor of state + goal_test(state) Return true if all constraints satisfied + The following are just for debugging purposes: + nassigns Slot: tracks the number of assignments made + display(a) Print a human-readable representation + + >>> search.depth_first_graph_search(australia) + + """ + +|# + + +(define (init csp vars domains neighbors constraints) + ;; Construct a CSP problem. If vars is empty, it becomes domains.keys(). + (define vars (if (null? vars) (hash-keys domains) vars)) + (hash-set*! csp 'vars vars 'domains domains + 'neighbors neighbors 'constraints constraints + 'initial null 'curr_domains null 'nassigns 0)) + +(define (assign csp var val assignment) + ;; Add {var: val} to assignment; Discard the old value if any. + (hash-set! assignment var val) + (hash-update! csp 'nassigns add1)) + + +(define (unassign csp var assignment) + ;; Remove {var: val} from assignment. + ;; DO NOT call this if you are changing a variable to a new value; + ;; just call assign for that. + (hash-remove! csp var)) + + +(define (nconflicts csp var val assignment) + ;; Return the number of conflicts var=val has with other variables. + (define (conflict var2) + (and (hash-has-key? assignment var2) + (not ((hash-ref csp 'constraints) var val var2 (hash-ref assignment var2))))) + (length (filter-not false? (map conflict (hash-ref (hash-ref csp 'neighbors) var))))) + +(define (display csp assignment) + ;; Show a human-readable representation of the CSP. + (displayln (format "CSP: ~a with assignment: ~a" csp (hash-ref csp assignment)))) + +(define (actions csp state) + ;; Return a list of applicable actions: nonconflicting + ;; assignments to an unassigned variable. + (if (= (length state) (length (hash-ref csp 'vars))) + null + (let () + (define assignment (make-hash state)) + (define var (findf (λ(v) (not (hash-has-key? assignment v))) (hash-ref csp 'vars))) + (map (λ(val) (list var val)) + (filter (λ(val) (= 0 (nconflicts csp var val assignment))) (hash-ref (hash-ref csp 'domains) var)))))) + + +#| + + def actions(self, state): + """Return a list of applicable actions: nonconflicting + assignments to an unassigned variable.""" + if len(state) == len(self.vars): + return [] + else: + assignment = dict(state) + var = find_if(lambda v: v not in assignment, self.vars) + return [(var, val) for val in self.domains[var] + if self.nconflicts(var, val, assignment) == 0] + + def result(self, state, (var, val)): + "Perform an action and return the new state." + return state + ((var, val),) + + def goal_test(self, state): + "The goal is to assign all vars, with all constraints satisfied." + assignment = dict(state) + return (len(assignment) == len(self.vars) and + every(lambda var: self.nconflicts(var, assignment[var], + assignment) == 0, + self.vars)) + + ## These are for constraint propagation + + def support_pruning(self): + """Make sure we can prune values from domains. (We want to pay + for this only if we use it.)""" + if self.curr_domains is None: + self.curr_domains = dict((v, list(self.domains[v])) + for v in self.vars) + + def suppose(self, var, value): + "Start accumulating inferences from assuming var=value." + self.support_pruning() + removals = [(var, a) for a in self.curr_domains[var] if a != value] + self.curr_domains[var] = [value] + return removals + + def prune(self, var, value, removals): + "Rule out var=value." + self.curr_domains[var].remove(value) + if removals is not None: removals.append((var, value)) + + def choices(self, var): + "Return all values for var that aren't currently ruled out." + return (self.curr_domains or self.domains)[var] + + def infer_assignment(self): + "Return the partial assignment implied by the current inferences." + self.support_pruning() + return dict((v, self.curr_domains[v][0]) + for v in self.vars if 1 == len(self.curr_domains[v])) + + def restore(self, removals): + "Undo a supposition and all inferences from it." + for B, b in removals: + self.curr_domains[B].append(b) + + ## This is for min_conflicts search + + def conflicted_vars(self, current): + "Return a list of variables in current assignment that are in conflict" + return [var for var in self.vars + if self.nconflicts(var, current[var], current) > 0] + +|# From 13af8d19524243ee114d1ada4bc344bd1523c1e3 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Sat, 27 Sep 2014 18:08:49 -0700 Subject: [PATCH 006/246] starter --- csp/csp.rkt | 2 +- csp/search.rkt | 3 +++ csp/utils.rkt | 3 +++ 3 files changed, 7 insertions(+), 1 deletion(-) create mode 100644 csp/search.rkt create mode 100644 csp/utils.rkt diff --git a/csp/csp.rkt b/csp/csp.rkt index c6c0cbde..765939e5 100644 --- a/csp/csp.rkt +++ b/csp/csp.rkt @@ -4,7 +4,7 @@ ;; http://aima-python.googlecode.com/svn/trunk/csp.py (require racket/list racket/bool racket/contract) -(require "csp-utils.rkt" "csp-search.rkt") +(require "utils.rkt" "search.rkt") #| diff --git a/csp/search.rkt b/csp/search.rkt new file mode 100644 index 00000000..a48d6a62 --- /dev/null +++ b/csp/search.rkt @@ -0,0 +1,3 @@ +#lang racket/base + +(provide (all-defined-out)) \ No newline at end of file diff --git a/csp/utils.rkt b/csp/utils.rkt new file mode 100644 index 00000000..a48d6a62 --- /dev/null +++ b/csp/utils.rkt @@ -0,0 +1,3 @@ +#lang racket/base + +(provide (all-defined-out)) \ No newline at end of file From 1fc2cf6f447cf1cc00aa554691c9bce106bc74b9 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Sun, 28 Sep 2014 18:46:13 -0700 Subject: [PATCH 007/246] abstract Problem class --- csp/search.rkt | 43 ++++++++++++++++++++++++++++++++++++++++++- 1 file changed, 42 insertions(+), 1 deletion(-) diff --git a/csp/search.rkt b/csp/search.rkt index a48d6a62..758e5d7d 100644 --- a/csp/search.rkt +++ b/csp/search.rkt @@ -1,3 +1,44 @@ #lang racket/base +(require racket/class) + +(provide (all-defined-out)) + +(define Problem + ;; The abstract class for a formal problem. You should subclass this and + ;; implement the method successor, and possibly __init__, goal_test, and + ;; path_cost. Then you will create instances of your subclass and solve them + ;; with the various search functions. + + (class object% + (super-new) + + (init-field initial [goal null]) + ;; The constructor specifies the initial state, and possibly a goal + ;; state, if there is a unique goal. Your subclass's constructor can add + ;; other arguments. + + (abstract successor) + ;; Given a state, return a sequence of (action, state) pairs reachable + ;; from this state. If there are many successors, consider an iterator + ;; that yields the successors one at a time, rather than building them + ;; all at once. Iterators will work fine within the framework. + + (define/public (goal_test state) + ;; Return True if the state is a goal. The default method compares the + ;; state to self.goal, as specified in the constructor. Implement this + ;; method if checking against a single self.goal is not enough. + (and (equal? state goal) #t)) + + (define/public (path_cost c state1 action state2) + ;; Return the cost of a solution path that arrives at state2 from + ;; state1 via action, assuming cost c to get up to state1. If the problem + ;; is such that the path doesn't matter, this function will only look at + ;; state2. If the path does matter, it will consider c and maybe state1 + ;; and action. The default method costs 1 for every step in the path. + (add1 c)) + + (abstract value) + ;; For optimization problems, each state has a value. Hill-climbing + ;; and related algorithms try to maximize this value. + )) -(provide (all-defined-out)) \ No newline at end of file From 0caa63af76f745fb8a922a7858d46992d050d651 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Sun, 28 Sep 2014 20:32:00 -0700 Subject: [PATCH 008/246] abstract Node class --- csp/search.rkt | 54 ++++++++++++++++++++++++++++++++++++++++++++++++-- 1 file changed, 52 insertions(+), 2 deletions(-) diff --git a/csp/search.rkt b/csp/search.rkt index 758e5d7d..f8578d02 100644 --- a/csp/search.rkt +++ b/csp/search.rkt @@ -1,5 +1,5 @@ #lang racket/base -(require racket/class) +(require racket/class racket/match) (provide (all-defined-out)) @@ -12,7 +12,7 @@ (class object% (super-new) - (init-field initial [goal null]) + (init-field initial [goal #f]) ;; The constructor specifies the initial state, and possibly a goal ;; state, if there is a unique goal. Your subclass's constructor can add ;; other arguments. @@ -42,3 +42,53 @@ ;; and related algorithms try to maximize this value. )) +(require describe) + +(define Node + #| A node in a search tree. Contains a pointer to the parent (the node + that this is a successor of) and to the actual state for this node. Note + that if a state is arrived at by two paths, then there are two nodes with + the same state. Also includes the action that got us to this state, and + the total path_cost (also known as g) to reach the node. Other functions + may add an f and h value; see best_first_graph_search and astar_search for + an explanation of how the f and h values are handled. You will not need to + subclass this class. +|# + + (class* object% (printable<%>) + (super-new) + + (init-field state [parent #f] [action #f] [path_cost 0]) + (field [depth (if parent (add1 (get-field depth parent)) 0)]) + ;; Create a search tree Node, derived from a parent by an action. + + (define (repr) (format "" (get-field state this))) + (define/public (custom-print out quoting-depth) (print (repr) out)) + (define/public (custom-display out) (displayln (repr) out)) + (define/public (custom-write out) (write (repr) out)) + + (define/public (path) + ;; Create a list of nodes from the root to this node. + (let ([parent (get-field parent this)]) + (cons this + (if (not parent) + null + (send parent path))))) + + (define/public (expand problem) + ;; Return a list of nodes reachable from this node. + (for/list ([action-state-pair (in-list (send problem successor state))]) + (match-define (cons act next) action-state-pair) + (new Node [state next][parent this][action act] + [path_cost (send problem path_cost path_cost state act next)]))) + )) + +(module+ main + (require racket/format) + (define gp (new Node [state 'grandparent])) + (define p (new Node [state 'parent][parent gp])) + (get-field state p) + (get-field depth p) + (define c (new Node [state 'child] [parent p])) + (get-field depth c) + (send c path)) \ No newline at end of file From 2b8dd131faf775ce3f43c754a6448a627c3ad99d Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Sun, 28 Sep 2014 20:32:04 -0700 Subject: [PATCH 009/246] changes --- csp/csp.rkt | 329 +++++++++++++++++++++++++++++++++++++++++++++++++++- 1 file changed, 327 insertions(+), 2 deletions(-) diff --git a/csp/csp.rkt b/csp/csp.rkt index 765939e5..96edb5bb 100644 --- a/csp/csp.rkt +++ b/csp/csp.rkt @@ -3,7 +3,7 @@ ;; Adapted from work by Peter Norvig ;; http://aima-python.googlecode.com/svn/trunk/csp.py -(require racket/list racket/bool racket/contract) +(require racket/list racket/bool racket/contract racket/class) (require "utils.rkt" "search.rkt") #| @@ -49,8 +49,9 @@ class CSP(search.Problem): |# +(define csp% (class problem%)) -(define (init csp vars domains neighbors constraints) +(define (?init csp vars domains neighbors constraints) ;; Construct a CSP problem. If vars is empty, it becomes domains.keys(). (define vars (if (null? vars) (hash-keys domains) vars)) (hash-set*! csp 'vars vars 'domains domains @@ -161,4 +162,328 @@ class CSP(search.Problem): return [var for var in self.vars if self.nconflicts(var, current[var], current) > 0] + +#______________________________________________________________________________ +# CSP Backtracking Search + +def backtracking_search(csp, mcv=False, lcv=False, fc=False, mac=False): + """Set up to do recursive backtracking search. Allow the following options: + mcv - If true, use Most Constrained Variable Heuristic + lcv - If true, use Least Constraining Value Heuristic + fc - If true, use Forward Checking + mac - If true, use Maintaining Arc Consistency. [Fig. 5.3] + >>> backtracking_search(australia) + {'WA': 'B', 'Q': 'B', 'T': 'B', 'V': 'B', 'SA': 'G', 'NT': 'R', 'NSW': 'R'} + """ + if fc or mac: + csp.curr_domains, csp.pruned = {}, {} + for v in csp.vars: + csp.curr_domains[v] = csp.domains[v][:] + csp.pruned[v] = [] + update(csp, mcv=mcv, lcv=lcv, fc=fc, mac=mac) + return recursive_backtracking({}, csp) + +def recursive_backtracking(assignment, csp): + """Search for a consistent assignment for the csp. + Each recursive call chooses a variable, and considers values for it.""" + if len(assignment) == len(csp.vars): + return assignment + var = select_unassigned_variable(assignment, csp) + for val in order_domain_values(var, assignment, csp): + if csp.fc or csp.nconflicts(var, val, assignment) == 0: + csp.assign(var, val, assignment) + result = recursive_backtracking(assignment, csp) + if result is not None: + return result + csp.unassign(var, assignment) + return None + +def select_unassigned_variable(assignment, csp): + "Select the variable to work on next. Find" + if csp.mcv: # Most Constrained Variable + unassigned = [v for v in csp.vars if v not in assignment] + return argmin_random_tie(unassigned, + lambda var: -num_legal_values(csp, var, assignment)) + else: # First unassigned variable + for v in csp.vars: + if v not in assignment: + return v + +def order_domain_values(var, assignment, csp): + "Decide what order to consider the domain variables." + if csp.curr_domains: + domain = csp.curr_domains[var] + else: + domain = csp.domains[var][:] + if csp.lcv: + # If LCV is specified, consider values with fewer conflicts first + key = lambda val: csp.nconflicts(var, val, assignment) + domain.sort(lambda(x,y): cmp(key(x), key(y))) + while domain: + yield domain.pop() + +def num_legal_values(csp, var, assignment): + if csp.curr_domains: + return len(csp.curr_domains[var]) + else: + return count_if(lambda val: csp.nconflicts(var, val, assignment) == 0, + csp.domains[var]) + +#______________________________________________________________________________ +# Constraint Propagation with AC-3 + +def AC3(csp, queue=None): + """[Fig. 5.7]""" + if queue == None: + queue = [(Xi, Xk) for Xi in csp.vars for Xk in csp.neighbors[Xi]] + while queue: + (Xi, Xj) = queue.pop() + if remove_inconsistent_values(csp, Xi, Xj): + for Xk in csp.neighbors[Xi]: + queue.append((Xk, Xi)) + +def remove_inconsistent_values(csp, Xi, Xj): + "Return true if we remove a value." + removed = False + for x in csp.curr_domains[Xi][:]: + # If Xi=x conflicts with Xj=y for every possible y, eliminate Xi=x + if every(lambda y: not csp.constraints(Xi, x, Xj, y), + csp.curr_domains[Xj]): + csp.curr_domains[Xi].remove(x) + removed = True + return removed + +#______________________________________________________________________________ +# Min-conflicts hillclimbing search for CSPs + +def min_conflicts(csp, max_steps=1000000): + """Solve a CSP by stochastic hillclimbing on the number of conflicts.""" + # Generate a complete assignement for all vars (probably with conflicts) + current = {}; csp.current = current + for var in csp.vars: + val = min_conflicts_value(csp, var, current) + csp.assign(var, val, current) + # Now repeapedly choose a random conflicted variable and change it + for i in range(max_steps): + conflicted = csp.conflicted_vars(current) + if not conflicted: + return current + var = random.choice(conflicted) + val = min_conflicts_value(csp, var, current) + csp.assign(var, val, current) + return None + +def min_conflicts_value(csp, var, current): + """Return the value that will give var the least number of conflicts. + If there is a tie, choose at random.""" + return argmin_random_tie(csp.domains[var], + lambda val: csp.nconflicts(var, val, current)) + +#______________________________________________________________________________ +# Map-Coloring Problems + +class UniversalDict: + """A universal dict maps any key to the same value. We use it here + as the domains dict for CSPs in which all vars have the same domain. + >>> d = UniversalDict(42) + >>> d['life'] + 42 + """ + def __init__(self, value): self.value = value + def __getitem__(self, key): return self.value + def __repr__(self): return '{Any: %r}' % self.value + +def different_values_constraint(A, a, B, b): + "A constraint saying two neighboring variables must differ in value." + return a != b + +def MapColoringCSP(colors, neighbors): + """Make a CSP for the problem of coloring a map with different colors + for any two adjacent regions. Arguments are a list of colors, and a + dict of {region: [neighbor,...]} entries. This dict may also be + specified as a string of the form defined by parse_neighbors""" + + if isinstance(neighbors, str): + neighbors = parse_neighbors(neighbors) + return CSP(neighbors.keys(), UniversalDict(colors), neighbors, + different_values_constraint) + +def parse_neighbors(neighbors, vars=[]): + """Convert a string of the form 'X: Y Z; Y: Z' into a dict mapping + regions to neighbors. The syntax is a region name followed by a ':' + followed by zero or more region names, followed by ';', repeated for + each region name. If you say 'X: Y' you don't need 'Y: X'. + >>> parse_neighbors('X: Y Z; Y: Z') + {'Y': ['X', 'Z'], 'X': ['Y', 'Z'], 'Z': ['X', 'Y']} + """ + dict = DefaultDict([]) + for var in vars: + dict[var] = [] + specs = [spec.split(':') for spec in neighbors.split(';')] + for (A, Aneighbors) in specs: + A = A.strip(); + dict.setdefault(A, []) + for B in Aneighbors.split(): + dict[A].append(B) + dict[B].append(A) + return dict + +australia = MapColoringCSP(list('RGB'), + 'SA: WA NT Q NSW V; NT: WA Q; NSW: Q V; T: ') + +usa = MapColoringCSP(list('RGBY'), + """WA: OR ID; OR: ID NV CA; CA: NV AZ; NV: ID UT AZ; ID: MT WY UT; + UT: WY CO AZ; MT: ND SD WY; WY: SD NE CO; CO: NE KA OK NM; NM: OK TX; + ND: MN SD; SD: MN IA NE; NE: IA MO KA; KA: MO OK; OK: MO AR TX; + TX: AR LA; MN: WI IA; IA: WI IL MO; MO: IL KY TN AR; AR: MS TN LA; + LA: MS; WI: MI IL; IL: IN; IN: KY; MS: TN AL; AL: TN GA FL; MI: OH; + OH: PA WV KY; KY: WV VA TN; TN: VA NC GA; GA: NC SC FL; + PA: NY NJ DE MD WV; WV: MD VA; VA: MD DC NC; NC: SC; NY: VT MA CA NJ; + NJ: DE; DE: MD; MD: DC; VT: NH MA; MA: NH RI CT; CT: RI; ME: NH; + HI: ; AK: """) +#______________________________________________________________________________ +# n-Queens Problem + +def queen_constraint(A, a, B, b): + """Constraint is satisfied (true) if A, B are really the same variable, + or if they are not in the same row, down diagonal, or up diagonal.""" + return A == B or (a != b and A + a != B + b and A - a != B - b) + +class NQueensCSP(CSP): + """Make a CSP for the nQueens problem for search with min_conflicts. + Suitable for large n, it uses only data structures of size O(n). + Think of placing queens one per column, from left to right. + That means position (x, y) represents (var, val) in the CSP. + The main structures are three arrays to count queens that could conflict: + rows[i] Number of queens in the ith row (i.e val == i) + downs[i] Number of queens in the \ diagonal + such that their (x, y) coordinates sum to i + ups[i] Number of queens in the / diagonal + such that their (x, y) coordinates have x-y+n-1 = i + We increment/decrement these counts each time a queen is placed/moved from + a row/diagonal. So moving is O(1), as is nconflicts. But choosing + a variable, and a best value for the variable, are each O(n). + If you want, you can keep track of conflicted vars, then variable + selection will also be O(1). + >>> len(backtracking_search(NQueensCSP(8))) + 8 + >>> len(min_conflicts(NQueensCSP(8))) + 8 + """ + def __init__(self, n): + """Initialize data structures for n Queens.""" + CSP.__init__(self, range(n), UniversalDict(range(n)), + UniversalDict(range(n)), queen_constraint) + update(self, rows=[0]*n, ups=[0]*(2*n - 1), downs=[0]*(2*n - 1)) + + def nconflicts(self, var, val, assignment): + """The number of conflicts, as recorded with each assignment. + Count conflicts in row and in up, down diagonals. If there + is a queen there, it can't conflict with itself, so subtract 3.""" + n = len(self.vars) + c = self.rows[val] + self.downs[var+val] + self.ups[var-val+n-1] + if assignment.get(var, None) == val: + c -= 3 + return c + + def assign(self, var, val, assignment): + "Assign var, and keep track of conflicts." + oldval = assignment.get(var, None) + if val != oldval: + if oldval is not None: # Remove old val if there was one + self.record_conflict(assignment, var, oldval, -1) + self.record_conflict(assignment, var, val, +1) + CSP.assign(self, var, val, assignment) + + def unassign(self, var, assignment): + "Remove var from assignment (if it is there) and track conflicts." + if var in assignment: + self.record_conflict(assignment, var, assignment[var], -1) + CSP.unassign(self, var, assignment) + + def record_conflict(self, assignment, var, val, delta): + "Record conflicts caused by addition or deletion of a Queen." + n = len(self.vars) + self.rows[val] += delta + self.downs[var + val] += delta + self.ups[var - val + n - 1] += delta + + def display(self, assignment): + "Print the queens and the nconflicts values (for debugging)." + n = len(self.vars) + for val in range(n): + for var in range(n): + if assignment.get(var,'') == val: ch ='Q' + elif (var+val) % 2 == 0: ch = '.' + else: ch = '-' + print ch, + print ' ', + for var in range(n): + if assignment.get(var,'') == val: ch ='*' + else: ch = ' ' + print str(self.nconflicts(var, val, assignment))+ch, + print + +#______________________________________________________________________________ +# The Zebra Puzzle + +def Zebra(): + "Return an instance of the Zebra Puzzle." + Colors = 'Red Yellow Blue Green Ivory'.split() + Pets = 'Dog Fox Snails Horse Zebra'.split() + Drinks = 'OJ Tea Coffee Milk Water'.split() + Countries = 'Englishman Spaniard Norwegian Ukranian Japanese'.split() + Smokes = 'Kools Chesterfields Winston LuckyStrike Parliaments'.split() + vars = Colors + Pets + Drinks + Countries + Smokes + domains = {} + for var in vars: + domains[var] = range(1, 6) + domains['Norwegian'] = [1] + domains['Milk'] = [3] + neighbors = parse_neighbors("""Englishman: Red; + Spaniard: Dog; Kools: Yellow; Chesterfields: Fox; + Norwegian: Blue; Winston: Snails; LuckyStrike: OJ; + Ukranian: Tea; Japanese: Parliaments; Kools: Horse; + Coffee: Green; Green: Ivory""", vars) + for type in [Colors, Pets, Drinks, Countries, Smokes]: + for A in type: + for B in type: + if A != B: + if B not in neighbors[A]: neighbors[A].append(B) + if A not in neighbors[B]: neighbors[B].append(A) + def zebra_constraint(A, a, B, b, recurse=0): + same = (a == b) + next_to = abs(a - b) == 1 + if A == 'Englishman' and B == 'Red': return same + if A == 'Spaniard' and B == 'Dog': return same + if A == 'Chesterfields' and B == 'Fox': return next_to + if A == 'Norwegian' and B == 'Blue': return next_to + if A == 'Kools' and B == 'Yellow': return same + if A == 'Winston' and B == 'Snails': return same + if A == 'LuckyStrike' and B == 'OJ': return same + if A == 'Ukranian' and B == 'Tea': return same + if A == 'Japanese' and B == 'Parliaments': return same + if A == 'Kools' and B == 'Horse': return next_to + if A == 'Coffee' and B == 'Green': return same + if A == 'Green' and B == 'Ivory': return (a - 1) == b + if recurse == 0: return zebra_constraint(B, b, A, a, 1) + if ((A in Colors and B in Colors) or + (A in Pets and B in Pets) or + (A in Drinks and B in Drinks) or + (A in Countries and B in Countries) or + (A in Smokes and B in Smokes)): return not same + raise 'error' + return CSP(vars, domains, neighbors, zebra_constraint) + +def solve_zebra(algorithm=min_conflicts, **args): + z = Zebra() + ans = algorithm(z, **args) + for h in range(1, 6): + print 'House', h, + for (var, val) in ans.items(): + if val == h: print var, + print + return ans['Zebra'], ans['Water'], z.nassigns, ans, + + |# From 84a82606d0d9ebda5926af14244c47b63c0dcf48 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Mon, 29 Sep 2014 08:30:26 -0700 Subject: [PATCH 010/246] count_if --- csp/utils.rkt | 11 ++++++++++- 1 file changed, 10 insertions(+), 1 deletion(-) diff --git a/csp/utils.rkt b/csp/utils.rkt index a48d6a62..4b88ea4f 100644 --- a/csp/utils.rkt +++ b/csp/utils.rkt @@ -1,3 +1,12 @@ #lang racket/base +(require racket/list racket/bool) -(provide (all-defined-out)) \ No newline at end of file +(provide (all-defined-out)) + +(module+ test (require rackunit)) + +(define (count_if pred xs) + (length (filter-not false? (map pred xs)))) + +(module+ test + (check-equal? (count_if procedure? (list 42 null max min)) 2)) \ No newline at end of file From 6d6d11c849a62b88f3f59d047ae3a9696f59f739 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Mon, 29 Sep 2014 08:30:32 -0700 Subject: [PATCH 011/246] tweak --- csp/search.rkt | 9 ++++----- 1 file changed, 4 insertions(+), 5 deletions(-) diff --git a/csp/search.rkt b/csp/search.rkt index f8578d02..e709a322 100644 --- a/csp/search.rkt +++ b/csp/search.rkt @@ -69,11 +69,10 @@ (define/public (path) ;; Create a list of nodes from the root to this node. - (let ([parent (get-field parent this)]) - (cons this - (if (not parent) - null - (send parent path))))) + (define parent (get-field parent this)) + (cons this (if (not parent) + null + (send parent path)))) (define/public (expand problem) ;; Return a list of nodes reachable from this node. From 32fd15e6edcce86dce1ef88525f9415dfcf54055 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Mon, 29 Sep 2014 08:30:57 -0700 Subject: [PATCH 012/246] add methods --- csp/csp.rkt | 90 +++++++++++++++++++++++++++++++---------------------- 1 file changed, 53 insertions(+), 37 deletions(-) diff --git a/csp/csp.rkt b/csp/csp.rkt index 96edb5bb..b4525f1f 100644 --- a/csp/csp.rkt +++ b/csp/csp.rkt @@ -6,10 +6,9 @@ (require racket/list racket/bool racket/contract racket/class) (require "utils.rkt" "search.rkt") -#| - -class CSP(search.Problem): - """This class describes finite-domain Constraint Satisfaction Problems. +(define CSP (class Problem + #| +This class describes finite-domain Constraint Satisfaction Problems. A CSP is specified by the following inputs: vars A list of variables; each is atomic (e.g. int or string). domains A dict of {var:[possible_value, ...]} entries. @@ -42,46 +41,63 @@ class CSP(search.Problem): The following are just for debugging purposes: nassigns Slot: tracks the number of assignments made display(a) Print a human-readable representation - - >>> search.depth_first_graph_search(australia) - - """ - |# + (super-new) + + ;; Construct a CSP problem. If vars is empty, it becomes domains.keys(). + (init-field vars domains neighbors constraints) + (when (not vars) (set! vars (hash-keys domains))) + (inherit-field initial) + (set! initial (hash)) + (field [curr_domains #f][pruned #f][nassigns 0][fc #f][mac #f]) + + (define/public (assign var val assignment) + ;; Add {var: val} to assignment; Discard the old value if any. + ;; Do bookkeeping for curr_domains and nassigns. + (set! nassigns (add1 nassigns)) + (hash-set! assignment var val) + (if curr_domains + (when fc + (forward_check var val assignment)) + (when mac + (AC3 (map (λ(Xk) (cons Xk var)) (hash-ref neighbors var)))))) + + (define/public (unassign var val assignment) + ;; Remove {var: val} from assignment; that is backtrack. + ;; DO NOT call this if you are changing a variable to a new value; + ;; just call assign for that. + (when (hash-has-key? assignment var) + ;; Reset the curr_domain to be the full original domain + (when curr_domains + (hash-set! curr_domains var (hash-ref domains var))) + (hash-remove! assignment var))) + + (define/public (nconflicts var val assignment) + ;; Return the number of conflicts var=val has with other variables. + ;; Subclasses may implement this more efficiently + (define (conflict var2) + (define val2 (hash-ref assignment var2 #f)) + (and val2 (not (constraints var val var2 val2)))) + (count_if conflict (hash-ref neighbors var))) + + (define/public (forward_check var val assignment) + ;; Do forward checking (current domain reduction) for this assignment. + (void)) + + (define/public (AC3 csp [queue #f]) + (void)) + + )) -(define csp% (class problem%)) - -(define (?init csp vars domains neighbors constraints) - ;; Construct a CSP problem. If vars is empty, it becomes domains.keys(). - (define vars (if (null? vars) (hash-keys domains) vars)) - (hash-set*! csp 'vars vars 'domains domains - 'neighbors neighbors 'constraints constraints - 'initial null 'curr_domains null 'nassigns 0)) - -(define (assign csp var val assignment) - ;; Add {var: val} to assignment; Discard the old value if any. - (hash-set! assignment var val) - (hash-update! csp 'nassigns add1)) -(define (unassign csp var assignment) - ;; Remove {var: val} from assignment. - ;; DO NOT call this if you are changing a variable to a new value; - ;; just call assign for that. - (hash-remove! csp var)) - - -(define (nconflicts csp var val assignment) - ;; Return the number of conflicts var=val has with other variables. - (define (conflict var2) - (and (hash-has-key? assignment var2) - (not ((hash-ref csp 'constraints) var val var2 (hash-ref assignment var2))))) - (length (filter-not false? (map conflict (hash-ref (hash-ref csp 'neighbors) var))))) (define (display csp assignment) ;; Show a human-readable representation of the CSP. (displayln (format "CSP: ~a with assignment: ~a" csp (hash-ref csp assignment)))) + +#| (define (actions csp state) ;; Return a list of applicable actions: nonconflicting ;; assignments to an unassigned variable. @@ -92,8 +108,8 @@ class CSP(search.Problem): (define var (findf (λ(v) (not (hash-has-key? assignment v))) (hash-ref csp 'vars))) (map (λ(val) (list var val)) (filter (λ(val) (= 0 (nconflicts csp var val assignment))) (hash-ref (hash-ref csp 'domains) var)))))) - - +|# + #| def actions(self, state): From 8f18a8c6a990c96eecaaf2e5f5b9d21f63ec6c16 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Mon, 29 Sep 2014 10:45:59 -0700 Subject: [PATCH 013/246] progress --- csp/csp.rkt | 62 +++++++++++++++++++++++++++++++++++++-------------- csp/utils.rkt | 12 +++++++++- 2 files changed, 56 insertions(+), 18 deletions(-) diff --git a/csp/csp.rkt b/csp/csp.rkt index b4525f1f..ac2b88bf 100644 --- a/csp/csp.rkt +++ b/csp/csp.rkt @@ -3,7 +3,7 @@ ;; Adapted from work by Peter Norvig ;; http://aima-python.googlecode.com/svn/trunk/csp.py -(require racket/list racket/bool racket/contract racket/class) +(require racket/list racket/bool racket/contract racket/class racket/match) (require "utils.rkt" "search.rkt") (define CSP (class Problem @@ -82,22 +82,49 @@ This class describes finite-domain Constraint Satisfaction Problems. (define/public (forward_check var val assignment) ;; Do forward checking (current domain reduction) for this assignment. - (void)) + (when curr_domains + ;; Restore prunings from previous value of var + (for ([Bb-pair (in-list (hash-ref pruned var))]) + (match-define (cons B b) Bb-pair) + (hash-update! curr_domains B (λ(v) (append v b)))) + (hash-set! pruned var #f) + ;; Prune any other B=b assignment that conflicts with var=val + (for ([B (in-list (hash-ref neighbors var))]) + (when (not (hash-has-key? assignment B)) + (for ([b (in-list (hash-ref curr_domains B))]) + (when (not (constraints var val B b)) + (remove b (hash-ref curr_domains B)) + (append (hash-ref pruned var) (cons B b)))))))) - (define/public (AC3 csp [queue #f]) - (void)) + (define/public (display assignment) + ;; Show a human-readable representation of the CSP. + (displayln (format "CSP: ~a with assignment: ~a" this assignment))) - )) - - - - -(define (display csp assignment) - ;; Show a human-readable representation of the CSP. - (displayln (format "CSP: ~a with assignment: ~a" csp (hash-ref csp assignment)))) - - -#| + ;; These methods are for the tree and graph search interface: + + (define/public (succ assignment) + ;; Return a list of (action, state) pairs + (if (= (length assignment) (length vars)) + null + (let () + (define var (find_if (λ(v) (not (hash-has-key? assignment v))) vars)) + (define result null) + (for ([val (in-list (hash-ref domains var))]) + (when (= (nconflicts var val assignment) 0) + ;; what does this mean? + ;; a = assignment.copy; a[var] = val + + + + (define/public (AC3 csp [queue #f]) + (void)) + + )) + + + + + #| (define (actions csp state) ;; Return a list of applicable actions: nonconflicting ;; assignments to an unassigned variable. @@ -109,8 +136,8 @@ This class describes finite-domain Constraint Satisfaction Problems. (map (λ(val) (list var val)) (filter (λ(val) (= 0 (nconflicts csp var val assignment))) (hash-ref (hash-ref csp 'domains) var)))))) |# - -#| + + #| def actions(self, state): """Return a list of applicable actions: nonconflicting @@ -503,3 +530,4 @@ def solve_zebra(algorithm=min_conflicts, **args): |# + \ No newline at end of file diff --git a/csp/utils.rkt b/csp/utils.rkt index 4b88ea4f..6024fa02 100644 --- a/csp/utils.rkt +++ b/csp/utils.rkt @@ -6,7 +6,17 @@ (module+ test (require rackunit)) (define (count_if pred xs) + ;; Count the number of elements of seq for which the predicate is true. (length (filter-not false? (map pred xs)))) (module+ test - (check-equal? (count_if procedure? (list 42 null max min)) 2)) \ No newline at end of file + (check-equal? (count_if procedure? (list 42 null max min)) 2)) + +(define (find_if pred xs) + ;; If there is an element of seq that satisfies predicate; return it. + (or (findf pred xs) null)) + +(module+ test + (check-equal? (find_if procedure? (list 3 min max)) min) + (check-equal? (find_if procedure? (list 1 2 3)) null)) + \ No newline at end of file From d2e27edafc43b186a996faf73ddfef0593dd7924 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Mon, 29 Sep 2014 10:58:37 -0700 Subject: [PATCH 014/246] updates --- csp/csp.rkt | 37 ++++++++++++++++++++----------------- 1 file changed, 20 insertions(+), 17 deletions(-) diff --git a/csp/csp.rkt b/csp/csp.rkt index ac2b88bf..a59a5a6c 100644 --- a/csp/csp.rkt +++ b/csp/csp.rkt @@ -111,20 +111,24 @@ This class describes finite-domain Constraint Satisfaction Problems. (define result null) (for ([val (in-list (hash-ref domains var))]) (when (= (nconflicts var val assignment) 0) - ;; what does this mean? - ;; a = assignment.copy; a[var] = val - - - - (define/public (AC3 csp [queue #f]) - (void)) - - )) - - - - - #| + (define a (hash-copy assignment)) ;; !! typo fix in original + (hash-set! a var val) + (set! result (append result (cons (cons var val) a))))) + result))) + + ;; todo: calls to append need to mutate. + + + + (define/public (AC3 csp [queue #f]) + (void)) + + )) + + + + +#| (define (actions csp state) ;; Return a list of applicable actions: nonconflicting ;; assignments to an unassigned variable. @@ -136,8 +140,8 @@ This class describes finite-domain Constraint Satisfaction Problems. (map (λ(val) (list var val)) (filter (λ(val) (= 0 (nconflicts csp var val assignment))) (hash-ref (hash-ref csp 'domains) var)))))) |# - - #| + +#| def actions(self, state): """Return a list of applicable actions: nonconflicting @@ -530,4 +534,3 @@ def solve_zebra(algorithm=min_conflicts, **args): |# - \ No newline at end of file From 1bb8b90e0bb3f842767d8d180b2d236744b5b9d1 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Mon, 29 Sep 2014 16:49:50 -0700 Subject: [PATCH 015/246] `every` --- csp/utils.rkt | 12 +++++++++++- 1 file changed, 11 insertions(+), 1 deletion(-) diff --git a/csp/utils.rkt b/csp/utils.rkt index 6024fa02..510ccd4c 100644 --- a/csp/utils.rkt +++ b/csp/utils.rkt @@ -5,6 +5,8 @@ (module+ test (require rackunit)) + + (define (count_if pred xs) ;; Count the number of elements of seq for which the predicate is true. (length (filter-not false? (map pred xs)))) @@ -19,4 +21,12 @@ (module+ test (check-equal? (find_if procedure? (list 3 min max)) min) (check-equal? (find_if procedure? (list 1 2 3)) null)) - \ No newline at end of file + + +(define (every pred xs) + ;;;True if every element of seq satisfies predicate. + (andmap pred xs)) + +(module+ test + (check-true (every procedure? (list min max))) + (check-false (every procedure? (list min 3)))) \ No newline at end of file From 2dd7edfb56ddd6db54e3d00562e4286d19b8badb Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Mon, 29 Sep 2014 16:50:01 -0700 Subject: [PATCH 016/246] finish draft CSP class --- csp/csp.rkt | 40 +++++++++++++++++++++++----------------- 1 file changed, 23 insertions(+), 17 deletions(-) diff --git a/csp/csp.rkt b/csp/csp.rkt index a59a5a6c..4320d4f7 100644 --- a/csp/csp.rkt +++ b/csp/csp.rkt @@ -93,8 +93,8 @@ This class describes finite-domain Constraint Satisfaction Problems. (when (not (hash-has-key? assignment B)) (for ([b (in-list (hash-ref curr_domains B))]) (when (not (constraints var val B b)) - (remove b (hash-ref curr_domains B)) - (append (hash-ref pruned var) (cons B b)))))))) + (hash-update! curr_domains B (λ(v) (remove v b))) + (hash-update! pruned var (λ(v) (append v (cons B b)))))))))) (define/public (display assignment) ;; Show a human-readable representation of the CSP. @@ -106,27 +106,33 @@ This class describes finite-domain Constraint Satisfaction Problems. ;; Return a list of (action, state) pairs (if (= (length assignment) (length vars)) null - (let () - (define var (find_if (λ(v) (not (hash-has-key? assignment v))) vars)) - (define result null) - (for ([val (in-list (hash-ref domains var))]) - (when (= (nconflicts var val assignment) 0) - (define a (hash-copy assignment)) ;; !! typo fix in original - (hash-set! a var val) - (set! result (append result (cons (cons var val) a))))) - result))) + (let ([var (find_if (λ(v) (not (hash-has-key? assignment v))) vars)]) + (for/list ([val (in-list (hash-ref domains var))] #:when (= (nconflicts var val assignment) 0)) + (define a (hash-copy assignment)) + (hash-set! a var val) + (cons (cons var val) a))))) - ;; todo: calls to append need to mutate. - - - - (define/public (AC3 csp [queue #f]) - (void)) + (define/override (goal_test assignment) + ;; The goal is to assign all vars, with all constraints satisfied. + (and (= (length assignment) (length vars)) + (every (λ(var) (= (nconflicts var (hash-ref assignment var) assignment) 0)) vars))) + ;; This is for min_conflicts search + (define/public (conflicted_vars current) + ;; Return a list of variables in current assignment that are in conflict + (for/list ([var (in-list vars)] + #:when (> (nconflicts var (hash-ref current var) current) 0)) + var)) )) +;;______________________________________________________________________________ +;; CSP Backtracking Search + + +(define (AC3 csp queue) + (void)) #| (define (actions csp state) From dac7f26dbb8a6e7d9d40bb92ba8f064f0fe0d3a6 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Mon, 29 Sep 2014 19:25:02 -0700 Subject: [PATCH 017/246] progress --- csp/csp.rkt | 525 ++++++++++++-------------------------------------- csp/utils.rkt | 19 +- 2 files changed, 136 insertions(+), 408 deletions(-) diff --git a/csp/csp.rkt b/csp/csp.rkt index 4320d4f7..585af7e4 100644 --- a/csp/csp.rkt +++ b/csp/csp.rkt @@ -3,7 +3,7 @@ ;; Adapted from work by Peter Norvig ;; http://aima-python.googlecode.com/svn/trunk/csp.py -(require racket/list racket/bool racket/contract racket/class racket/match) +(require racket/list racket/bool racket/contract racket/class racket/match racket/generator) (require "utils.rkt" "search.rkt") (define CSP (class Problem @@ -128,415 +128,132 @@ This class describes finite-domain Constraint Satisfaction Problems. ;;______________________________________________________________________________ ;; CSP Backtracking Search - - - -(define (AC3 csp queue) - (void)) - -#| -(define (actions csp state) - ;; Return a list of applicable actions: nonconflicting - ;; assignments to an unassigned variable. - (if (= (length state) (length (hash-ref csp 'vars))) - null - (let () - (define assignment (make-hash state)) - (define var (findf (λ(v) (not (hash-has-key? assignment v))) (hash-ref csp 'vars))) - (map (λ(val) (list var val)) - (filter (λ(val) (= 0 (nconflicts csp var val assignment))) (hash-ref (hash-ref csp 'domains) var)))))) -|# - -#| - - def actions(self, state): - """Return a list of applicable actions: nonconflicting - assignments to an unassigned variable.""" - if len(state) == len(self.vars): - return [] - else: - assignment = dict(state) - var = find_if(lambda v: v not in assignment, self.vars) - return [(var, val) for val in self.domains[var] - if self.nconflicts(var, val, assignment) == 0] - - def result(self, state, (var, val)): - "Perform an action and return the new state." - return state + ((var, val),) - - def goal_test(self, state): - "The goal is to assign all vars, with all constraints satisfied." - assignment = dict(state) - return (len(assignment) == len(self.vars) and - every(lambda var: self.nconflicts(var, assignment[var], - assignment) == 0, - self.vars)) - - ## These are for constraint propagation - - def support_pruning(self): - """Make sure we can prune values from domains. (We want to pay - for this only if we use it.)""" - if self.curr_domains is None: - self.curr_domains = dict((v, list(self.domains[v])) - for v in self.vars) - - def suppose(self, var, value): - "Start accumulating inferences from assuming var=value." - self.support_pruning() - removals = [(var, a) for a in self.curr_domains[var] if a != value] - self.curr_domains[var] = [value] - return removals - - def prune(self, var, value, removals): - "Rule out var=value." - self.curr_domains[var].remove(value) - if removals is not None: removals.append((var, value)) - - def choices(self, var): - "Return all values for var that aren't currently ruled out." - return (self.curr_domains or self.domains)[var] - - def infer_assignment(self): - "Return the partial assignment implied by the current inferences." - self.support_pruning() - return dict((v, self.curr_domains[v][0]) - for v in self.vars if 1 == len(self.curr_domains[v])) - - def restore(self, removals): - "Undo a supposition and all inferences from it." - for B, b in removals: - self.curr_domains[B].append(b) - - ## This is for min_conflicts search - - def conflicted_vars(self, current): - "Return a list of variables in current assignment that are in conflict" - return [var for var in self.vars - if self.nconflicts(var, current[var], current) > 0] - - -#______________________________________________________________________________ -# CSP Backtracking Search - -def backtracking_search(csp, mcv=False, lcv=False, fc=False, mac=False): - """Set up to do recursive backtracking search. Allow the following options: +(define (backtracking_search csp [mcv #f] [lcv #f] [fc #f] [mac #f]) + #| +Set up to do recursive backtracking search. Allow the following options: mcv - If true, use Most Constrained Variable Heuristic lcv - If true, use Least Constraining Value Heuristic fc - If true, use Forward Checking mac - If true, use Maintaining Arc Consistency. [Fig. 5.3] >>> backtracking_search(australia) {'WA': 'B', 'Q': 'B', 'T': 'B', 'V': 'B', 'SA': 'G', 'NT': 'R', 'NSW': 'R'} - """ - if fc or mac: - csp.curr_domains, csp.pruned = {}, {} - for v in csp.vars: - csp.curr_domains[v] = csp.domains[v][:] - csp.pruned[v] = [] - update(csp, mcv=mcv, lcv=lcv, fc=fc, mac=mac) - return recursive_backtracking({}, csp) - -def recursive_backtracking(assignment, csp): - """Search for a consistent assignment for the csp. - Each recursive call chooses a variable, and considers values for it.""" - if len(assignment) == len(csp.vars): - return assignment - var = select_unassigned_variable(assignment, csp) - for val in order_domain_values(var, assignment, csp): - if csp.fc or csp.nconflicts(var, val, assignment) == 0: - csp.assign(var, val, assignment) - result = recursive_backtracking(assignment, csp) - if result is not None: - return result - csp.unassign(var, assignment) - return None - -def select_unassigned_variable(assignment, csp): - "Select the variable to work on next. Find" - if csp.mcv: # Most Constrained Variable - unassigned = [v for v in csp.vars if v not in assignment] - return argmin_random_tie(unassigned, - lambda var: -num_legal_values(csp, var, assignment)) - else: # First unassigned variable - for v in csp.vars: - if v not in assignment: - return v - -def order_domain_values(var, assignment, csp): - "Decide what order to consider the domain variables." - if csp.curr_domains: - domain = csp.curr_domains[var] - else: - domain = csp.domains[var][:] - if csp.lcv: - # If LCV is specified, consider values with fewer conflicts first - key = lambda val: csp.nconflicts(var, val, assignment) - domain.sort(lambda(x,y): cmp(key(x), key(y))) - while domain: - yield domain.pop() - -def num_legal_values(csp, var, assignment): - if csp.curr_domains: - return len(csp.curr_domains[var]) - else: - return count_if(lambda val: csp.nconflicts(var, val, assignment) == 0, - csp.domains[var]) - -#______________________________________________________________________________ -# Constraint Propagation with AC-3 - -def AC3(csp, queue=None): - """[Fig. 5.7]""" - if queue == None: - queue = [(Xi, Xk) for Xi in csp.vars for Xk in csp.neighbors[Xi]] - while queue: - (Xi, Xj) = queue.pop() - if remove_inconsistent_values(csp, Xi, Xj): - for Xk in csp.neighbors[Xi]: - queue.append((Xk, Xi)) - -def remove_inconsistent_values(csp, Xi, Xj): - "Return true if we remove a value." - removed = False - for x in csp.curr_domains[Xi][:]: - # If Xi=x conflicts with Xj=y for every possible y, eliminate Xi=x - if every(lambda y: not csp.constraints(Xi, x, Xj, y), - csp.curr_domains[Xj]): - csp.curr_domains[Xi].remove(x) - removed = True - return removed - -#______________________________________________________________________________ -# Min-conflicts hillclimbing search for CSPs - -def min_conflicts(csp, max_steps=1000000): - """Solve a CSP by stochastic hillclimbing on the number of conflicts.""" - # Generate a complete assignement for all vars (probably with conflicts) - current = {}; csp.current = current - for var in csp.vars: - val = min_conflicts_value(csp, var, current) - csp.assign(var, val, current) - # Now repeapedly choose a random conflicted variable and change it - for i in range(max_steps): - conflicted = csp.conflicted_vars(current) - if not conflicted: - return current - var = random.choice(conflicted) - val = min_conflicts_value(csp, var, current) - csp.assign(var, val, current) - return None - -def min_conflicts_value(csp, var, current): - """Return the value that will give var the least number of conflicts. - If there is a tie, choose at random.""" - return argmin_random_tie(csp.domains[var], - lambda val: csp.nconflicts(var, val, current)) - -#______________________________________________________________________________ -# Map-Coloring Problems - -class UniversalDict: - """A universal dict maps any key to the same value. We use it here - as the domains dict for CSPs in which all vars have the same domain. - >>> d = UniversalDict(42) - >>> d['life'] - 42 - """ - def __init__(self, value): self.value = value - def __getitem__(self, key): return self.value - def __repr__(self): return '{Any: %r}' % self.value - -def different_values_constraint(A, a, B, b): - "A constraint saying two neighboring variables must differ in value." - return a != b - -def MapColoringCSP(colors, neighbors): - """Make a CSP for the problem of coloring a map with different colors - for any two adjacent regions. Arguments are a list of colors, and a - dict of {region: [neighbor,...]} entries. This dict may also be - specified as a string of the form defined by parse_neighbors""" - - if isinstance(neighbors, str): - neighbors = parse_neighbors(neighbors) - return CSP(neighbors.keys(), UniversalDict(colors), neighbors, - different_values_constraint) - -def parse_neighbors(neighbors, vars=[]): - """Convert a string of the form 'X: Y Z; Y: Z' into a dict mapping - regions to neighbors. The syntax is a region name followed by a ':' - followed by zero or more region names, followed by ';', repeated for - each region name. If you say 'X: Y' you don't need 'Y: X'. - >>> parse_neighbors('X: Y Z; Y: Z') - {'Y': ['X', 'Z'], 'X': ['Y', 'Z'], 'Z': ['X', 'Y']} - """ - dict = DefaultDict([]) - for var in vars: - dict[var] = [] - specs = [spec.split(':') for spec in neighbors.split(';')] - for (A, Aneighbors) in specs: - A = A.strip(); - dict.setdefault(A, []) - for B in Aneighbors.split(): - dict[A].append(B) - dict[B].append(A) - return dict - -australia = MapColoringCSP(list('RGB'), - 'SA: WA NT Q NSW V; NT: WA Q; NSW: Q V; T: ') - -usa = MapColoringCSP(list('RGBY'), - """WA: OR ID; OR: ID NV CA; CA: NV AZ; NV: ID UT AZ; ID: MT WY UT; - UT: WY CO AZ; MT: ND SD WY; WY: SD NE CO; CO: NE KA OK NM; NM: OK TX; - ND: MN SD; SD: MN IA NE; NE: IA MO KA; KA: MO OK; OK: MO AR TX; - TX: AR LA; MN: WI IA; IA: WI IL MO; MO: IL KY TN AR; AR: MS TN LA; - LA: MS; WI: MI IL; IL: IN; IN: KY; MS: TN AL; AL: TN GA FL; MI: OH; - OH: PA WV KY; KY: WV VA TN; TN: VA NC GA; GA: NC SC FL; - PA: NY NJ DE MD WV; WV: MD VA; VA: MD DC NC; NC: SC; NY: VT MA CA NJ; - NJ: DE; DE: MD; MD: DC; VT: NH MA; MA: NH RI CT; CT: RI; ME: NH; - HI: ; AK: """) -#______________________________________________________________________________ -# n-Queens Problem - -def queen_constraint(A, a, B, b): - """Constraint is satisfied (true) if A, B are really the same variable, - or if they are not in the same row, down diagonal, or up diagonal.""" - return A == B or (a != b and A + a != B + b and A - a != B - b) - -class NQueensCSP(CSP): - """Make a CSP for the nQueens problem for search with min_conflicts. - Suitable for large n, it uses only data structures of size O(n). - Think of placing queens one per column, from left to right. - That means position (x, y) represents (var, val) in the CSP. - The main structures are three arrays to count queens that could conflict: - rows[i] Number of queens in the ith row (i.e val == i) - downs[i] Number of queens in the \ diagonal - such that their (x, y) coordinates sum to i - ups[i] Number of queens in the / diagonal - such that their (x, y) coordinates have x-y+n-1 = i - We increment/decrement these counts each time a queen is placed/moved from - a row/diagonal. So moving is O(1), as is nconflicts. But choosing - a variable, and a best value for the variable, are each O(n). - If you want, you can keep track of conflicted vars, then variable - selection will also be O(1). - >>> len(backtracking_search(NQueensCSP(8))) - 8 - >>> len(min_conflicts(NQueensCSP(8))) - 8 - """ - def __init__(self, n): - """Initialize data structures for n Queens.""" - CSP.__init__(self, range(n), UniversalDict(range(n)), - UniversalDict(range(n)), queen_constraint) - update(self, rows=[0]*n, ups=[0]*(2*n - 1), downs=[0]*(2*n - 1)) - - def nconflicts(self, var, val, assignment): - """The number of conflicts, as recorded with each assignment. - Count conflicts in row and in up, down diagonals. If there - is a queen there, it can't conflict with itself, so subtract 3.""" - n = len(self.vars) - c = self.rows[val] + self.downs[var+val] + self.ups[var-val+n-1] - if assignment.get(var, None) == val: - c -= 3 - return c - - def assign(self, var, val, assignment): - "Assign var, and keep track of conflicts." - oldval = assignment.get(var, None) - if val != oldval: - if oldval is not None: # Remove old val if there was one - self.record_conflict(assignment, var, oldval, -1) - self.record_conflict(assignment, var, val, +1) - CSP.assign(self, var, val, assignment) - - def unassign(self, var, assignment): - "Remove var from assignment (if it is there) and track conflicts." - if var in assignment: - self.record_conflict(assignment, var, assignment[var], -1) - CSP.unassign(self, var, assignment) - - def record_conflict(self, assignment, var, val, delta): - "Record conflicts caused by addition or deletion of a Queen." - n = len(self.vars) - self.rows[val] += delta - self.downs[var + val] += delta - self.ups[var - val + n - 1] += delta - - def display(self, assignment): - "Print the queens and the nconflicts values (for debugging)." - n = len(self.vars) - for val in range(n): - for var in range(n): - if assignment.get(var,'') == val: ch ='Q' - elif (var+val) % 2 == 0: ch = '.' - else: ch = '-' - print ch, - print ' ', - for var in range(n): - if assignment.get(var,'') == val: ch ='*' - else: ch = ' ' - print str(self.nconflicts(var, val, assignment))+ch, - print +|# + (when (or fc mac) + (set-field! curr_domains csp (hash)) + (set-field! pruned csp (hash))) + (set-field! mcv csp mcv) + (set-field! lcv csp lcv) + (set-field! fc csp fc) + (set-field! mac csp mac)) + +(define (recursive_backtracking assignment csp) + ;; Search for a consistent assignment for the csp. + ;; Each recursive call chooses a variable, and considers values for it. + (cond + [(= (length assignment) (length (get-field vars csp))) assignment] + [else + (define var (select_unassigned_variable assignment csp)) + (define result null) + (let/ec done ;; sneaky way of getting return-like functionality + (for ([val (in-list (order_domain_values var assignment csp))]) + (when (or (get-field fc csp) (= (send csp nconflicts var val assignment) 0)) + (send csp assign var val assignment) + (set! result (recursive_backtracking assignment csp)) + (when (not (null? result)) + (done)) + (send csp unassign var assignment))) + result)])) + + +(define (select_unassigned_variable assignment csp) + ;; Select the variable to work on next. Find + (if (get-field mcv csp) ; most constrained variable + (let () + (define unassigned (filter (λ(v) (not (hash-has-key? assignment v))) (get-field vars csp))) + (argmin_random_tie unassigned (λ(var) (* -1 (num_legal_values csp var assignment))))) + ;; else first unassigned variable + (for/first ([v (in-list (get-field vars csp))] #:when (not (hash-has-key? assignment v))) + v))) + +(define (order_domain_values var assignment csp) + ;; Decide what order to consider the domain variables. + (define domain (if (get-field curr_domains csp) + (hash-ref (get-field curr_domains csp) var) + (hash-ref (get-field domains csp) var))) + (when (get-field lcv csp) + ;; If LCV is specified, consider values with fewer conflicts first + (define key (λ(val) (send csp nconflicts var val assignment))) + (set! domain (sort domain < #:key key))) + (generator () + (let loop ([niamod (reverse domain)]) + (yield (car niamod)) + (loop (cdr niamod))))) + +(define (num_legal_values csp var assignment) + (if (get-field curr_domains csp) + (length (hash-ref (get-field curr_domains csp) var)) + (count_if (λ(val) (= (send csp nconflicts var val assignment) 0)) (hash-ref (get-field domains csp) var)))) -#______________________________________________________________________________ -# The Zebra Puzzle -def Zebra(): - "Return an instance of the Zebra Puzzle." - Colors = 'Red Yellow Blue Green Ivory'.split() - Pets = 'Dog Fox Snails Horse Zebra'.split() - Drinks = 'OJ Tea Coffee Milk Water'.split() - Countries = 'Englishman Spaniard Norwegian Ukranian Japanese'.split() - Smokes = 'Kools Chesterfields Winston LuckyStrike Parliaments'.split() - vars = Colors + Pets + Drinks + Countries + Smokes - domains = {} - for var in vars: - domains[var] = range(1, 6) - domains['Norwegian'] = [1] - domains['Milk'] = [3] - neighbors = parse_neighbors("""Englishman: Red; - Spaniard: Dog; Kools: Yellow; Chesterfields: Fox; - Norwegian: Blue; Winston: Snails; LuckyStrike: OJ; - Ukranian: Tea; Japanese: Parliaments; Kools: Horse; - Coffee: Green; Green: Ivory""", vars) - for type in [Colors, Pets, Drinks, Countries, Smokes]: - for A in type: - for B in type: - if A != B: - if B not in neighbors[A]: neighbors[A].append(B) - if A not in neighbors[B]: neighbors[B].append(A) - def zebra_constraint(A, a, B, b, recurse=0): - same = (a == b) - next_to = abs(a - b) == 1 - if A == 'Englishman' and B == 'Red': return same - if A == 'Spaniard' and B == 'Dog': return same - if A == 'Chesterfields' and B == 'Fox': return next_to - if A == 'Norwegian' and B == 'Blue': return next_to - if A == 'Kools' and B == 'Yellow': return same - if A == 'Winston' and B == 'Snails': return same - if A == 'LuckyStrike' and B == 'OJ': return same - if A == 'Ukranian' and B == 'Tea': return same - if A == 'Japanese' and B == 'Parliaments': return same - if A == 'Kools' and B == 'Horse': return next_to - if A == 'Coffee' and B == 'Green': return same - if A == 'Green' and B == 'Ivory': return (a - 1) == b - if recurse == 0: return zebra_constraint(B, b, A, a, 1) - if ((A in Colors and B in Colors) or - (A in Pets and B in Pets) or - (A in Drinks and B in Drinks) or - (A in Countries and B in Countries) or - (A in Smokes and B in Smokes)): return not same - raise 'error' - return CSP(vars, domains, neighbors, zebra_constraint) +;;______________________________________________________________________________ +;; Constraint Propagation with AC-3 + + +(define (AC3 csp [queue null]) + (when (null? queue) + (set! queue (for*/list ([Xi (in-list (get-field vars csp))] + [Xk (in-list (hash-ref (get-field neighbors csp) Xi))]) + (cons Xi Xk)))) + (let loop ([eueuq (reverse queue)]) + (when (not (null? eueuq)) + (match-define (cons Xi Xj) (car eueuq)) + (set! eueuq (cdr eueuq)) ;; equivalent to python pop + (when (remove_inconsistent_values csp Xi Xj) + (set! eueuq + (append + (reverse (for/list ([Xk (in-list (hash-ref (get-field neighbors csp) Xi))]) + (cons Xk Xi))) + eueuq))) + (loop eueuq)))) + +(define (remove_inconsistent_values csp Xi Xj) + ;; Return true if we remove a value. + (define removed #f) + (for ([x (in-list (hash-ref (get-field curr_domains csp) Xi))]) + ;; If Xi=x conflicts with Xj=y for every possible y, eliminate Xi=x + (when (every (λ(y) (not (send csp constraints Xi x Xj y))) + (hash-ref (get-field curr_domains csp) Xj)) + (hash-update! (get-field curr_domains csp) Xi (λ(val) (remove val x))) + (set! removed #t))) + removed) -def solve_zebra(algorithm=min_conflicts, **args): - z = Zebra() - ans = algorithm(z, **args) - for h in range(1, 6): - print 'House', h, - for (var, val) in ans.items(): - if val == h: print var, - print - return ans['Zebra'], ans['Water'], z.nassigns, ans, - - -|# +;;______________________________________________________________________________ +;; Min-conflicts hillclimbing search for CSPs + +(define (min_conflicts csp [max_steps 1000000]) + ;; Solve a CSP by stochastic hillclimbing on the number of conflicts. + ;; Generate a complete assignment for all vars (probably with conflicts) + (define current (hash)) + (set-field! current csp current) + (for ([var (in-list (get-field vars csp))]) + (define val (min_conflicts_value csp var current)) + (send csp assign var val current)) + ;; Now repeatedly choose a random conflicted variable and change it + (define found-result #f) + (let/ec done ;; sneaky way of getting return-like functionality + (for ([i (in-range max_steps)]) + (define conflicted (send csp conflicted_vars current)) + (when (not conflicted) (set! found-result #t) (done)) + (define var (list-ref conflicted (random (length conflicted)))) + (define val (min_conflicts_value csp var current)) + (send csp assign var val current))) + (and found-result current)) + + (define (min_conflicts_value csp var current) + ;; Return the value that will give var the least number of conflicts. + ;; If there is a tie, choose at random. + (argmin_random_tie (hash-ref (get-field domains csp) var) + (λ(val) (send csp nconflicts var val current)))) + + + \ No newline at end of file diff --git a/csp/utils.rkt b/csp/utils.rkt index 510ccd4c..8ee8cd49 100644 --- a/csp/utils.rkt +++ b/csp/utils.rkt @@ -21,12 +21,23 @@ (module+ test (check-equal? (find_if procedure? (list 3 min max)) min) (check-equal? (find_if procedure? (list 1 2 3)) null)) - + (define (every pred xs) - ;;;True if every element of seq satisfies predicate. - (andmap pred xs)) + ;;;True if every element of seq satisfies predicate. + (andmap pred xs)) (module+ test (check-true (every procedure? (list min max))) - (check-false (every procedure? (list min 3)))) \ No newline at end of file + (check-false (every procedure? (list min 3)))) + + +(define (argmin_random_tie xs proc) + ;; Return an element with lowest fn(seq[i]) score; break ties at random. + ;; Thus, for all s,f: argmin_random_tie(s, f) in argmin_list(s, f) + (define assocs (map (λ(x) (cons (proc x) x)) xs)) + (define min-value (apply min (map car assocs))) + (define min-xs (map cdr (filter (λ(a) (= min-value (car a))) assocs))) + (list-ref min-xs (random (length min-xs)))) + +;(argmin_random_tie (list (range 0 4) (range 5 9) (range 10 13) (range 20 23)) length) \ No newline at end of file From c803ee3bb5cb5c35843322b6afc9037721d734aa Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Mon, 29 Sep 2014 19:44:20 -0700 Subject: [PATCH 018/246] start zebra puzzle --- csp/csp.rkt | 70 ++++++++++++++++++++++++++++++++++++++++++++++++----- 1 file changed, 64 insertions(+), 6 deletions(-) diff --git a/csp/csp.rkt b/csp/csp.rkt index 585af7e4..38f26ac6 100644 --- a/csp/csp.rkt +++ b/csp/csp.rkt @@ -248,12 +248,70 @@ Set up to do recursive backtracking search. Allow the following options: (define val (min_conflicts_value csp var current)) (send csp assign var val current))) (and found-result current)) + +(define (min_conflicts_value csp var current) + ;; Return the value that will give var the least number of conflicts. + ;; If there is a tie, choose at random. + (argmin_random_tie (hash-ref (get-field domains csp) var) + (λ(val) (send csp nconflicts var val current)))) + +;; ______________________________________________________________________________ +;; Map-Coloring Problems + +(define (parse_neighbors neighbors [vars null]) + #| + Convert a string of the form 'X: Y Z; Y: Z' into a dict mapping + regions to neighbors. The syntax is a region name followed by a ':' + followed by zero or more region names, followed by ';', repeated for + each region name. If you say 'X: Y' you don't need 'Y: X'. + >>> parse_neighbors('X: Y Z; Y: Z') + {'Y': ['X', 'Z'], 'X': ['Y', 'Z'], 'Z': ['X', 'Y']} +|# + (define nh (hash)) + + nh) + + +;; ______________________________________________________________________________ +;; The Zebra Puzzle + +(define (zebra) + ;; Return an instance of the Zebra Puzzle. + (define Colors '(Red Yellow Blue Green Ivory)) + (define Pets '(Dog Fox Snails Horse Zebra)) + (define Drinks '(OJ Tea Coffee Milk Water)) + (define Countries '(Englishman Spaniard Norwegian Ukranian Japanese)) + (define Smokes '(Kools Chesterfields Winston LuckyStrike Parliaments)) + (define vars (apply append (list Colors Pets Drinks Countries Smokes))) + (define domains (make-hash)) + (for-each (λ(var) (hash-set! domains var (range 1 6))) vars) + (hash-set! domains 'Norwegian '(1)) + (hash-set! domains 'Milk '(3)) + (define neighbors (parse_neighbors "Englishman: Red; + Spaniard: Dog; Kools: Yellow; Chesterfields: Fox; + Norwegian: Blue; Winston: Snails; LuckyStrike: OJ; + Ukranian: Tea; Japanese: Parliaments; Kools: Horse; + Coffee: Green; Green: Ivory" vars)) + + (for* ([type (in-list (list Colors Pets Drinks Countries Smokes))] + [A (in-list type)] + [B (in-list type)]) + (when (not (equal? A B)) + (when (not (memq B (hash-ref neighbors A))) + (hash-update! neighbors A (λ(v) (append v B)))) + (when (not (memq A (hash-ref neighbors B))) + (hash-update! neighbors B (λ(v) (append v A)))))) + + (define (zebra_constraint A a B b [recurse 0]) + (define same (= a b)) + (define next_to (= (abs (- a b)) 1)) + ;; resume here + (void)) + - (define (min_conflicts_value csp var current) - ;; Return the value that will give var the least number of conflicts. - ;; If there is a tie, choose at random. - (argmin_random_tie (hash-ref (get-field domains csp) var) - (λ(val) (send csp nconflicts var val current)))) + (new CSP [vars vars] [domains domains] [neighbors neighbors] [constraints zebra_constraint])) - \ No newline at end of file +(module+ main + ; (zebra) + ) \ No newline at end of file From 6e8edaa1358d6883005ab3e3afb4ec88809116cc Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Tue, 30 Sep 2014 11:12:45 -0700 Subject: [PATCH 019/246] parse-neighbors --- csp/csp.rkt | 17 ++++++++++++++--- 1 file changed, 14 insertions(+), 3 deletions(-) diff --git a/csp/csp.rkt b/csp/csp.rkt index 38f26ac6..9178af97 100644 --- a/csp/csp.rkt +++ b/csp/csp.rkt @@ -3,7 +3,7 @@ ;; Adapted from work by Peter Norvig ;; http://aima-python.googlecode.com/svn/trunk/csp.py -(require racket/list racket/bool racket/contract racket/class racket/match racket/generator) +(require racket/list racket/bool racket/contract racket/class racket/match racket/generator racket/string) (require "utils.rkt" "search.rkt") (define CSP (class Problem @@ -267,10 +267,21 @@ Set up to do recursive backtracking search. Allow the following options: >>> parse_neighbors('X: Y Z; Y: Z') {'Y': ['X', 'Z'], 'X': ['Y', 'Z'], 'Z': ['X', 'Y']} |# - (define nh (hash)) - + (define nh (make-hash)) + (for ([v (in-list vars)]) (hash-set! nh v null)) + (define specs (for/list ([spec (in-list (string-split neighbors ";"))]) (string-split spec ":"))) + (for ([pair (in-list specs)]) + (match-define (list A Aneighbors) pair) + (set! A (string-trim A)) + (hash-ref! nh A null) + (for ([B (in-list (string-split Aneighbors))]) + (hash-update! nh A (λ(v) (append v (list B))) null) + (hash-update! nh B (λ(v) (append v (list A))) null))) nh) +(module+ test + (parse_neighbors "X: Y Z; Y: Z")) + ;; ______________________________________________________________________________ ;; The Zebra Puzzle From a404ba169fa588d27dca44b07fb5734a47dd7e8b Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Tue, 30 Sep 2014 11:27:50 -0700 Subject: [PATCH 020/246] ready to solve? --- csp/csp.rkt | 39 ++++++++++++++++++++++++++++++++++----- 1 file changed, 34 insertions(+), 5 deletions(-) diff --git a/csp/csp.rkt b/csp/csp.rkt index 9178af97..f101ebb6 100644 --- a/csp/csp.rkt +++ b/csp/csp.rkt @@ -6,6 +6,8 @@ (require racket/list racket/bool racket/contract racket/class racket/match racket/generator racket/string) (require "utils.rkt" "search.rkt") +(module+ test (require rackunit)) + (define CSP (class Problem #| This class describes finite-domain Constraint Satisfaction Problems. @@ -280,7 +282,7 @@ Set up to do recursive backtracking search. Allow the following options: nh) (module+ test - (parse_neighbors "X: Y Z; Y: Z")) + (check-equal? (sort (hash->list (parse_neighbors "X: Y Z; Y: Z")) string Date: Tue, 30 Sep 2014 12:46:23 -0700 Subject: [PATCH 021/246] python-constraint library --- csp/python-constraint/LICENSE | 23 + csp/python-constraint/MANIFEST.in | 2 + csp/python-constraint/PKG-INFO | 13 + csp/python-constraint/README | 1 + csp/python-constraint/constraint.py | 1434 +++++++++++++++++ csp/python-constraint/examples/abc/abc.py | 30 + csp/python-constraint/examples/coins/coins.py | 30 + .../examples/crosswords/crosswords.py | 153 ++ .../examples/crosswords/large.mask | 27 + .../examples/crosswords/medium.mask | 19 + .../examples/crosswords/python.mask | 8 + .../examples/crosswords/small.mask | 8 + .../examples/einstein/einstein.py | 201 +++ .../examples/einstein/einstein2.py | 190 +++ .../examples/queens/queens.py | 47 + csp/python-constraint/examples/rooks/rooks.py | 49 + .../examples/studentdesks/studentdesks.py | 39 + .../examples/sudoku/sudoku.py | 61 + .../examples/wordmath/seisseisdoze.py | 32 + .../examples/wordmath/sendmoremoney.py | 34 + .../examples/wordmath/twotwofour.py | 28 + csp/python-constraint/examples/xsum/xsum.py | 37 + csp/python-constraint/setup.cfg | 6 + csp/python-constraint/setup.py | 21 + 24 files changed, 2493 insertions(+) create mode 100644 csp/python-constraint/LICENSE create mode 100644 csp/python-constraint/MANIFEST.in create mode 100644 csp/python-constraint/PKG-INFO create mode 100644 csp/python-constraint/README create mode 100644 csp/python-constraint/constraint.py create mode 100755 csp/python-constraint/examples/abc/abc.py create mode 100755 csp/python-constraint/examples/coins/coins.py create mode 100755 csp/python-constraint/examples/crosswords/crosswords.py create mode 100644 csp/python-constraint/examples/crosswords/large.mask create mode 100644 csp/python-constraint/examples/crosswords/medium.mask create mode 100644 csp/python-constraint/examples/crosswords/python.mask create mode 100644 csp/python-constraint/examples/crosswords/small.mask create mode 100755 csp/python-constraint/examples/einstein/einstein.py create mode 100755 csp/python-constraint/examples/einstein/einstein2.py create mode 100755 csp/python-constraint/examples/queens/queens.py create mode 100755 csp/python-constraint/examples/rooks/rooks.py create mode 100755 csp/python-constraint/examples/studentdesks/studentdesks.py create mode 100644 csp/python-constraint/examples/sudoku/sudoku.py create mode 100755 csp/python-constraint/examples/wordmath/seisseisdoze.py create mode 100755 csp/python-constraint/examples/wordmath/sendmoremoney.py create mode 100755 csp/python-constraint/examples/wordmath/twotwofour.py create mode 100755 csp/python-constraint/examples/xsum/xsum.py create mode 100644 csp/python-constraint/setup.cfg create mode 100755 csp/python-constraint/setup.py diff --git a/csp/python-constraint/LICENSE b/csp/python-constraint/LICENSE new file mode 100644 index 00000000..1551a23a --- /dev/null +++ b/csp/python-constraint/LICENSE @@ -0,0 +1,23 @@ +Copyright (c) 2005-2014 - Gustavo Niemeyer + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + +1. Redistributions of source code must retain the above copyright notice, this + list of conditions and the following disclaimer. +2. Redistributions in binary form must reproduce the above copyright notice, + this list of conditions and the following disclaimer in the documentation + and/or other materials provided with the distribution. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND +ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED +WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE +DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR +ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES +(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; +LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND +ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS +SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/csp/python-constraint/MANIFEST.in b/csp/python-constraint/MANIFEST.in new file mode 100644 index 00000000..18b718a2 --- /dev/null +++ b/csp/python-constraint/MANIFEST.in @@ -0,0 +1,2 @@ +include constraint.py setup.py setup.cfg README LICENSE MANIFEST.in +recursive-include examples *.py *.mask diff --git a/csp/python-constraint/PKG-INFO b/csp/python-constraint/PKG-INFO new file mode 100644 index 00000000..f3a51345 --- /dev/null +++ b/csp/python-constraint/PKG-INFO @@ -0,0 +1,13 @@ +Metadata-Version: 1.0 +Name: python-constraint +Version: 1.2 +Summary: Python module for handling Constraint Solving Problems +Home-page: http://labix.org/python-constraint +Author: Gustavo Niemeyer +Author-email: gustavo@niemeyer.net +License: Simplified BSD +Description: + python-constraint is a module implementing support for handling CSPs + (Constraint Solving Problems) over finite domains. + +Platform: UNKNOWN diff --git a/csp/python-constraint/README b/csp/python-constraint/README new file mode 100644 index 00000000..625e7075 --- /dev/null +++ b/csp/python-constraint/README @@ -0,0 +1 @@ +See http://labix.org/constraint diff --git a/csp/python-constraint/constraint.py b/csp/python-constraint/constraint.py new file mode 100644 index 00000000..b1cd836b --- /dev/null +++ b/csp/python-constraint/constraint.py @@ -0,0 +1,1434 @@ +#!/usr/bin/python +# +# Copyright (c) 2005-2014 - Gustavo Niemeyer +# +# All rights reserved. +# +# Redistribution and use in source and binary forms, with or without +# modification, are permitted provided that the following conditions are met: +# +# 1. Redistributions of source code must retain the above copyright notice, this +# list of conditions and the following disclaimer. +# 2. Redistributions in binary form must reproduce the above copyright notice, +# this list of conditions and the following disclaimer in the documentation +# and/or other materials provided with the distribution. +# +# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +# AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE +# DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE +# FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +# DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +# SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +# CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +# OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +# OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +""" +@var Unassigned: Helper object instance representing unassigned values + +@sort: Problem, Variable, Domain +@group Solvers: Solver, + BacktrackingSolver, + RecursiveBacktrackingSolver, + MinConflictsSolver +@group Constraints: Constraint, + FunctionConstraint, + AllDifferentConstraint, + AllEqualConstraint, + MaxSumConstraint, + ExactSumConstraint, + MinSumConstraint, + InSetConstraint, + NotInSetConstraint, + SomeInSetConstraint, + SomeNotInSetConstraint +""" +import random +import copy + +__all__ = ["Problem", "Variable", "Domain", "Unassigned", + "Solver", "BacktrackingSolver", "RecursiveBacktrackingSolver", + "MinConflictsSolver", "Constraint", "FunctionConstraint", + "AllDifferentConstraint", "AllEqualConstraint", "MaxSumConstraint", + "ExactSumConstraint", "MinSumConstraint", "InSetConstraint", + "NotInSetConstraint", "SomeInSetConstraint", + "SomeNotInSetConstraint"] + +class Problem(object): + """ + Class used to define a problem and retrieve solutions + """ + + def __init__(self, solver=None): + """ + @param solver: Problem solver used to find solutions + (default is L{BacktrackingSolver}) + @type solver: instance of a L{Solver} subclass + """ + self._solver = solver or BacktrackingSolver() + self._constraints = [] + self._variables = {} + + def reset(self): + """ + Reset the current problem definition + + Example: + + >>> problem = Problem() + >>> problem.addVariable("a", [1, 2]) + >>> problem.reset() + >>> problem.getSolution() + >>> + """ + del self._constraints[:] + self._variables.clear() + + def setSolver(self, solver): + """ + Change the problem solver currently in use + + Example: + + >>> solver = BacktrackingSolver() + >>> problem = Problem(solver) + >>> problem.getSolver() is solver + True + + @param solver: New problem solver + @type solver: instance of a C{Solver} subclass + """ + self._solver = solver + + def getSolver(self): + """ + Obtain the problem solver currently in use + + Example: + + >>> solver = BacktrackingSolver() + >>> problem = Problem(solver) + >>> problem.getSolver() is solver + True + + @return: Solver currently in use + @rtype: instance of a L{Solver} subclass + """ + return self._solver + + def addVariable(self, variable, domain): + """ + Add a variable to the problem + + Example: + + >>> problem = Problem() + >>> problem.addVariable("a", [1, 2]) + >>> problem.getSolution() in ({'a': 1}, {'a': 2}) + True + + @param variable: Object representing a problem variable + @type variable: hashable object + @param domain: Set of items defining the possible values that + the given variable may assume + @type domain: list, tuple, or instance of C{Domain} + """ + if variable in self._variables: + raise ValueError, "Tried to insert duplicated variable %s" % \ + repr(variable) + if type(domain) in (list, tuple): + domain = Domain(domain) + elif isinstance(domain, Domain): + domain = copy.copy(domain) + else: + raise TypeError, "Domains must be instances of subclasses of "\ + "the Domain class" + if not domain: + raise ValueError, "Domain is empty" + self._variables[variable] = domain + + def addVariables(self, variables, domain): + """ + Add one or more variables to the problem + + Example: + + >>> problem = Problem() + >>> problem.addVariables(["a", "b"], [1, 2, 3]) + >>> solutions = problem.getSolutions() + >>> len(solutions) + 9 + >>> {'a': 3, 'b': 1} in solutions + True + + @param variables: Any object containing a sequence of objects + represeting problem variables + @type variables: sequence of hashable objects + @param domain: Set of items defining the possible values that + the given variables may assume + @type domain: list, tuple, or instance of C{Domain} + """ + for variable in variables: + self.addVariable(variable, domain) + + def addConstraint(self, constraint, variables=None): + """ + Add a constraint to the problem + + Example: + + >>> problem = Problem() + >>> problem.addVariables(["a", "b"], [1, 2, 3]) + >>> problem.addConstraint(lambda a, b: b == a+1, ["a", "b"]) + >>> solutions = problem.getSolutions() + >>> + + @param constraint: Constraint to be included in the problem + @type constraint: instance a L{Constraint} subclass or a + function to be wrapped by L{FunctionConstraint} + @param variables: Variables affected by the constraint (default to + all variables). Depending on the constraint type + the order may be important. + @type variables: set or sequence of variables + """ + if not isinstance(constraint, Constraint): + if callable(constraint): + constraint = FunctionConstraint(constraint) + else: + raise ValueError, "Constraints must be instances of "\ + "subclasses of the Constraint class" + self._constraints.append((constraint, variables)) + + def getSolution(self): + """ + Find and return a solution to the problem + + Example: + + >>> problem = Problem() + >>> problem.getSolution() is None + True + >>> problem.addVariables(["a"], [42]) + >>> problem.getSolution() + {'a': 42} + + @return: Solution for the problem + @rtype: dictionary mapping variables to values + """ + domains, constraints, vconstraints = self._getArgs() + if not domains: + return None + return self._solver.getSolution(domains, constraints, vconstraints) + + def getSolutions(self): + """ + Find and return all solutions to the problem + + Example: + + >>> problem = Problem() + >>> problem.getSolutions() == [] + True + >>> problem.addVariables(["a"], [42]) + >>> problem.getSolutions() + [{'a': 42}] + + @return: All solutions for the problem + @rtype: list of dictionaries mapping variables to values + """ + domains, constraints, vconstraints = self._getArgs() + if not domains: + return [] + return self._solver.getSolutions(domains, constraints, vconstraints) + + def getSolutionIter(self): + """ + Return an iterator to the solutions of the problem + + Example: + + >>> problem = Problem() + >>> list(problem.getSolutionIter()) == [] + True + >>> problem.addVariables(["a"], [42]) + >>> iter = problem.getSolutionIter() + >>> iter.next() + {'a': 42} + >>> iter.next() + Traceback (most recent call last): + File "", line 1, in ? + StopIteration + """ + domains, constraints, vconstraints = self._getArgs() + if not domains: + return iter(()) + return self._solver.getSolutionIter(domains, constraints, + vconstraints) + + def _getArgs(self): + domains = self._variables.copy() + allvariables = domains.keys() + constraints = [] + for constraint, variables in self._constraints: + if not variables: + variables = allvariables + constraints.append((constraint, variables)) + vconstraints = {} + for variable in domains: + vconstraints[variable] = [] + for constraint, variables in constraints: + for variable in variables: + vconstraints[variable].append((constraint, variables)) + for constraint, variables in constraints[:]: + constraint.preProcess(variables, domains, + constraints, vconstraints) + for domain in domains.values(): + domain.resetState() + if not domain: + return None, None, None + #doArc8(getArcs(domains, constraints), domains, {}) + return domains, constraints, vconstraints + +# ---------------------------------------------------------------------- +# Solvers +# ---------------------------------------------------------------------- + +def getArcs(domains, constraints): + """ + Return a dictionary mapping pairs (arcs) of constrained variables + + @attention: Currently unused. + """ + arcs = {} + for x in constraints: + constraint, variables = x + if len(variables) == 2: + variable1, variable2 = variables + arcs.setdefault(variable1, {})\ + .setdefault(variable2, [])\ + .append(x) + arcs.setdefault(variable2, {})\ + .setdefault(variable1, [])\ + .append(x) + return arcs + +def doArc8(arcs, domains, assignments): + """ + Perform the ARC-8 arc checking algorithm and prune domains + + @attention: Currently unused. + """ + check = dict.fromkeys(domains, True) + while check: + variable, _ = check.popitem() + if variable not in arcs or variable in assignments: + continue + domain = domains[variable] + arcsvariable = arcs[variable] + for othervariable in arcsvariable: + arcconstraints = arcsvariable[othervariable] + if othervariable in assignments: + otherdomain = [assignments[othervariable]] + else: + otherdomain = domains[othervariable] + if domain: + changed = False + for value in domain[:]: + assignments[variable] = value + if otherdomain: + for othervalue in otherdomain: + assignments[othervariable] = othervalue + for constraint, variables in arcconstraints: + if not constraint(variables, domains, + assignments, True): + break + else: + # All constraints passed. Value is safe. + break + else: + # All othervalues failed. Kill value. + domain.hideValue(value) + changed = True + del assignments[othervariable] + del assignments[variable] + #if changed: + # check.update(dict.fromkeys(arcsvariable)) + if not domain: + return False + return True + +class Solver(object): + """ + Abstract base class for solvers + + @sort: getSolution, getSolutions, getSolutionIter + """ + + def getSolution(self, domains, constraints, vconstraints): + """ + Return one solution for the given problem + + @param domains: Dictionary mapping variables to their domains + @type domains: dict + @param constraints: List of pairs of (constraint, variables) + @type constraints: list + @param vconstraints: Dictionary mapping variables to a list of + constraints affecting the given variables. + @type vconstraints: dict + """ + raise NotImplementedError, \ + "%s is an abstract class" % self.__class__.__name__ + + def getSolutions(self, domains, constraints, vconstraints): + """ + Return all solutions for the given problem + + @param domains: Dictionary mapping variables to domains + @type domains: dict + @param constraints: List of pairs of (constraint, variables) + @type constraints: list + @param vconstraints: Dictionary mapping variables to a list of + constraints affecting the given variables. + @type vconstraints: dict + """ + raise NotImplementedError, \ + "%s provides only a single solution" % self.__class__.__name__ + + def getSolutionIter(self, domains, constraints, vconstraints): + """ + Return an iterator for the solutions of the given problem + + @param domains: Dictionary mapping variables to domains + @type domains: dict + @param constraints: List of pairs of (constraint, variables) + @type constraints: list + @param vconstraints: Dictionary mapping variables to a list of + constraints affecting the given variables. + @type vconstraints: dict + """ + raise NotImplementedError, \ + "%s doesn't provide iteration" % self.__class__.__name__ + +class BacktrackingSolver(Solver): + """ + Problem solver with backtracking capabilities + + Examples: + + >>> result = [[('a', 1), ('b', 2)], + ... [('a', 1), ('b', 3)], + ... [('a', 2), ('b', 3)]] + + >>> problem = Problem(BacktrackingSolver()) + >>> problem.addVariables(["a", "b"], [1, 2, 3]) + >>> problem.addConstraint(lambda a, b: b > a, ["a", "b"]) + + >>> solution = problem.getSolution() + >>> sorted(solution.items()) in result + True + + >>> for solution in problem.getSolutionIter(): + ... sorted(solution.items()) in result + True + True + True + + >>> for solution in problem.getSolutions(): + ... sorted(solution.items()) in result + True + True + True + """#""" + + def __init__(self, forwardcheck=True): + """ + @param forwardcheck: If false forward checking will not be requested + to constraints while looking for solutions + (default is true) + @type forwardcheck: bool + """ + self._forwardcheck = forwardcheck + + def getSolutionIter(self, domains, constraints, vconstraints): + forwardcheck = self._forwardcheck + assignments = {} + + queue = [] + + while True: + + # Mix the Degree and Minimum Remaing Values (MRV) heuristics + lst = [(-len(vconstraints[variable]), + len(domains[variable]), variable) for variable in domains] + lst.sort() + for item in lst: + if item[-1] not in assignments: + # Found unassigned variable + variable = item[-1] + values = domains[variable][:] + if forwardcheck: + pushdomains = [domains[x] for x in domains + if x not in assignments and + x != variable] + else: + pushdomains = None + break + else: + # No unassigned variables. We've got a solution. Go back + # to last variable, if there's one. + yield assignments.copy() + if not queue: + return + variable, values, pushdomains = queue.pop() + if pushdomains: + for domain in pushdomains: + domain.popState() + + while True: + # We have a variable. Do we have any values left? + if not values: + # No. Go back to last variable, if there's one. + del assignments[variable] + while queue: + variable, values, pushdomains = queue.pop() + if pushdomains: + for domain in pushdomains: + domain.popState() + if values: + break + del assignments[variable] + else: + return + + # Got a value. Check it. + assignments[variable] = values.pop() + + if pushdomains: + for domain in pushdomains: + domain.pushState() + + for constraint, variables in vconstraints[variable]: + if not constraint(variables, domains, assignments, + pushdomains): + # Value is not good. + break + else: + break + + if pushdomains: + for domain in pushdomains: + domain.popState() + + # Push state before looking for next variable. + queue.append((variable, values, pushdomains)) + + raise RuntimeError, "Can't happen" + + def getSolution(self, domains, constraints, vconstraints): + iter = self.getSolutionIter(domains, constraints, vconstraints) + try: + return iter.next() + except StopIteration: + return None + + def getSolutions(self, domains, constraints, vconstraints): + return list(self.getSolutionIter(domains, constraints, vconstraints)) + + +class RecursiveBacktrackingSolver(Solver): + """ + Recursive problem solver with backtracking capabilities + + Examples: + + >>> result = [[('a', 1), ('b', 2)], + ... [('a', 1), ('b', 3)], + ... [('a', 2), ('b', 3)]] + + >>> problem = Problem(RecursiveBacktrackingSolver()) + >>> problem.addVariables(["a", "b"], [1, 2, 3]) + >>> problem.addConstraint(lambda a, b: b > a, ["a", "b"]) + + >>> solution = problem.getSolution() + >>> sorted(solution.items()) in result + True + + >>> for solution in problem.getSolutions(): + ... sorted(solution.items()) in result + True + True + True + + >>> problem.getSolutionIter() + Traceback (most recent call last): + ... + NotImplementedError: RecursiveBacktrackingSolver doesn't provide iteration + """#""" + + def __init__(self, forwardcheck=True): + """ + @param forwardcheck: If false forward checking will not be requested + to constraints while looking for solutions + (default is true) + @type forwardcheck: bool + """ + self._forwardcheck = forwardcheck + + def recursiveBacktracking(self, solutions, domains, vconstraints, + assignments, single): + + # Mix the Degree and Minimum Remaing Values (MRV) heuristics + lst = [(-len(vconstraints[variable]), + len(domains[variable]), variable) for variable in domains] + lst.sort() + for item in lst: + if item[-1] not in assignments: + # Found an unassigned variable. Let's go. + break + else: + # No unassigned variables. We've got a solution. + solutions.append(assignments.copy()) + return solutions + + variable = item[-1] + assignments[variable] = None + + forwardcheck = self._forwardcheck + if forwardcheck: + pushdomains = [domains[x] for x in domains if x not in assignments] + else: + pushdomains = None + + for value in domains[variable]: + assignments[variable] = value + if pushdomains: + for domain in pushdomains: + domain.pushState() + for constraint, variables in vconstraints[variable]: + if not constraint(variables, domains, assignments, + pushdomains): + # Value is not good. + break + else: + # Value is good. Recurse and get next variable. + self.recursiveBacktracking(solutions, domains, vconstraints, + assignments, single) + if solutions and single: + return solutions + if pushdomains: + for domain in pushdomains: + domain.popState() + del assignments[variable] + return solutions + + def getSolution(self, domains, constraints, vconstraints): + solutions = self.recursiveBacktracking([], domains, vconstraints, + {}, True) + return solutions and solutions[0] or None + + def getSolutions(self, domains, constraints, vconstraints): + return self.recursiveBacktracking([], domains, vconstraints, + {}, False) + + +class MinConflictsSolver(Solver): + """ + Problem solver based on the minimum conflicts theory + + Examples: + + >>> result = [[('a', 1), ('b', 2)], + ... [('a', 1), ('b', 3)], + ... [('a', 2), ('b', 3)]] + + >>> problem = Problem(MinConflictsSolver()) + >>> problem.addVariables(["a", "b"], [1, 2, 3]) + >>> problem.addConstraint(lambda a, b: b > a, ["a", "b"]) + + >>> solution = problem.getSolution() + >>> sorted(solution.items()) in result + True + + >>> problem.getSolutions() + Traceback (most recent call last): + ... + NotImplementedError: MinConflictsSolver provides only a single solution + + >>> problem.getSolutionIter() + Traceback (most recent call last): + ... + NotImplementedError: MinConflictsSolver doesn't provide iteration + """#""" + + def __init__(self, steps=1000): + """ + @param steps: Maximum number of steps to perform before giving up + when looking for a solution (default is 1000) + @type steps: int + """ + self._steps = steps + + def getSolution(self, domains, constraints, vconstraints): + assignments = {} + # Initial assignment + for variable in domains: + assignments[variable] = random.choice(domains[variable]) + for _ in xrange(self._steps): + conflicted = False + lst = domains.keys() + random.shuffle(lst) + for variable in lst: + # Check if variable is not in conflict + for constraint, variables in vconstraints[variable]: + if not constraint(variables, domains, assignments): + break + else: + continue + # Variable has conflicts. Find values with less conflicts. + mincount = len(vconstraints[variable]) + minvalues = [] + for value in domains[variable]: + assignments[variable] = value + count = 0 + for constraint, variables in vconstraints[variable]: + if not constraint(variables, domains, assignments): + count += 1 + if count == mincount: + minvalues.append(value) + elif count < mincount: + mincount = count + del minvalues[:] + minvalues.append(value) + # Pick a random one from these values. + assignments[variable] = random.choice(minvalues) + conflicted = True + if not conflicted: + return assignments + return None + +# ---------------------------------------------------------------------- +# Variables +# ---------------------------------------------------------------------- + +class Variable(object): + """ + Helper class for variable definition + + Using this class is optional, since any hashable object, + including plain strings and integers, may be used as variables. + """ + + def __init__(self, name): + """ + @param name: Generic variable name for problem-specific purposes + @type name: string + """ + self.name = name + + def __repr__(self): + return self.name + +Unassigned = Variable("Unassigned") + +# ---------------------------------------------------------------------- +# Domains +# ---------------------------------------------------------------------- + +class Domain(list): + """ + Class used to control possible values for variables + + When list or tuples are used as domains, they are automatically + converted to an instance of that class. + """ + + def __init__(self, set): + """ + @param set: Set of values that the given variables may assume + @type set: set of objects comparable by equality + """ + list.__init__(self, set) + self._hidden = [] + self._states = [] + + def resetState(self): + """ + Reset to the original domain state, including all possible values + """ + self.extend(self._hidden) + del self._hidden[:] + del self._states[:] + + def pushState(self): + """ + Save current domain state + + Variables hidden after that call are restored when that state + is popped from the stack. + """ + self._states.append(len(self)) + + def popState(self): + """ + Restore domain state from the top of the stack + + Variables hidden since the last popped state are then available + again. + """ + diff = self._states.pop()-len(self) + if diff: + self.extend(self._hidden[-diff:]) + del self._hidden[-diff:] + + def hideValue(self, value): + """ + Hide the given value from the domain + + After that call the given value won't be seen as a possible value + on that domain anymore. The hidden value will be restored when the + previous saved state is popped. + + @param value: Object currently available in the domain + """ + list.remove(self, value) + self._hidden.append(value) + +# ---------------------------------------------------------------------- +# Constraints +# ---------------------------------------------------------------------- + +class Constraint(object): + """ + Abstract base class for constraints + """ + + def __call__(self, variables, domains, assignments, forwardcheck=False): + """ + Perform the constraint checking + + If the forwardcheck parameter is not false, besides telling if + the constraint is currently broken or not, the constraint + implementation may choose to hide values from the domains of + unassigned variables to prevent them from being used, and thus + prune the search space. + + @param variables: Variables affected by that constraint, in the + same order provided by the user + @type variables: sequence + @param domains: Dictionary mapping variables to their domains + @type domains: dict + @param assignments: Dictionary mapping assigned variables to their + current assumed value + @type assignments: dict + @param forwardcheck: Boolean value stating whether forward checking + should be performed or not + @return: Boolean value stating if this constraint is currently + broken or not + @rtype: bool + """#""" + return True + + def preProcess(self, variables, domains, constraints, vconstraints): + """ + Preprocess variable domains + + This method is called before starting to look for solutions, + and is used to prune domains with specific constraint logic + when possible. For instance, any constraints with a single + variable may be applied on all possible values and removed, + since they may act on individual values even without further + knowledge about other assignments. + + @param variables: Variables affected by that constraint, in the + same order provided by the user + @type variables: sequence + @param domains: Dictionary mapping variables to their domains + @type domains: dict + @param constraints: List of pairs of (constraint, variables) + @type constraints: list + @param vconstraints: Dictionary mapping variables to a list of + constraints affecting the given variables. + @type vconstraints: dict + """#""" + if len(variables) == 1: + variable = variables[0] + domain = domains[variable] + for value in domain[:]: + if not self(variables, domains, {variable: value}): + domain.remove(value) + constraints.remove((self, variables)) + vconstraints[variable].remove((self, variables)) + + def forwardCheck(self, variables, domains, assignments, + _unassigned=Unassigned): + """ + Helper method for generic forward checking + + Currently, this method acts only when there's a single + unassigned variable. + + @param variables: Variables affected by that constraint, in the + same order provided by the user + @type variables: sequence + @param domains: Dictionary mapping variables to their domains + @type domains: dict + @param assignments: Dictionary mapping assigned variables to their + current assumed value + @type assignments: dict + @return: Boolean value stating if this constraint is currently + broken or not + @rtype: bool + """#""" + unassignedvariable = _unassigned + for variable in variables: + if variable not in assignments: + if unassignedvariable is _unassigned: + unassignedvariable = variable + else: + break + else: + if unassignedvariable is not _unassigned: + # Remove from the unassigned variable domain's all + # values which break our variable's constraints. + domain = domains[unassignedvariable] + if domain: + for value in domain[:]: + assignments[unassignedvariable] = value + if not self(variables, domains, assignments): + domain.hideValue(value) + del assignments[unassignedvariable] + if not domain: + return False + return True + +class FunctionConstraint(Constraint): + """ + Constraint which wraps a function defining the constraint logic + + Examples: + + >>> problem = Problem() + >>> problem.addVariables(["a", "b"], [1, 2]) + >>> def func(a, b): + ... return b > a + >>> problem.addConstraint(func, ["a", "b"]) + >>> problem.getSolution() + {'a': 1, 'b': 2} + + >>> problem = Problem() + >>> problem.addVariables(["a", "b"], [1, 2]) + >>> def func(a, b): + ... return b > a + >>> problem.addConstraint(FunctionConstraint(func), ["a", "b"]) + >>> problem.getSolution() + {'a': 1, 'b': 2} + """#""" + + def __init__(self, func, assigned=True): + """ + @param func: Function wrapped and queried for constraint logic + @type func: callable object + @param assigned: Whether the function may receive unassigned + variables or not + @type assigned: bool + """ + self._func = func + self._assigned = assigned + + def __call__(self, variables, domains, assignments, forwardcheck=False, + _unassigned=Unassigned): + parms = [assignments.get(x, _unassigned) for x in variables] + missing = parms.count(_unassigned) + if missing: + return ((self._assigned or self._func(*parms)) and + (not forwardcheck or missing != 1 or + self.forwardCheck(variables, domains, assignments))) + return self._func(*parms) + +class AllDifferentConstraint(Constraint): + """ + Constraint enforcing that values of all given variables are different + + Example: + + >>> problem = Problem() + >>> problem.addVariables(["a", "b"], [1, 2]) + >>> problem.addConstraint(AllDifferentConstraint()) + >>> sorted(sorted(x.items()) for x in problem.getSolutions()) + [[('a', 1), ('b', 2)], [('a', 2), ('b', 1)]] + """#""" + + def __call__(self, variables, domains, assignments, forwardcheck=False, + _unassigned=Unassigned): + seen = {} + for variable in variables: + value = assignments.get(variable, _unassigned) + if value is not _unassigned: + if value in seen: + return False + seen[value] = True + if forwardcheck: + for variable in variables: + if variable not in assignments: + domain = domains[variable] + for value in seen: + if value in domain: + domain.hideValue(value) + if not domain: + return False + return True + +class AllEqualConstraint(Constraint): + """ + Constraint enforcing that values of all given variables are equal + + Example: + + >>> problem = Problem() + >>> problem.addVariables(["a", "b"], [1, 2]) + >>> problem.addConstraint(AllEqualConstraint()) + >>> sorted(sorted(x.items()) for x in problem.getSolutions()) + [[('a', 1), ('b', 1)], [('a', 2), ('b', 2)]] + """#""" + + def __call__(self, variables, domains, assignments, forwardcheck=False, + _unassigned=Unassigned): + singlevalue = _unassigned + for variable in variables: + value = assignments.get(variable, _unassigned) + if singlevalue is _unassigned: + singlevalue = value + elif value is not _unassigned and value != singlevalue: + return False + if forwardcheck and singlevalue is not _unassigned: + for variable in variables: + if variable not in assignments: + domain = domains[variable] + if singlevalue not in domain: + return False + for value in domain[:]: + if value != singlevalue: + domain.hideValue(value) + return True + +class MaxSumConstraint(Constraint): + """ + Constraint enforcing that values of given variables sum up to + a given amount + + Example: + + >>> problem = Problem() + >>> problem.addVariables(["a", "b"], [1, 2]) + >>> problem.addConstraint(MaxSumConstraint(3)) + >>> sorted(sorted(x.items()) for x in problem.getSolutions()) + [[('a', 1), ('b', 1)], [('a', 1), ('b', 2)], [('a', 2), ('b', 1)]] + """#""" + + def __init__(self, maxsum, multipliers=None): + """ + @param maxsum: Value to be considered as the maximum sum + @type maxsum: number + @param multipliers: If given, variable values will be multiplied by + the given factors before being summed to be checked + @type multipliers: sequence of numbers + """ + self._maxsum = maxsum + self._multipliers = multipliers + + def preProcess(self, variables, domains, constraints, vconstraints): + Constraint.preProcess(self, variables, domains, + constraints, vconstraints) + multipliers = self._multipliers + maxsum = self._maxsum + if multipliers: + for variable, multiplier in zip(variables, multipliers): + domain = domains[variable] + for value in domain[:]: + if value*multiplier > maxsum: + domain.remove(value) + else: + for variable in variables: + domain = domains[variable] + for value in domain[:]: + if value > maxsum: + domain.remove(value) + + def __call__(self, variables, domains, assignments, forwardcheck=False): + multipliers = self._multipliers + maxsum = self._maxsum + sum = 0 + if multipliers: + for variable, multiplier in zip(variables, multipliers): + if variable in assignments: + sum += assignments[variable]*multiplier + if type(sum) is float: + sum = round(sum, 10) + if sum > maxsum: + return False + if forwardcheck: + for variable, multiplier in zip(variables, multipliers): + if variable not in assignments: + domain = domains[variable] + for value in domain[:]: + if sum+value*multiplier > maxsum: + domain.hideValue(value) + if not domain: + return False + else: + for variable in variables: + if variable in assignments: + sum += assignments[variable] + if type(sum) is float: + sum = round(sum, 10) + if sum > maxsum: + return False + if forwardcheck: + for variable in variables: + if variable not in assignments: + domain = domains[variable] + for value in domain[:]: + if sum+value > maxsum: + domain.hideValue(value) + if not domain: + return False + return True + +class ExactSumConstraint(Constraint): + """ + Constraint enforcing that values of given variables sum exactly + to a given amount + + Example: + + >>> problem = Problem() + >>> problem.addVariables(["a", "b"], [1, 2]) + >>> problem.addConstraint(ExactSumConstraint(3)) + >>> sorted(sorted(x.items()) for x in problem.getSolutions()) + [[('a', 1), ('b', 2)], [('a', 2), ('b', 1)]] + """#""" + + def __init__(self, exactsum, multipliers=None): + """ + @param exactsum: Value to be considered as the exact sum + @type exactsum: number + @param multipliers: If given, variable values will be multiplied by + the given factors before being summed to be checked + @type multipliers: sequence of numbers + """ + self._exactsum = exactsum + self._multipliers = multipliers + + def preProcess(self, variables, domains, constraints, vconstraints): + Constraint.preProcess(self, variables, domains, + constraints, vconstraints) + multipliers = self._multipliers + exactsum = self._exactsum + if multipliers: + for variable, multiplier in zip(variables, multipliers): + domain = domains[variable] + for value in domain[:]: + if value*multiplier > exactsum: + domain.remove(value) + else: + for variable in variables: + domain = domains[variable] + for value in domain[:]: + if value > exactsum: + domain.remove(value) + + def __call__(self, variables, domains, assignments, forwardcheck=False): + multipliers = self._multipliers + exactsum = self._exactsum + sum = 0 + missing = False + if multipliers: + for variable, multiplier in zip(variables, multipliers): + if variable in assignments: + sum += assignments[variable]*multiplier + else: + missing = True + if type(sum) is float: + sum = round(sum, 10) + if sum > exactsum: + return False + if forwardcheck and missing: + for variable, multiplier in zip(variables, multipliers): + if variable not in assignments: + domain = domains[variable] + for value in domain[:]: + if sum+value*multiplier > exactsum: + domain.hideValue(value) + if not domain: + return False + else: + for variable in variables: + if variable in assignments: + sum += assignments[variable] + else: + missing = True + if type(sum) is float: + sum = round(sum, 10) + if sum > exactsum: + return False + if forwardcheck and missing: + for variable in variables: + if variable not in assignments: + domain = domains[variable] + for value in domain[:]: + if sum+value > exactsum: + domain.hideValue(value) + if not domain: + return False + if missing: + return sum <= exactsum + else: + return sum == exactsum + +class MinSumConstraint(Constraint): + """ + Constraint enforcing that values of given variables sum at least + to a given amount + + Example: + + >>> problem = Problem() + >>> problem.addVariables(["a", "b"], [1, 2]) + >>> problem.addConstraint(MinSumConstraint(3)) + >>> sorted(sorted(x.items()) for x in problem.getSolutions()) + [[('a', 1), ('b', 2)], [('a', 2), ('b', 1)], [('a', 2), ('b', 2)]] + """#""" + + def __init__(self, minsum, multipliers=None): + """ + @param minsum: Value to be considered as the minimum sum + @type minsum: number + @param multipliers: If given, variable values will be multiplied by + the given factors before being summed to be checked + @type multipliers: sequence of numbers + """ + self._minsum = minsum + self._multipliers = multipliers + + def __call__(self, variables, domains, assignments, forwardcheck=False): + for variable in variables: + if variable not in assignments: + return True + else: + multipliers = self._multipliers + minsum = self._minsum + sum = 0 + if multipliers: + for variable, multiplier in zip(variables, multipliers): + sum += assignments[variable]*multiplier + else: + for variable in variables: + sum += assignments[variable] + if type(sum) is float: + sum = round(sum, 10) + return sum >= minsum + +class InSetConstraint(Constraint): + """ + Constraint enforcing that values of given variables are present in + the given set + + Example: + + >>> problem = Problem() + >>> problem.addVariables(["a", "b"], [1, 2]) + >>> problem.addConstraint(InSetConstraint([1])) + >>> sorted(sorted(x.items()) for x in problem.getSolutions()) + [[('a', 1), ('b', 1)]] + """#""" + + def __init__(self, set): + """ + @param set: Set of allowed values + @type set: set + """ + self._set = set + + def __call__(self, variables, domains, assignments, forwardcheck=False): + # preProcess() will remove it. + raise RuntimeError, "Can't happen" + + def preProcess(self, variables, domains, constraints, vconstraints): + set = self._set + for variable in variables: + domain = domains[variable] + for value in domain[:]: + if value not in set: + domain.remove(value) + vconstraints[variable].remove((self, variables)) + constraints.remove((self, variables)) + +class NotInSetConstraint(Constraint): + """ + Constraint enforcing that values of given variables are not present in + the given set + + Example: + + >>> problem = Problem() + >>> problem.addVariables(["a", "b"], [1, 2]) + >>> problem.addConstraint(NotInSetConstraint([1])) + >>> sorted(sorted(x.items()) for x in problem.getSolutions()) + [[('a', 2), ('b', 2)]] + """#""" + + def __init__(self, set): + """ + @param set: Set of disallowed values + @type set: set + """ + self._set = set + + def __call__(self, variables, domains, assignments, forwardcheck=False): + # preProcess() will remove it. + raise RuntimeError, "Can't happen" + + def preProcess(self, variables, domains, constraints, vconstraints): + set = self._set + for variable in variables: + domain = domains[variable] + for value in domain[:]: + if value in set: + domain.remove(value) + vconstraints[variable].remove((self, variables)) + constraints.remove((self, variables)) + +class SomeInSetConstraint(Constraint): + """ + Constraint enforcing that at least some of the values of given + variables must be present in a given set + + Example: + + >>> problem = Problem() + >>> problem.addVariables(["a", "b"], [1, 2]) + >>> problem.addConstraint(SomeInSetConstraint([1])) + >>> sorted(sorted(x.items()) for x in problem.getSolutions()) + [[('a', 1), ('b', 1)], [('a', 1), ('b', 2)], [('a', 2), ('b', 1)]] + """#""" + + def __init__(self, set, n=1, exact=False): + """ + @param set: Set of values to be checked + @type set: set + @param n: Minimum number of assigned values that should be present + in set (default is 1) + @type n: int + @param exact: Whether the number of assigned values which are + present in set must be exactly C{n} + @type exact: bool + """ + self._set = set + self._n = n + self._exact = exact + + def __call__(self, variables, domains, assignments, forwardcheck=False): + set = self._set + missing = 0 + found = 0 + for variable in variables: + if variable in assignments: + found += assignments[variable] in set + else: + missing += 1 + if missing: + if self._exact: + if not (found <= self._n <= missing+found): + return False + else: + if self._n > missing+found: + return False + if forwardcheck and self._n-found == missing: + # All unassigned variables must be assigned to + # values in the set. + for variable in variables: + if variable not in assignments: + domain = domains[variable] + for value in domain[:]: + if value not in set: + domain.hideValue(value) + if not domain: + return False + else: + if self._exact: + if found != self._n: + return False + else: + if found < self._n: + return False + return True + +class SomeNotInSetConstraint(Constraint): + """ + Constraint enforcing that at least some of the values of given + variables must not be present in a given set + + Example: + + >>> problem = Problem() + >>> problem.addVariables(["a", "b"], [1, 2]) + >>> problem.addConstraint(SomeNotInSetConstraint([1])) + >>> sorted(sorted(x.items()) for x in problem.getSolutions()) + [[('a', 1), ('b', 2)], [('a', 2), ('b', 1)], [('a', 2), ('b', 2)]] + """#""" + + def __init__(self, set, n=1, exact=False): + """ + @param set: Set of values to be checked + @type set: set + @param n: Minimum number of assigned values that should not be present + in set (default is 1) + @type n: int + @param exact: Whether the number of assigned values which are + not present in set must be exactly C{n} + @type exact: bool + """ + self._set = set + self._n = n + self._exact = exact + + def __call__(self, variables, domains, assignments, forwardcheck=False): + set = self._set + missing = 0 + found = 0 + for variable in variables: + if variable in assignments: + found += assignments[variable] not in set + else: + missing += 1 + if missing: + if self._exact: + if not (found <= self._n <= missing+found): + return False + else: + if self._n > missing+found: + return False + if forwardcheck and self._n-found == missing: + # All unassigned variables must be assigned to + # values not in the set. + for variable in variables: + if variable not in assignments: + domain = domains[variable] + for value in domain[:]: + if value in set: + domain.hideValue(value) + if not domain: + return False + else: + if self._exact: + if found != self._n: + return False + else: + if found < self._n: + return False + return True + +if __name__ == "__main__": + import doctest + doctest.testmod() + diff --git a/csp/python-constraint/examples/abc/abc.py b/csp/python-constraint/examples/abc/abc.py new file mode 100755 index 00000000..c10bc675 --- /dev/null +++ b/csp/python-constraint/examples/abc/abc.py @@ -0,0 +1,30 @@ +#!/usr/bin/python +# +# What's the minimum value for: +# +# ABC +# ------- +# A+B+C +# +# From http://www.umassd.edu/mathcontest/abc.cfm +# +from constraint import * + +def main(): + problem = Problem() + problem.addVariables("abc", range(1,10)) + problem.getSolutions() + minvalue = 999/(9*3) + minsolution = {} + for solution in problem.getSolutions(): + a = solution["a"] + b = solution["b"] + c = solution["c"] + value = (a*100+b*10+c)/(a+b+c) + if value < minvalue: + minsolution = solution + print minvalue + print minsolution + +if __name__ == "__main__": + main() diff --git a/csp/python-constraint/examples/coins/coins.py b/csp/python-constraint/examples/coins/coins.py new file mode 100755 index 00000000..1102f3ac --- /dev/null +++ b/csp/python-constraint/examples/coins/coins.py @@ -0,0 +1,30 @@ +#!/usr/bin/python +# +# 100 coins must sum to $5.00 +# +# That's kind of a country-specific problem, since depending on the +# country there are different values for coins. Here is presented +# the solution for a given set. +# +from constraint import * +import sys + +def main(): + problem = Problem() + total = 5.00 + variables = ("0.01", "0.05", "0.10", "0.50", "1.00") + values = [float(x) for x in variables] + for variable, value in zip(variables, values): + problem.addVariable(variable, range(int(total/value))) + problem.addConstraint(ExactSumConstraint(total, values), variables) + problem.addConstraint(ExactSumConstraint(100)) + solutions = problem.getSolutionIter() + for i, solution in enumerate(solutions): + sys.stdout.write("%03d -> " % (i+1)) + for variable in variables: + sys.stdout.write("%s:%d " % (variable, solution[variable])) + sys.stdout.write("\n") + +if __name__ == "__main__": + main() + diff --git a/csp/python-constraint/examples/crosswords/crosswords.py b/csp/python-constraint/examples/crosswords/crosswords.py new file mode 100755 index 00000000..5cb502f0 --- /dev/null +++ b/csp/python-constraint/examples/crosswords/crosswords.py @@ -0,0 +1,153 @@ +#!/usr/bin/python +from constraint import * +import random +import sys + +MINLEN = 3 + +def main(puzzle, lines): + puzzle = puzzle.rstrip().splitlines() + while puzzle and not puzzle[0]: + del puzzle[0] + + # Extract horizontal words + horizontal = [] + word = [] + predefined = {} + for row in range(len(puzzle)): + for col in range(len(puzzle[row])): + char = puzzle[row][col] + if not char.isspace(): + word.append((row, col)) + if char != "#": + predefined[row, col] = char + elif word: + if len(word) > MINLEN: + horizontal.append(word[:]) + del word[:] + if word: + if len(word) > MINLEN: + horizontal.append(word[:]) + del word[:] + + # Extract vertical words + vertical = [] + validcol = True + col = 0 + while validcol: + validcol = False + for row in range(len(puzzle)): + if col >= len(puzzle[row]): + if word: + if len(word) > MINLEN: + vertical.append(word[:]) + del word[:] + else: + validcol = True + char = puzzle[row][col] + if not char.isspace(): + word.append((row, col)) + if char != "#": + predefined[row, col] = char + elif word: + if len(word) > MINLEN: + vertical.append(word[:]) + del word[:] + if word: + if len(word) > MINLEN: + vertical.append(word[:]) + del word[:] + col += 1 + + hnames = ["h%d" % i for i in range(len(horizontal))] + vnames = ["v%d" % i for i in range(len(vertical))] + + #problem = Problem(MinConflictsSolver()) + problem = Problem() + + for hi, hword in enumerate(horizontal): + for vi, vword in enumerate(vertical): + for hchar in hword: + if hchar in vword: + hci = hword.index(hchar) + vci = vword.index(hchar) + problem.addConstraint(lambda hw, vw, hci=hci, vci=vci: + hw[hci] == vw[vci], + ("h%d" % hi, "v%d" % vi)) + + for char, letter in predefined.items(): + for hi, hword in enumerate(horizontal): + if char in hword: + hci = hword.index(char) + problem.addConstraint(lambda hw, hci=hci, letter=letter: + hw[hci] == letter, ("h%d" % hi,)) + for vi, vword in enumerate(vertical): + if char in vword: + vci = vword.index(char) + problem.addConstraint(lambda vw, vci=vci, letter=letter: + vw[vci] == letter, ("v%d" % vi,)) + + wordsbylen = {} + for hword in horizontal: + wordsbylen[len(hword)] = [] + for vword in vertical: + wordsbylen[len(vword)] = [] + + for line in lines: + line = line.strip() + l = len(line) + if l in wordsbylen: + wordsbylen[l].append(line.upper()) + + for hi, hword in enumerate(horizontal): + words = wordsbylen[len(hword)] + random.shuffle(words) + problem.addVariable("h%d" % hi, words) + for vi, vword in enumerate(vertical): + words = wordsbylen[len(vword)] + random.shuffle(words) + problem.addVariable("v%d" % vi, words) + + problem.addConstraint(AllDifferentConstraint()) + + solution = problem.getSolution() + if not solution: + print "No solution found!" + + maxcol = 0 + maxrow = 0 + for hword in horizontal: + for row, col in hword: + if row > maxrow: + maxrow = row + if col > maxcol: + maxcol = col + for vword in vertical: + for row, col in vword: + if row > maxrow: + maxrow = row + if col > maxcol: + maxcol = col + + matrix = [] + for row in range(maxrow+1): + matrix.append([" "]*(maxcol+1)) + + for variable in solution: + if variable[0] == "v": + word = vertical[int(variable[1:])] + else: + word = horizontal[int(variable[1:])] + for (row, col), char in zip(word, solution[variable]): + matrix[row][col] = char + + for row in range(maxrow+1): + for col in range(maxcol+1): + sys.stdout.write(matrix[row][col]) + sys.stdout.write("\n") + +if __name__ == "__main__": + if len(sys.argv) != 3: + sys.exit("Usage: crosswords.py ") + main(open(sys.argv[1]).read(), open(sys.argv[2])) + diff --git a/csp/python-constraint/examples/crosswords/large.mask b/csp/python-constraint/examples/crosswords/large.mask new file mode 100644 index 00000000..ba5364c8 --- /dev/null +++ b/csp/python-constraint/examples/crosswords/large.mask @@ -0,0 +1,27 @@ + +# ######## # +# # # # # +######## # # +# # # # # +# # ######## +# # # # # # +######## # # +# # # # # # + # # # +######## # # + # # # # # + # ######## + # # # # # + # # ######## + # # # # # # + # # ######## + # # # # +######## # # + # # # # # # + # # # # # # + ######## # # + # # # # + # ######## + # # # # +######## # # + diff --git a/csp/python-constraint/examples/crosswords/medium.mask b/csp/python-constraint/examples/crosswords/medium.mask new file mode 100644 index 00000000..3332a097 --- /dev/null +++ b/csp/python-constraint/examples/crosswords/medium.mask @@ -0,0 +1,19 @@ + + # +######### +# # # +# # ###### +# # # +# # # # +# # # # +######## # +# # # + # # # + ######### + # # # + ######### + # # # + # # +####### + # + diff --git a/csp/python-constraint/examples/crosswords/python.mask b/csp/python-constraint/examples/crosswords/python.mask new file mode 100644 index 00000000..fe5a5767 --- /dev/null +++ b/csp/python-constraint/examples/crosswords/python.mask @@ -0,0 +1,8 @@ + P + Y +####T#### + # H # + # O # +####N # + # # +######### diff --git a/csp/python-constraint/examples/crosswords/small.mask b/csp/python-constraint/examples/crosswords/small.mask new file mode 100644 index 00000000..0e43ff78 --- /dev/null +++ b/csp/python-constraint/examples/crosswords/small.mask @@ -0,0 +1,8 @@ + # + # +######### + # # + # # # # +##### # # + # # # +######### diff --git a/csp/python-constraint/examples/einstein/einstein.py b/csp/python-constraint/examples/einstein/einstein.py new file mode 100755 index 00000000..ede13f88 --- /dev/null +++ b/csp/python-constraint/examples/einstein/einstein.py @@ -0,0 +1,201 @@ +#!/usr/bin/python +# +# ALBERT EINSTEIN'S RIDDLE +# +# ARE YOU IN THE TOP 2% OF INTELLIGENT PEOPLE IN THE WORLD? +# SOLVE THE RIDDLE AND FIND OUT. +# +# There are no tricks, just pure logic, so good luck and don't give up. +# +# 1. In a street there are five houses, painted five different colours. +# 2. In each house lives a person of different nationality +# 3. These five homeowners each drink a different kind of beverage, smoke +# different brand of cigar and keep a different pet. +# +# THE QUESTION: WHO OWNS THE FISH? +# +# HINTS +# +# 1. The Brit lives in a red house. +# 2. The Swede keeps dogs as pets. +# 3. The Dane drinks tea. +# 4. The Green house is on the left of the White house. +# 5. The owner of the Green house drinks coffee. +# 6. The person who smokes Pall Mall rears birds. +# 7. The owner of the Yellow house smokes Dunhill. +# 8. The man living in the centre house drinks milk. +# 9. The Norwegian lives in the first house. +# 10. The man who smokes Blends lives next to the one who keeps cats. +# 11. The man who keeps horses lives next to the man who smokes Dunhill. +# 12. The man who smokes Blue Master drinks beer. +# 13. The German smokes Prince. +# 14. The Norwegian lives next to the blue house. +# 15. The man who smokes Blends has a neighbour who drinks water. +# +# ALBERT EINSTEIN WROTE THIS RIDDLE EARLY DURING THE 19th CENTURY. HE +# SAID THAT 98% OF THE WORLD POPULATION WOULD NOT BE ABLE TO SOLVE IT. + +from constraint import * + +# Check http://www.csc.fi/oppaat/f95/python/talot.py + +def main(): + problem = Problem() + for i in range(1,6): + problem.addVariable("color%d" % i, + ["red", "white", "green", "yellow", "blue"]) + problem.addVariable("nationality%d" % i, + ["brit", "swede", "dane", "norwegian", "german"]) + problem.addVariable("drink%d" % i, + ["tea", "coffee", "milk", "beer", "water"]) + problem.addVariable("smoke%d" % i, + ["pallmall", "dunhill", "blends", + "bluemaster", "prince"]) + problem.addVariable("pet%d" % i, + ["dogs", "birds", "cats", "horses", "fish"]) + + problem.addConstraint(AllDifferentConstraint(), + ["color%d" % i for i in range(1,6)]) + problem.addConstraint(AllDifferentConstraint(), + ["nationality%d" % i for i in range(1,6)]) + problem.addConstraint(AllDifferentConstraint(), + ["drink%d" % i for i in range(1,6)]) + problem.addConstraint(AllDifferentConstraint(), + ["smoke%d" % i for i in range(1,6)]) + problem.addConstraint(AllDifferentConstraint(), + ["pet%d" % i for i in range(1,6)]) + + for i in range(1,6): + + # Hint 1 + problem.addConstraint(lambda nationality, color: + nationality != "brit" or color == "red", + ("nationality%d" % i, "color%d" % i)) + + # Hint 2 + problem.addConstraint(lambda nationality, pet: + nationality != "swede" or pet == "dogs", + ("nationality%d" % i, "pet%d" % i)) + + # Hint 3 + problem.addConstraint(lambda nationality, drink: + nationality != "dane" or drink == "tea", + ("nationality%d" % i, "drink%d" % i)) + + # Hint 4 + if i < 5: + problem.addConstraint(lambda colora, colorb: + colora != "green" or colorb == "white", + ("color%d" % i, "color%d" % (i+1))) + else: + problem.addConstraint(lambda color: color != "green", + ("color%d" % i,)) + + # Hint 5 + problem.addConstraint(lambda color, drink: + color != "green" or drink == "coffee", + ("color%d" % i, "drink%d" % i)) + + # Hint 6 + problem.addConstraint(lambda smoke, pet: + smoke != "pallmall" or pet == "birds", + ("smoke%d" % i, "pet%d" % i)) + + # Hint 7 + problem.addConstraint(lambda color, smoke: + color != "yellow" or smoke == "dunhill", + ("color%d" % i, "smoke%d" % i)) + + # Hint 8 + if i == 3: + problem.addConstraint(lambda drink: drink == "milk", + ("drink%d" % i,)) + + # Hint 9 + if i == 1: + problem.addConstraint(lambda nationality: + nationality == "norwegian", + ("nationality%d" % i,)) + + # Hint 10 + if 1 < i < 5: + problem.addConstraint(lambda smoke, peta, petb: + smoke != "blends" or peta == "cats" or + petb == "cats", + ("smoke%d" % i, "pet%d" % (i-1), + "pet%d" % (i+1))) + else: + problem.addConstraint(lambda smoke, pet: + smoke != "blends" or pet == "cats", + ("smoke%d" % i, + "pet%d" % (i == 1 and 2 or 4))) + + # Hint 11 + if 1 < i < 5: + problem.addConstraint(lambda pet, smokea, smokeb: + pet != "horses" or smokea == "dunhill" or + smokeb == "dunhill", + ("pet%d" % i, "smoke%d" % (i-1), + "smoke%d" % (i+1))) + else: + problem.addConstraint(lambda pet, smoke: + pet != "horses" or smoke == "dunhill", + ("pet%d" % i, + "smoke%d" % (i == 1 and 2 or 4))) + + # Hint 12 + problem.addConstraint(lambda smoke, drink: + smoke != "bluemaster" or drink == "beer", + ("smoke%d" % i, "drink%d" % i)) + + # Hint 13 + problem.addConstraint(lambda nationality, smoke: + nationality != "german" or smoke == "prince", + ("nationality%d" % i, "smoke%d" % i)) + + # Hint 14 + if 1 < i < 5: + problem.addConstraint(lambda nationality, colora, colorb: + nationality != "norwegian" or + colora == "blue" or colorb == "blue", + ("nationality%d" % i, "color%d" % (i-1), + "color%d" % (i+1))) + else: + problem.addConstraint(lambda nationality, color: + nationality != "norwegian" or + color == "blue", + ("nationality%d" % i, + "color%d" % (i == 1 and 2 or 4))) + + # Hint 15 + if 1 < i < 5: + problem.addConstraint(lambda smoke, drinka, drinkb: + smoke != "blends" or + drinka == "water" or drinkb == "water", + ("smoke%d" % i, "drink%d" % (i-1), + "drink%d" % (i+1))) + else: + problem.addConstraint(lambda smoke, drink: + smoke != "blends" or drink == "water", + ("smoke%d" % i, + "drink%d" % (i == 1 and 2 or 4))) + + solutions = problem.getSolutions() + print "Found %d solution(s)!" % len(solutions) + print + for solution in solutions: + showSolution(solution) + +def showSolution(solution): + for i in range(1,6): + print "House %d" % i + print "--------" + print "Nationality: %s" % solution["nationality%d" % i] + print "Color: %s" % solution["color%d" % i] + print "Drink: %s" % solution["drink%d" % i] + print "Smoke: %s" % solution["smoke%d" % i] + print "Pet: %s" % solution["pet%d" % i] + print + +if __name__ == "__main__": + main() diff --git a/csp/python-constraint/examples/einstein/einstein2.py b/csp/python-constraint/examples/einstein/einstein2.py new file mode 100755 index 00000000..d1f7b86d --- /dev/null +++ b/csp/python-constraint/examples/einstein/einstein2.py @@ -0,0 +1,190 @@ +#!/usr/bin/python +# +# ALBERT EINSTEIN'S RIDDLE +# +# ARE YOU IN THE TOP 2% OF INTELLIGENT PEOPLE IN THE WORLD? +# SOLVE THE RIDDLE AND FIND OUT. +# +# There are no tricks, just pure logic, so good luck and don't give up. +# +# 1. In a street there are five houses, painted five different colours. +# 2. In each house lives a person of different nationality +# 3. These five homeowners each drink a different kind of beverage, smoke +# different brand of cigar and keep a different pet. +# +# THE QUESTION: WHO OWNS THE zebra? +# +# HINTS +# +# 1. The englishman lives in a red house. +# 2. The spaniard keeps dogs as pets. +# 5. The owner of the Green house drinks coffee. +# 3. The ukrainian drinks tea. +# 4. The Green house is on the left of the ivory house. +# 6. The person who smokes oldgold rears snails. +# 7. The owner of the Yellow house smokes kools. +# 8. The man living in the centre house drinks milk. +# 9. The Norwegian lives in the first house. +# 10. The man who smokes chesterfields lives next to the one who keeps foxes. +# 11. The man who keeps horses lives next to the man who smokes kools. +# 12. The man who smokes luckystrike drinks orangejuice. +# 13. The japanese smokes parliaments. +# 14. The Norwegian lives next to the blue house. +# 15. The man who smokes chesterfields has a neighbour who drinks water. +# +# ALBERT EINSTEIN WROTE THIS RIDDLE EARLY DURING THE 19th CENTURY. HE +# SAID THAT 98% OF THE WORLD POPULATION WOULD NOT BE ABLE TO SOLVE IT. + +from constraint import * + +# Check http://www.csc.fi/oppaat/f95/python/talot.py + +def main(): + problem = Problem() + for i in range(1,6): + problem.addVariable("color%d" % i, + ["red", "ivory", "green", "yellow", "blue"]) + problem.addVariable("nationality%d" % i, + ["englishman", "spaniard", "ukrainian", "norwegian", "japanese"]) + problem.addVariable("drink%d" % i, + ["tea", "coffee", "milk", "orangejuice", "water"]) + problem.addVariable("smoke%d" % i, + ["oldgold", "kools", "chesterfields", + "luckystrike", "parliaments"]) + problem.addVariable("pet%d" % i, + ["dogs", "snails", "foxes", "horses", "zebra"]) + + problem.addConstraint(AllDifferentConstraint(), + ["color%d" % i for i in range(1,6)]) + problem.addConstraint(AllDifferentConstraint(), + ["nationality%d" % i for i in range(1,6)]) + problem.addConstraint(AllDifferentConstraint(), + ["drink%d" % i for i in range(1,6)]) + problem.addConstraint(AllDifferentConstraint(), + ["smoke%d" % i for i in range(1,6)]) + problem.addConstraint(AllDifferentConstraint(), + ["pet%d" % i for i in range(1,6)]) + + for i in range(1,6): + + # Hint 1 + problem.addConstraint(lambda nationality, color: + nationality != "englishman" or color == "red", + ("nationality%d" % i, "color%d" % i)) + + # Hint 2 + problem.addConstraint(lambda nationality, pet: + nationality != "spaniard" or pet == "dogs", + ("nationality%d" % i, "pet%d" % i)) + + # Hint 3 + problem.addConstraint(lambda nationality, drink: + nationality != "ukrainian" or drink == "tea", + ("nationality%d" % i, "drink%d" % i)) + + # Hint 4 + if i < 5: + problem.addConstraint(lambda colora, colorb: + colora != "green" or colorb == "ivory", + ("color%d" % i, "color%d" % (i+1))) + else: + problem.addConstraint(lambda color: color != "green", + ("color%d" % i,)) + + # Hint 5 + problem.addConstraint(lambda color, drink: + color != "green" or drink == "coffee", + ("color%d" % i, "drink%d" % i)) + + # Hint 6 + problem.addConstraint(lambda smoke, pet: + smoke != "oldgold" or pet == "snails", + ("smoke%d" % i, "pet%d" % i)) + + # Hint 7 + problem.addConstraint(lambda color, smoke: + color != "yellow" or smoke == "kools", + ("color%d" % i, "smoke%d" % i)) + + # Hint 8 + if i == 3: + problem.addConstraint(lambda drink: drink == "milk", + ("drink%d" % i,)) + + # Hint 9 + if i == 1: + problem.addConstraint(lambda nationality: + nationality == "norwegian", + ("nationality%d" % i,)) + + # Hint 10 + if 1 < i < 5: + problem.addConstraint(lambda smoke, peta, petb: + smoke != "chesterfields" or peta == "foxes" or + petb == "foxes", + ("smoke%d" % i, "pet%d" % (i-1), + "pet%d" % (i+1))) + else: + problem.addConstraint(lambda smoke, pet: + smoke != "chesterfields" or pet == "foxes", + ("smoke%d" % i, + "pet%d" % (i == 1 and 2 or 4))) + + # Hint 11 + if 1 < i < 5: + problem.addConstraint(lambda pet, smokea, smokeb: + pet != "horses" or smokea == "kools" or + smokeb == "kools", + ("pet%d" % i, "smoke%d" % (i-1), + "smoke%d" % (i+1))) + else: + problem.addConstraint(lambda pet, smoke: + pet != "horses" or smoke == "kools", + ("pet%d" % i, + "smoke%d" % (i == 1 and 2 or 4))) + + # Hint 12 + problem.addConstraint(lambda smoke, drink: + smoke != "luckystrike" or drink == "orangejuice", + ("smoke%d" % i, "drink%d" % i)) + + # Hint 13 + problem.addConstraint(lambda nationality, smoke: + nationality != "japanese" or smoke == "parliaments", + ("nationality%d" % i, "smoke%d" % i)) + + # Hint 14 + if 1 < i < 5: + problem.addConstraint(lambda nationality, colora, colorb: + nationality != "norwegian" or + colora == "blue" or colorb == "blue", + ("nationality%d" % i, "color%d" % (i-1), + "color%d" % (i+1))) + else: + problem.addConstraint(lambda nationality, color: + nationality != "norwegian" or + color == "blue", + ("nationality%d" % i, + "color%d" % (i == 1 and 2 or 4))) + + + + solutions = problem.getSolutions() + print "Found %d solution(s)!" % len(solutions) + print + for solution in solutions: + showSolution(solution) + +def showSolution(solution): + for i in range(1,6): + print "House %d" % i + print "--------" + print "Nationality: %s" % solution["nationality%d" % i] + print "Color: %s" % solution["color%d" % i] + print "Drink: %s" % solution["drink%d" % i] + print "Smoke: %s" % solution["smoke%d" % i] + print "Pet: %s" % solution["pet%d" % i] + print + +if __name__ == "__main__": + main() diff --git a/csp/python-constraint/examples/queens/queens.py b/csp/python-constraint/examples/queens/queens.py new file mode 100755 index 00000000..deac7131 --- /dev/null +++ b/csp/python-constraint/examples/queens/queens.py @@ -0,0 +1,47 @@ +#!/usr/bin/python +# +# http://mathworld.wolfram.com/QueensProblem.html +# +from constraint import * +import sys + +def main(show=False): + problem = Problem() + size = 8 + cols = range(size) + rows = range(size) + problem.addVariables(cols, rows) + for col1 in cols: + for col2 in cols: + if col1 < col2: + problem.addConstraint(lambda row1, row2, col1=col1, col2=col2: + abs(row1-row2) != abs(col1-col2) and + row1 != row2, (col1, col2)) + solutions = problem.getSolutions() + print "Found %d solution(s)!" % len(solutions) + if show: + for solution in solutions: + showSolution(solution, size) + +def showSolution(solution, size): + sys.stdout.write(" %s \n" % ("-"*((size*4)-1))) + for i in range(size): + sys.stdout.write(" |") + for j in range(size): + if solution[j] == i: + sys.stdout.write(" %d |" % j) + else: + sys.stdout.write(" |") + sys.stdout.write("\n") + if i != size-1: + sys.stdout.write(" |%s|\n" % ("-"*((size*4)-1))) + sys.stdout.write(" %s \n" % ("-"*((size*4)-1))) + +if __name__ == "__main__": + show = False + if len(sys.argv) == 2 and sys.argv[1] == "-s": + show = True + elif len(sys.argv) != 1: + sys.exit("Usage: queens.py [-s]") + main(show) + diff --git a/csp/python-constraint/examples/rooks/rooks.py b/csp/python-constraint/examples/rooks/rooks.py new file mode 100755 index 00000000..14f88b1e --- /dev/null +++ b/csp/python-constraint/examples/rooks/rooks.py @@ -0,0 +1,49 @@ +#!/usr/bin/python +# +# http://mathworld.wolfram.com/RooksProblem.html +# +from constraint import * +import sys + +def factorial(x): return x == 1 or factorial(x-1)*x + +def main(show=False): + problem = Problem() + size = 8 + cols = range(size) + rows = range(size) + problem.addVariables(cols, rows) + for col1 in cols: + for col2 in cols: + if col1 < col2: + problem.addConstraint(lambda row1, row2: row1 != row2, + (col1, col2)) + solutions = problem.getSolutions() + print "Found %d solution(s)!" % len(solutions) + assert len(solutions) == factorial(size) + if show: + for solution in solutions: + showSolution(solution, size) + +def showSolution(solution, size): + sys.stdout.write(" %s \n" % ("-"*((size*4)-1))) + for i in range(size): + sys.stdout.write(" |") + for j in range(size): + if solution[j] == i: + sys.stdout.write(" %d |" % j) + else: + sys.stdout.write(" |") + sys.stdout.write("\n") + if i != size-1: + sys.stdout.write(" |%s|\n" % ("-"*((size*4)-1))) + sys.stdout.write(" %s \n" % ("-"*((size*4)-1))) + +if __name__ == "__main__": + show = False + if len(sys.argv) == 2 and sys.argv[1] == "-s": + show = True + elif len(sys.argv) != 1: + sys.exit("Usage: rooks.py [-s]") + main(show) + diff --git a/csp/python-constraint/examples/studentdesks/studentdesks.py b/csp/python-constraint/examples/studentdesks/studentdesks.py new file mode 100755 index 00000000..e8d47792 --- /dev/null +++ b/csp/python-constraint/examples/studentdesks/studentdesks.py @@ -0,0 +1,39 @@ +#!/usr/bin/python +# +# http://home.chello.no/~dudley/ +# +from constraint import * +import sys + +STUDENTDESKS = [[ 0, 1, 0, 0, 0, 0], + [ 0, 2, 3, 4, 5, 6], + [ 0, 7, 8, 9, 10, 0], + [ 0, 11, 12, 13, 14, 0], + [ 15, 16, 17, 18, 19, 0], + [ 0, 0, 0, 0, 20, 0]] + +def main(): + problem = Problem() + problem.addVariables(range(1,21), ["A", "B", "C", "D", "E"]) + problem.addConstraint(SomeInSetConstraint(["A"], 4, True)) + problem.addConstraint(SomeInSetConstraint(["B"], 4, True)) + problem.addConstraint(SomeInSetConstraint(["C"], 4, True)) + problem.addConstraint(SomeInSetConstraint(["D"], 4, True)) + problem.addConstraint(SomeInSetConstraint(["E"], 4, True)) + for row in range(len(STUDENTDESKS)-1): + for col in range(len(STUDENTDESKS[row])-1): + lst = [STUDENTDESKS[row][col], STUDENTDESKS[row][col+1], + STUDENTDESKS[row+1][col], STUDENTDESKS[row+1][col+1]] + lst = [x for x in lst if x] + problem.addConstraint(AllDifferentConstraint(), lst) + showSolution(problem.getSolution()) + +def showSolution(solution): + for row in range(len(STUDENTDESKS)): + for col in range(len(STUDENTDESKS[row])): + id = STUDENTDESKS[row][col] + sys.stdout.write(" %s" % (id and solution[id] or " ")) + sys.stdout.write("\n") + +if __name__ == "__main__": + main() diff --git a/csp/python-constraint/examples/sudoku/sudoku.py b/csp/python-constraint/examples/sudoku/sudoku.py new file mode 100644 index 00000000..e79698ea --- /dev/null +++ b/csp/python-constraint/examples/sudoku/sudoku.py @@ -0,0 +1,61 @@ +# +# Sudoku puzzle solver by by Luigi Poderico (www.poderico.it). +# +from constraint import * + +problem = Problem() + +# Define the variables: 9 rows of 9 variables rangin in 1...9 +for i in range(1, 10) : + problem.addVariables(range(i*10+1, i*10+10), range(1, 10)) + +# Each row has different values +for i in range(1, 10) : + problem.addConstraint(AllDifferentConstraint(), range(i*10+1, i*10+10)) + +# Each colum has different values +for i in range(1, 10) : + problem.addConstraint(AllDifferentConstraint(), range(10+i, 100+i, 10)) + +# Each 3x3 box has different values +problem.addConstraint(AllDifferentConstraint(), [11,12,13,21,22,23,31,32,33]) +problem.addConstraint(AllDifferentConstraint(), [41,42,43,51,52,53,61,62,63]) +problem.addConstraint(AllDifferentConstraint(), [71,72,73,81,82,83,91,92,93]) + +problem.addConstraint(AllDifferentConstraint(), [14,15,16,24,25,26,34,35,36]) +problem.addConstraint(AllDifferentConstraint(), [44,45,46,54,55,56,64,65,66]) +problem.addConstraint(AllDifferentConstraint(), [74,75,76,84,85,86,94,95,96]) + +problem.addConstraint(AllDifferentConstraint(), [17,18,19,27,28,29,37,38,39]) +problem.addConstraint(AllDifferentConstraint(), [47,48,49,57,58,59,67,68,69]) +problem.addConstraint(AllDifferentConstraint(), [77,78,79,87,88,89,97,98,99]) + +# Some value is given. +initValue = [[0, 9, 0, 7, 0, 0, 8, 6, 0], + [0, 3, 1, 0, 0, 5, 0, 2, 0], + [8, 0, 6, 0, 0, 0, 0, 0, 0], + [0, 0, 7, 0, 5, 0, 0, 0, 6], + [0, 0, 0, 3, 0, 7, 0, 0, 0], + [5, 0, 0, 0, 1, 0, 7, 0, 0], + [0, 0, 0, 0, 0, 0, 1, 0, 9], + [0, 2, 0, 6, 0, 0, 0, 5, 0], + [0, 5, 4, 0, 0, 8, 0, 7, 0]] + +for i in range(1, 10) : + for j in range(1, 10): + if initValue[i-1][j-1] !=0 : + problem.addConstraint(lambda var, val=initValue[i-1][j-1]: + var==val, (i*10+j,)) + +# Get the solutions. +solutions = problem.getSolutions() + +# Print the solutions +for solution in solutions: + for i in range(1, 10): + for j in range(1, 10): + index = i*10+j + print solution[index], + print + print + diff --git a/csp/python-constraint/examples/wordmath/seisseisdoze.py b/csp/python-constraint/examples/wordmath/seisseisdoze.py new file mode 100755 index 00000000..b17956db --- /dev/null +++ b/csp/python-constraint/examples/wordmath/seisseisdoze.py @@ -0,0 +1,32 @@ +#!/usr/bin/python +# +# Assign equal values to equal letters, and different values to +# different letters, in a way that satisfies the following sum: +# +# SEIS +# + SEIS +# ------ +# DOZE +# +from constraint import * + +def main(): + problem = Problem() + problem.addVariables("seidoz", range(10)) + problem.addConstraint(lambda s, e: (2*s)%10 == e, "se") + problem.addConstraint(lambda i, s, z, e: ((10*2*i)+(2*s))%100 == z*10+e, + "isze") + problem.addConstraint(lambda s, e, i, d, o, z: + 2*(s*1000+e*100+i*10+s) == d*1000+o*100+z*10+e, + "seidoz") + problem.addConstraint(lambda s: s != 0, "s") + problem.addConstraint(lambda d: d != 0, "d") + problem.addConstraint(AllDifferentConstraint()) + print "SEIS+SEIS=DOZE" + for s in problem.getSolutions(): + print ("%(s)d%(e)d%(i)d%(s)s+%(s)d%(e)d%(i)d%(s)d=" + "%(d)d%(o)d%(z)d%(e)d") % s + +if __name__ == "__main__": + main() + diff --git a/csp/python-constraint/examples/wordmath/sendmoremoney.py b/csp/python-constraint/examples/wordmath/sendmoremoney.py new file mode 100755 index 00000000..894b0cd5 --- /dev/null +++ b/csp/python-constraint/examples/wordmath/sendmoremoney.py @@ -0,0 +1,34 @@ +#!/usr/bin/python +# +# Assign equal values to equal letters, and different values to +# different letters, in a way that satisfies the following sum: +# +# SEND +# + MORE +# ------ +# MONEY +# +from constraint import * + +def main(): + problem = Problem() + problem.addVariables("sendmory", range(10)) + problem.addConstraint(lambda d, e, y: (d+e)%10 == y, "dey") + problem.addConstraint(lambda n, d, r, e, y: (n*10+d+r*10+e)%100 == e*10+y, + "ndrey") + problem.addConstraint(lambda e, n, d, o, r, y: + (e*100+n*10+d+o*100+r*10+e)%1000 == n*100+e*10+y, + "endory") + problem.addConstraint(lambda s, e, n, d, m, o, r, y: + 1000*s+100*e+10*n+d + 1000*m+100*o+10*r+e == + 10000*m+1000*o+100*n+10*e+y, "sendmory") + problem.addConstraint(NotInSetConstraint([0]), "sm") + problem.addConstraint(AllDifferentConstraint()) + print "SEND+MORE=MONEY" + for s in problem.getSolutions(): + print "%(s)d%(e)d%(n)d%(d)d+" \ + "%(m)d%(o)d%(r)d%(e)d=" \ + "%(m)d%(o)d%(n)d%(e)d%(y)d" % s + +if __name__ == "__main__": + main() diff --git a/csp/python-constraint/examples/wordmath/twotwofour.py b/csp/python-constraint/examples/wordmath/twotwofour.py new file mode 100755 index 00000000..b9e70d6a --- /dev/null +++ b/csp/python-constraint/examples/wordmath/twotwofour.py @@ -0,0 +1,28 @@ +#!/usr/bin/python +# +# Assign equal values to equal letters, and different values to +# different letters, in a way that satisfies the following sum: +# +# TWO +# + TWO +# ----- +# FOUR +# +from constraint import * + +def main(): + problem = Problem() + problem.addVariables("twofur", range(10)) + problem.addConstraint(lambda o, r: (2*o)%10 == r, "or") + problem.addConstraint(lambda w, o, u, r: ((10*2*w)+(2*o))%100 == u*10+r, + "wour") + problem.addConstraint(lambda t, w, o, f, u, r: + 2*(t*100+w*10+o) == f*1000+o*100+u*10+r, "twofur") + problem.addConstraint(NotInSetConstraint([0]), "ft") + problem.addConstraint(AllDifferentConstraint()) + print "TWO+TWO=FOUR" + for s in problem.getSolutions(): + print "%(t)d%(w)d%(o)d+%(t)d%(w)d%(o)d=%(f)d%(o)d%(u)d%(r)d" % s + +if __name__ == "__main__": + main() diff --git a/csp/python-constraint/examples/xsum/xsum.py b/csp/python-constraint/examples/xsum/xsum.py new file mode 100755 index 00000000..0f5f70b6 --- /dev/null +++ b/csp/python-constraint/examples/xsum/xsum.py @@ -0,0 +1,37 @@ +#!/usr/bin/python +# +# Reorganize the following numbers in a way that each line of +# 5 numbers sum to 27. +# +# 1 6 +# 2 7 +# 3 +# 8 4 +# 9 5 +# +from constraint import * + +def main(): + problem = Problem() + problem.addVariables("abcdxefgh", range(1,10)) + problem.addConstraint(lambda a, b, c, d, x: + a < b < c < d and a+b+c+d+x == 27, "abcdx") + problem.addConstraint(lambda e, f, g, h, x: + e < f < g < h and e+f+g+h+x == 27, "efghx") + problem.addConstraint(AllDifferentConstraint()) + solutions = problem.getSolutions() + print "Found %d solutions!" % len(solutions) + showSolutions(solutions) + +def showSolutions(solutions): + for solution in solutions: + print " %d %d" % (solution["a"], solution["e"]) + print " %d %d " % (solution["b"], solution["f"]) + print " %d " % (solution["x"],) + print " %d %d " % (solution["g"], solution["c"]) + print " %d %d" % (solution["h"], solution["d"]) + print + +if __name__ == "__main__": + main() + diff --git a/csp/python-constraint/setup.cfg b/csp/python-constraint/setup.cfg new file mode 100644 index 00000000..33d88e05 --- /dev/null +++ b/csp/python-constraint/setup.cfg @@ -0,0 +1,6 @@ +[bdist_rpm] +doc_files = README +use_bzip2 = 1 + +[sdist] +formats = bztar diff --git a/csp/python-constraint/setup.py b/csp/python-constraint/setup.py new file mode 100755 index 00000000..cda67133 --- /dev/null +++ b/csp/python-constraint/setup.py @@ -0,0 +1,21 @@ +#!/usr/bin/python +from distutils.core import setup +import os + +if os.path.isfile("MANIFEST"): + os.unlink("MANIFEST") + +setup(name="python-constraint", + version = "1.2", + description = "Python module for handling Constraint Solving Problems", + author = "Gustavo Niemeyer", + author_email = "gustavo@niemeyer.net", + url = "http://labix.org/python-constraint", + license = "Simplified BSD", + long_description = +""" +python-constraint is a module implementing support for handling CSPs +(Constraint Solving Problems) over finite domains. +""", + py_modules = ["constraint"], + ) From 6fd2aea9d2c492126865944df07c85dd72358ee6 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Tue, 30 Sep 2014 15:03:25 -0700 Subject: [PATCH 022/246] tribulations --- csp/aima/csp.py | 3 +- csp/constraint.rkt | 167 ++ csp/csp.rkt | 5 +- .../API Documentation.webloc | 8 + csp/python-constraint/trials/abc.py | 30 + csp/python-constraint/trials/coins.py | 30 + csp/python-constraint/trials/constraint.py | 1434 +++++++++++++++++ csp/python-constraint/trials/crosswords.py | 153 ++ csp/python-constraint/trials/einstein.py | 201 +++ csp/python-constraint/trials/einstein2.py | 190 +++ csp/python-constraint/trials/large.mask | 27 + csp/python-constraint/trials/medium.mask | 19 + csp/python-constraint/trials/python.mask | 8 + csp/python-constraint/trials/queens.py | 47 + csp/python-constraint/trials/rooks.py | 49 + csp/python-constraint/trials/seisseisdoze.py | 32 + csp/python-constraint/trials/sendmoremoney.py | 34 + csp/python-constraint/trials/small.mask | 8 + csp/python-constraint/trials/studentdesks.py | 39 + csp/python-constraint/trials/sudoku.py | 61 + csp/python-constraint/trials/twotwofour.py | 28 + csp/python-constraint/trials/xsum.py | 37 + 22 files changed, 2607 insertions(+), 3 deletions(-) create mode 100644 csp/constraint.rkt create mode 100644 csp/python-constraint/API Documentation.webloc create mode 100755 csp/python-constraint/trials/abc.py create mode 100755 csp/python-constraint/trials/coins.py create mode 100644 csp/python-constraint/trials/constraint.py create mode 100755 csp/python-constraint/trials/crosswords.py create mode 100755 csp/python-constraint/trials/einstein.py create mode 100755 csp/python-constraint/trials/einstein2.py create mode 100644 csp/python-constraint/trials/large.mask create mode 100644 csp/python-constraint/trials/medium.mask create mode 100644 csp/python-constraint/trials/python.mask create mode 100755 csp/python-constraint/trials/queens.py create mode 100755 csp/python-constraint/trials/rooks.py create mode 100755 csp/python-constraint/trials/seisseisdoze.py create mode 100755 csp/python-constraint/trials/sendmoremoney.py create mode 100644 csp/python-constraint/trials/small.mask create mode 100755 csp/python-constraint/trials/studentdesks.py create mode 100644 csp/python-constraint/trials/sudoku.py create mode 100755 csp/python-constraint/trials/twotwofour.py create mode 100755 csp/python-constraint/trials/xsum.py diff --git a/csp/aima/csp.py b/csp/aima/csp.py index 9347599a..935b2035 100644 --- a/csp/aima/csp.py +++ b/csp/aima/csp.py @@ -227,6 +227,7 @@ def min_conflicts(csp, max_steps=1000000): csp.assign(var, val, current) # Now repeapedly choose a random conflicted variable and change it for i in range(max_steps): + print i conflicted = csp.conflicted_vars(current) if not conflicted: return current @@ -447,4 +448,4 @@ def solve_zebra(algorithm=min_conflicts, **args): print return ans['Zebra'], ans['Water'], z.nassigns, ans, - +solve_zebra() diff --git a/csp/constraint.rkt b/csp/constraint.rkt new file mode 100644 index 00000000..7c0ed101 --- /dev/null +++ b/csp/constraint.rkt @@ -0,0 +1,167 @@ +#lang racket/base +(require racket/class racket/contract racket/match) +(require sugar/container sugar/debug) + +(module+ test (require rackunit)) + +;; Adapted from work by Gustavo Niemeyer +#| +# Copyright (c) 2005-2014 - Gustavo Niemeyer +# +# All rights reserved. +# +# Redistribution and use in source and binary forms, with or without +# modification, are permitted provided that the following conditions are met: +# +# 1. Redistributions of source code must retain the above copyright notice, this +# list of conditions and the following disclaimer. +# 2. Redistributions in binary form must reproduce the above copyright notice, +# this list of conditions and the following disclaimer in the documentation +# and/or other materials provided with the distribution. +# +# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +# AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE +# DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE +# FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +# DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +# SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +# CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +# OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +# OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +|# + +(provide (all-defined-out)) +;(provide Problem Variable Domain Unassigned Solver BacktrackingSolver RecursiveBacktrackingSolver MinConflictsSolver Constraint FunctionConstraint AllDifferentConstraint AllEqualConstraint MaxSumConstraint ExactSumConstraint MinSumConstraint InSetConstraint NotInSetConstraint SomeInSetConstraint SomeNotInSetConstraint) + +;(define Problem/c (λ(x) (is-a x Problem))) + +(define/contract Problem + ;; Class used to define a problem and retrieve solutions + + (class/c [reset (->m void?)] + ;; todo: tighten `object?` contracts + [setSolver (object? . ->m . void?)] + [getSolver (->m object?)] + ;; todo: tighten `object?` contract + [addVariable (any/c (or/c list? object?) . ->m . void?)] + [getSolutions (->m list?)]) + (class object% + (super-new) + + (init-field [solver #f]) + (field [_solver (or solver (new BacktrackingSolver))] + [_constraints null] + [_variables (make-hash)]) + + (define/public (reset) + ;; Reset the current problem definition + (set! _constraints null) + (hash-clear! _variables)) + + (define/public (setSolver solver) + ;; Change the problem solver currently in use + (set! _solver solver)) + + (define/public (getSolver) + ;; Obtain the problem solver currently in use + _solver) + + (define/public (addVariable variable domain) + ;; Add a variable to the problem + (when (variable . in? . _variables) + (error 'addVariable (format "Tried to insert duplicated variable ~a" variable))) + (cond + [(list? domain) (report domain) (set! domain (new Domain [set domain]))] + ;; todo: test for `instance-of-Domain?` ; how to copy domain? + [(object? domain) (report 'foo) (report domain) (set! domain '(copy.copy domain))] + [else (error 'addVariable "Domains must be instances of subclasses of Domain")]) + (when (not domain) ; todo: check this test + (error 'addVariable "Domain is empty")) + (hash-set! _variables variable (get-field _list domain))) + + (define/public (addVariables variables domain) + ;; Add one or more variables to the problem + (for-each (λ(var) (addVariable var domain)) variables)) + + (define/public (getSolutions) + ;; Find and return all solutions to the problem + (define-values (domains constraints vconstraints) (_getArgs)) + (if (not domains) + null + (send _solver getSolutions domains constraints vconstraints))) + + (define/public (_getArgs) + (define domains (hash-copy _variables)) + (define allvariables (hash-keys domains)) + (define constraints null) + (for ([constraint-variables-pair (in-list _constraints)]) + (match-define (cons constraint variables) constraint-variables-pair) + (when (not variables) + (set! variables allvariables)) + (set! constraints (append constraints (list (cons constraint variables))))) + (define vconstraints (make-hash)) + (for ([variable (in-hash-keys domains)]) + (hash-set! vconstraints variable null)) + (for ([constraint-variables-pair (in-list constraints)]) + (match-define (cons constraint variables) constraint-variables-pair) + (for ([variable (in-list variables)]) + (hash-update! vconstraints variable (λ(val) (append val (list (cons constraint variables))))))) + (for ([constraint-variables-pair (in-list constraints)]) + (match-define (cons constraint variables) constraint-variables-pair) + (send constraint preProcess variables domains constraints vconstraints)) + (define result #f) + (let/ec done + (for ([domain (in-list (hash-values domains))]) + (send domain resetState) + (when (not domain) + (set! result (values null null null)) + (done))) + (set! result (values domains constraints vconstraints))) + result) + + + )) + +(module+ test + (check-equal? (get-field _solver (new Problem [solver 'solver-in])) 'solver-in) + (check-equal? (get-field _constraints (new Problem)) null) + (check-equal? (get-field _variables (new Problem)) (make-hash)) + + (define problem (new Problem)) + (send problem addVariable "a" '(1 2)) + (check-equal? (hash-ref (get-field _variables problem) "a") '(1 2)) + (send problem reset) + (check-equal? (get-field _variables problem) (make-hash)) + (send problem addVariables '("a" "b") '(1 2 3)) + (check-equal? (hash-ref (get-field _variables problem) "a") '(1 2 3)) + (check-equal? (hash-ref (get-field _variables problem) "b") '(1 2 3)) + (get-field _variables problem) + (send problem getSolutions) + ) + + +(define BacktrackingSolver + (class object% + (super-new))) + + +;; ---------------------------------------------------------------------- +;; Domains +;; ---------------------------------------------------------------------- + + +(define Domain + ;; Class used to control possible values for variables + ;; When list or tuples are used as domains, they are automatically + ;; converted to an instance of that class. + + (class object% + (super-new) + (init-field set) + (field [_list set]))) + +(module+ main + (define p (new Problem)) + (define d (new Domain [set '(1 2)])) + ) \ No newline at end of file diff --git a/csp/csp.rkt b/csp/csp.rkt index f101ebb6..e0cb48bc 100644 --- a/csp/csp.rkt +++ b/csp/csp.rkt @@ -4,6 +4,7 @@ ;; http://aima-python.googlecode.com/svn/trunk/csp.py (require racket/list racket/bool racket/contract racket/class racket/match racket/generator racket/string) +(require sugar/debug) (require "utils.rkt" "search.rkt") (module+ test (require rackunit)) @@ -310,9 +311,9 @@ Set up to do recursive backtracking search. Allow the following options: [A (in-list type)] [B (in-list type)]) (when (not (equal? A B)) - (when (not (memq B (hash-ref neighbors A))) + (when (not (member B (report (hash-ref neighbors A)))) (hash-update! neighbors A (λ(v) (append v B)))) - (when (not (memq A (hash-ref neighbors B))) + (when (not (member A (hash-ref neighbors B))) (hash-update! neighbors B (λ(v) (append v A)))))) (define (zebra_constraint A a B b [recurse 0]) diff --git a/csp/python-constraint/API Documentation.webloc b/csp/python-constraint/API Documentation.webloc new file mode 100644 index 00000000..3cae8191 --- /dev/null +++ b/csp/python-constraint/API Documentation.webloc @@ -0,0 +1,8 @@ + + + + + URL + http://labix.org/doc/constraint/ + + diff --git a/csp/python-constraint/trials/abc.py b/csp/python-constraint/trials/abc.py new file mode 100755 index 00000000..800cf2c0 --- /dev/null +++ b/csp/python-constraint/trials/abc.py @@ -0,0 +1,30 @@ +#!/usr/bin/python +# +# What's the minimum value for: +# +# ABC +# ------- +# A+B+C +# +# From http://www.umassd.edu/mathcontest/abc.cfm +# +from constraint import * + +def main(): + problem = Problem() + problem.addVariables("abc", range(1,10)) + problem.getSolutions() + minvalue = 999/(9*3) + minsolution = {} + for solution in problem.getSolutions(): + a = solution["a"] + b = solution["b"] + c = solution["c"] + value = (a*100+b*10+c)/(a+b+c) + if value < minvalue: + minsolution = solution + print (minsolution["a"]*100+minsolution["b"]*10+minsolution["c"])/(minsolution["a"]+minsolution["b"]+minsolution["c"]) + print minsolution + +if __name__ == "__main__": + main() diff --git a/csp/python-constraint/trials/coins.py b/csp/python-constraint/trials/coins.py new file mode 100755 index 00000000..cb47537d --- /dev/null +++ b/csp/python-constraint/trials/coins.py @@ -0,0 +1,30 @@ +#!/usr/bin/python +# +# 100 coins must sum to $5.00 +# +# That's kind of a country-specific problem, since depending on the +# country there are different values for coins. Here is presented +# the solution for a given set. +# +from constraint import * +import sys + +def main(): + problem = Problem() + total = 5.00 + variables = ("0.01", "0.05", "0.10", "0.25") + values = [float(x) for x in variables] + for variable, value in zip(variables, values): + problem.addVariable(variable, range(int(total/value))) + problem.addConstraint(ExactSumConstraint(total, values), variables) + problem.addConstraint(ExactSumConstraint(100)) + solutions = problem.getSolutionIter() + for i, solution in enumerate(solutions): + sys.stdout.write("%03d -> " % (i+1)) + for variable in variables: + sys.stdout.write("%s:%d " % (variable, solution[variable])) + sys.stdout.write("\n") + +if __name__ == "__main__": + main() + diff --git a/csp/python-constraint/trials/constraint.py b/csp/python-constraint/trials/constraint.py new file mode 100644 index 00000000..b1cd836b --- /dev/null +++ b/csp/python-constraint/trials/constraint.py @@ -0,0 +1,1434 @@ +#!/usr/bin/python +# +# Copyright (c) 2005-2014 - Gustavo Niemeyer +# +# All rights reserved. +# +# Redistribution and use in source and binary forms, with or without +# modification, are permitted provided that the following conditions are met: +# +# 1. Redistributions of source code must retain the above copyright notice, this +# list of conditions and the following disclaimer. +# 2. Redistributions in binary form must reproduce the above copyright notice, +# this list of conditions and the following disclaimer in the documentation +# and/or other materials provided with the distribution. +# +# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +# AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE +# DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE +# FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +# DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +# SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +# CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +# OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +# OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +""" +@var Unassigned: Helper object instance representing unassigned values + +@sort: Problem, Variable, Domain +@group Solvers: Solver, + BacktrackingSolver, + RecursiveBacktrackingSolver, + MinConflictsSolver +@group Constraints: Constraint, + FunctionConstraint, + AllDifferentConstraint, + AllEqualConstraint, + MaxSumConstraint, + ExactSumConstraint, + MinSumConstraint, + InSetConstraint, + NotInSetConstraint, + SomeInSetConstraint, + SomeNotInSetConstraint +""" +import random +import copy + +__all__ = ["Problem", "Variable", "Domain", "Unassigned", + "Solver", "BacktrackingSolver", "RecursiveBacktrackingSolver", + "MinConflictsSolver", "Constraint", "FunctionConstraint", + "AllDifferentConstraint", "AllEqualConstraint", "MaxSumConstraint", + "ExactSumConstraint", "MinSumConstraint", "InSetConstraint", + "NotInSetConstraint", "SomeInSetConstraint", + "SomeNotInSetConstraint"] + +class Problem(object): + """ + Class used to define a problem and retrieve solutions + """ + + def __init__(self, solver=None): + """ + @param solver: Problem solver used to find solutions + (default is L{BacktrackingSolver}) + @type solver: instance of a L{Solver} subclass + """ + self._solver = solver or BacktrackingSolver() + self._constraints = [] + self._variables = {} + + def reset(self): + """ + Reset the current problem definition + + Example: + + >>> problem = Problem() + >>> problem.addVariable("a", [1, 2]) + >>> problem.reset() + >>> problem.getSolution() + >>> + """ + del self._constraints[:] + self._variables.clear() + + def setSolver(self, solver): + """ + Change the problem solver currently in use + + Example: + + >>> solver = BacktrackingSolver() + >>> problem = Problem(solver) + >>> problem.getSolver() is solver + True + + @param solver: New problem solver + @type solver: instance of a C{Solver} subclass + """ + self._solver = solver + + def getSolver(self): + """ + Obtain the problem solver currently in use + + Example: + + >>> solver = BacktrackingSolver() + >>> problem = Problem(solver) + >>> problem.getSolver() is solver + True + + @return: Solver currently in use + @rtype: instance of a L{Solver} subclass + """ + return self._solver + + def addVariable(self, variable, domain): + """ + Add a variable to the problem + + Example: + + >>> problem = Problem() + >>> problem.addVariable("a", [1, 2]) + >>> problem.getSolution() in ({'a': 1}, {'a': 2}) + True + + @param variable: Object representing a problem variable + @type variable: hashable object + @param domain: Set of items defining the possible values that + the given variable may assume + @type domain: list, tuple, or instance of C{Domain} + """ + if variable in self._variables: + raise ValueError, "Tried to insert duplicated variable %s" % \ + repr(variable) + if type(domain) in (list, tuple): + domain = Domain(domain) + elif isinstance(domain, Domain): + domain = copy.copy(domain) + else: + raise TypeError, "Domains must be instances of subclasses of "\ + "the Domain class" + if not domain: + raise ValueError, "Domain is empty" + self._variables[variable] = domain + + def addVariables(self, variables, domain): + """ + Add one or more variables to the problem + + Example: + + >>> problem = Problem() + >>> problem.addVariables(["a", "b"], [1, 2, 3]) + >>> solutions = problem.getSolutions() + >>> len(solutions) + 9 + >>> {'a': 3, 'b': 1} in solutions + True + + @param variables: Any object containing a sequence of objects + represeting problem variables + @type variables: sequence of hashable objects + @param domain: Set of items defining the possible values that + the given variables may assume + @type domain: list, tuple, or instance of C{Domain} + """ + for variable in variables: + self.addVariable(variable, domain) + + def addConstraint(self, constraint, variables=None): + """ + Add a constraint to the problem + + Example: + + >>> problem = Problem() + >>> problem.addVariables(["a", "b"], [1, 2, 3]) + >>> problem.addConstraint(lambda a, b: b == a+1, ["a", "b"]) + >>> solutions = problem.getSolutions() + >>> + + @param constraint: Constraint to be included in the problem + @type constraint: instance a L{Constraint} subclass or a + function to be wrapped by L{FunctionConstraint} + @param variables: Variables affected by the constraint (default to + all variables). Depending on the constraint type + the order may be important. + @type variables: set or sequence of variables + """ + if not isinstance(constraint, Constraint): + if callable(constraint): + constraint = FunctionConstraint(constraint) + else: + raise ValueError, "Constraints must be instances of "\ + "subclasses of the Constraint class" + self._constraints.append((constraint, variables)) + + def getSolution(self): + """ + Find and return a solution to the problem + + Example: + + >>> problem = Problem() + >>> problem.getSolution() is None + True + >>> problem.addVariables(["a"], [42]) + >>> problem.getSolution() + {'a': 42} + + @return: Solution for the problem + @rtype: dictionary mapping variables to values + """ + domains, constraints, vconstraints = self._getArgs() + if not domains: + return None + return self._solver.getSolution(domains, constraints, vconstraints) + + def getSolutions(self): + """ + Find and return all solutions to the problem + + Example: + + >>> problem = Problem() + >>> problem.getSolutions() == [] + True + >>> problem.addVariables(["a"], [42]) + >>> problem.getSolutions() + [{'a': 42}] + + @return: All solutions for the problem + @rtype: list of dictionaries mapping variables to values + """ + domains, constraints, vconstraints = self._getArgs() + if not domains: + return [] + return self._solver.getSolutions(domains, constraints, vconstraints) + + def getSolutionIter(self): + """ + Return an iterator to the solutions of the problem + + Example: + + >>> problem = Problem() + >>> list(problem.getSolutionIter()) == [] + True + >>> problem.addVariables(["a"], [42]) + >>> iter = problem.getSolutionIter() + >>> iter.next() + {'a': 42} + >>> iter.next() + Traceback (most recent call last): + File "", line 1, in ? + StopIteration + """ + domains, constraints, vconstraints = self._getArgs() + if not domains: + return iter(()) + return self._solver.getSolutionIter(domains, constraints, + vconstraints) + + def _getArgs(self): + domains = self._variables.copy() + allvariables = domains.keys() + constraints = [] + for constraint, variables in self._constraints: + if not variables: + variables = allvariables + constraints.append((constraint, variables)) + vconstraints = {} + for variable in domains: + vconstraints[variable] = [] + for constraint, variables in constraints: + for variable in variables: + vconstraints[variable].append((constraint, variables)) + for constraint, variables in constraints[:]: + constraint.preProcess(variables, domains, + constraints, vconstraints) + for domain in domains.values(): + domain.resetState() + if not domain: + return None, None, None + #doArc8(getArcs(domains, constraints), domains, {}) + return domains, constraints, vconstraints + +# ---------------------------------------------------------------------- +# Solvers +# ---------------------------------------------------------------------- + +def getArcs(domains, constraints): + """ + Return a dictionary mapping pairs (arcs) of constrained variables + + @attention: Currently unused. + """ + arcs = {} + for x in constraints: + constraint, variables = x + if len(variables) == 2: + variable1, variable2 = variables + arcs.setdefault(variable1, {})\ + .setdefault(variable2, [])\ + .append(x) + arcs.setdefault(variable2, {})\ + .setdefault(variable1, [])\ + .append(x) + return arcs + +def doArc8(arcs, domains, assignments): + """ + Perform the ARC-8 arc checking algorithm and prune domains + + @attention: Currently unused. + """ + check = dict.fromkeys(domains, True) + while check: + variable, _ = check.popitem() + if variable not in arcs or variable in assignments: + continue + domain = domains[variable] + arcsvariable = arcs[variable] + for othervariable in arcsvariable: + arcconstraints = arcsvariable[othervariable] + if othervariable in assignments: + otherdomain = [assignments[othervariable]] + else: + otherdomain = domains[othervariable] + if domain: + changed = False + for value in domain[:]: + assignments[variable] = value + if otherdomain: + for othervalue in otherdomain: + assignments[othervariable] = othervalue + for constraint, variables in arcconstraints: + if not constraint(variables, domains, + assignments, True): + break + else: + # All constraints passed. Value is safe. + break + else: + # All othervalues failed. Kill value. + domain.hideValue(value) + changed = True + del assignments[othervariable] + del assignments[variable] + #if changed: + # check.update(dict.fromkeys(arcsvariable)) + if not domain: + return False + return True + +class Solver(object): + """ + Abstract base class for solvers + + @sort: getSolution, getSolutions, getSolutionIter + """ + + def getSolution(self, domains, constraints, vconstraints): + """ + Return one solution for the given problem + + @param domains: Dictionary mapping variables to their domains + @type domains: dict + @param constraints: List of pairs of (constraint, variables) + @type constraints: list + @param vconstraints: Dictionary mapping variables to a list of + constraints affecting the given variables. + @type vconstraints: dict + """ + raise NotImplementedError, \ + "%s is an abstract class" % self.__class__.__name__ + + def getSolutions(self, domains, constraints, vconstraints): + """ + Return all solutions for the given problem + + @param domains: Dictionary mapping variables to domains + @type domains: dict + @param constraints: List of pairs of (constraint, variables) + @type constraints: list + @param vconstraints: Dictionary mapping variables to a list of + constraints affecting the given variables. + @type vconstraints: dict + """ + raise NotImplementedError, \ + "%s provides only a single solution" % self.__class__.__name__ + + def getSolutionIter(self, domains, constraints, vconstraints): + """ + Return an iterator for the solutions of the given problem + + @param domains: Dictionary mapping variables to domains + @type domains: dict + @param constraints: List of pairs of (constraint, variables) + @type constraints: list + @param vconstraints: Dictionary mapping variables to a list of + constraints affecting the given variables. + @type vconstraints: dict + """ + raise NotImplementedError, \ + "%s doesn't provide iteration" % self.__class__.__name__ + +class BacktrackingSolver(Solver): + """ + Problem solver with backtracking capabilities + + Examples: + + >>> result = [[('a', 1), ('b', 2)], + ... [('a', 1), ('b', 3)], + ... [('a', 2), ('b', 3)]] + + >>> problem = Problem(BacktrackingSolver()) + >>> problem.addVariables(["a", "b"], [1, 2, 3]) + >>> problem.addConstraint(lambda a, b: b > a, ["a", "b"]) + + >>> solution = problem.getSolution() + >>> sorted(solution.items()) in result + True + + >>> for solution in problem.getSolutionIter(): + ... sorted(solution.items()) in result + True + True + True + + >>> for solution in problem.getSolutions(): + ... sorted(solution.items()) in result + True + True + True + """#""" + + def __init__(self, forwardcheck=True): + """ + @param forwardcheck: If false forward checking will not be requested + to constraints while looking for solutions + (default is true) + @type forwardcheck: bool + """ + self._forwardcheck = forwardcheck + + def getSolutionIter(self, domains, constraints, vconstraints): + forwardcheck = self._forwardcheck + assignments = {} + + queue = [] + + while True: + + # Mix the Degree and Minimum Remaing Values (MRV) heuristics + lst = [(-len(vconstraints[variable]), + len(domains[variable]), variable) for variable in domains] + lst.sort() + for item in lst: + if item[-1] not in assignments: + # Found unassigned variable + variable = item[-1] + values = domains[variable][:] + if forwardcheck: + pushdomains = [domains[x] for x in domains + if x not in assignments and + x != variable] + else: + pushdomains = None + break + else: + # No unassigned variables. We've got a solution. Go back + # to last variable, if there's one. + yield assignments.copy() + if not queue: + return + variable, values, pushdomains = queue.pop() + if pushdomains: + for domain in pushdomains: + domain.popState() + + while True: + # We have a variable. Do we have any values left? + if not values: + # No. Go back to last variable, if there's one. + del assignments[variable] + while queue: + variable, values, pushdomains = queue.pop() + if pushdomains: + for domain in pushdomains: + domain.popState() + if values: + break + del assignments[variable] + else: + return + + # Got a value. Check it. + assignments[variable] = values.pop() + + if pushdomains: + for domain in pushdomains: + domain.pushState() + + for constraint, variables in vconstraints[variable]: + if not constraint(variables, domains, assignments, + pushdomains): + # Value is not good. + break + else: + break + + if pushdomains: + for domain in pushdomains: + domain.popState() + + # Push state before looking for next variable. + queue.append((variable, values, pushdomains)) + + raise RuntimeError, "Can't happen" + + def getSolution(self, domains, constraints, vconstraints): + iter = self.getSolutionIter(domains, constraints, vconstraints) + try: + return iter.next() + except StopIteration: + return None + + def getSolutions(self, domains, constraints, vconstraints): + return list(self.getSolutionIter(domains, constraints, vconstraints)) + + +class RecursiveBacktrackingSolver(Solver): + """ + Recursive problem solver with backtracking capabilities + + Examples: + + >>> result = [[('a', 1), ('b', 2)], + ... [('a', 1), ('b', 3)], + ... [('a', 2), ('b', 3)]] + + >>> problem = Problem(RecursiveBacktrackingSolver()) + >>> problem.addVariables(["a", "b"], [1, 2, 3]) + >>> problem.addConstraint(lambda a, b: b > a, ["a", "b"]) + + >>> solution = problem.getSolution() + >>> sorted(solution.items()) in result + True + + >>> for solution in problem.getSolutions(): + ... sorted(solution.items()) in result + True + True + True + + >>> problem.getSolutionIter() + Traceback (most recent call last): + ... + NotImplementedError: RecursiveBacktrackingSolver doesn't provide iteration + """#""" + + def __init__(self, forwardcheck=True): + """ + @param forwardcheck: If false forward checking will not be requested + to constraints while looking for solutions + (default is true) + @type forwardcheck: bool + """ + self._forwardcheck = forwardcheck + + def recursiveBacktracking(self, solutions, domains, vconstraints, + assignments, single): + + # Mix the Degree and Minimum Remaing Values (MRV) heuristics + lst = [(-len(vconstraints[variable]), + len(domains[variable]), variable) for variable in domains] + lst.sort() + for item in lst: + if item[-1] not in assignments: + # Found an unassigned variable. Let's go. + break + else: + # No unassigned variables. We've got a solution. + solutions.append(assignments.copy()) + return solutions + + variable = item[-1] + assignments[variable] = None + + forwardcheck = self._forwardcheck + if forwardcheck: + pushdomains = [domains[x] for x in domains if x not in assignments] + else: + pushdomains = None + + for value in domains[variable]: + assignments[variable] = value + if pushdomains: + for domain in pushdomains: + domain.pushState() + for constraint, variables in vconstraints[variable]: + if not constraint(variables, domains, assignments, + pushdomains): + # Value is not good. + break + else: + # Value is good. Recurse and get next variable. + self.recursiveBacktracking(solutions, domains, vconstraints, + assignments, single) + if solutions and single: + return solutions + if pushdomains: + for domain in pushdomains: + domain.popState() + del assignments[variable] + return solutions + + def getSolution(self, domains, constraints, vconstraints): + solutions = self.recursiveBacktracking([], domains, vconstraints, + {}, True) + return solutions and solutions[0] or None + + def getSolutions(self, domains, constraints, vconstraints): + return self.recursiveBacktracking([], domains, vconstraints, + {}, False) + + +class MinConflictsSolver(Solver): + """ + Problem solver based on the minimum conflicts theory + + Examples: + + >>> result = [[('a', 1), ('b', 2)], + ... [('a', 1), ('b', 3)], + ... [('a', 2), ('b', 3)]] + + >>> problem = Problem(MinConflictsSolver()) + >>> problem.addVariables(["a", "b"], [1, 2, 3]) + >>> problem.addConstraint(lambda a, b: b > a, ["a", "b"]) + + >>> solution = problem.getSolution() + >>> sorted(solution.items()) in result + True + + >>> problem.getSolutions() + Traceback (most recent call last): + ... + NotImplementedError: MinConflictsSolver provides only a single solution + + >>> problem.getSolutionIter() + Traceback (most recent call last): + ... + NotImplementedError: MinConflictsSolver doesn't provide iteration + """#""" + + def __init__(self, steps=1000): + """ + @param steps: Maximum number of steps to perform before giving up + when looking for a solution (default is 1000) + @type steps: int + """ + self._steps = steps + + def getSolution(self, domains, constraints, vconstraints): + assignments = {} + # Initial assignment + for variable in domains: + assignments[variable] = random.choice(domains[variable]) + for _ in xrange(self._steps): + conflicted = False + lst = domains.keys() + random.shuffle(lst) + for variable in lst: + # Check if variable is not in conflict + for constraint, variables in vconstraints[variable]: + if not constraint(variables, domains, assignments): + break + else: + continue + # Variable has conflicts. Find values with less conflicts. + mincount = len(vconstraints[variable]) + minvalues = [] + for value in domains[variable]: + assignments[variable] = value + count = 0 + for constraint, variables in vconstraints[variable]: + if not constraint(variables, domains, assignments): + count += 1 + if count == mincount: + minvalues.append(value) + elif count < mincount: + mincount = count + del minvalues[:] + minvalues.append(value) + # Pick a random one from these values. + assignments[variable] = random.choice(minvalues) + conflicted = True + if not conflicted: + return assignments + return None + +# ---------------------------------------------------------------------- +# Variables +# ---------------------------------------------------------------------- + +class Variable(object): + """ + Helper class for variable definition + + Using this class is optional, since any hashable object, + including plain strings and integers, may be used as variables. + """ + + def __init__(self, name): + """ + @param name: Generic variable name for problem-specific purposes + @type name: string + """ + self.name = name + + def __repr__(self): + return self.name + +Unassigned = Variable("Unassigned") + +# ---------------------------------------------------------------------- +# Domains +# ---------------------------------------------------------------------- + +class Domain(list): + """ + Class used to control possible values for variables + + When list or tuples are used as domains, they are automatically + converted to an instance of that class. + """ + + def __init__(self, set): + """ + @param set: Set of values that the given variables may assume + @type set: set of objects comparable by equality + """ + list.__init__(self, set) + self._hidden = [] + self._states = [] + + def resetState(self): + """ + Reset to the original domain state, including all possible values + """ + self.extend(self._hidden) + del self._hidden[:] + del self._states[:] + + def pushState(self): + """ + Save current domain state + + Variables hidden after that call are restored when that state + is popped from the stack. + """ + self._states.append(len(self)) + + def popState(self): + """ + Restore domain state from the top of the stack + + Variables hidden since the last popped state are then available + again. + """ + diff = self._states.pop()-len(self) + if diff: + self.extend(self._hidden[-diff:]) + del self._hidden[-diff:] + + def hideValue(self, value): + """ + Hide the given value from the domain + + After that call the given value won't be seen as a possible value + on that domain anymore. The hidden value will be restored when the + previous saved state is popped. + + @param value: Object currently available in the domain + """ + list.remove(self, value) + self._hidden.append(value) + +# ---------------------------------------------------------------------- +# Constraints +# ---------------------------------------------------------------------- + +class Constraint(object): + """ + Abstract base class for constraints + """ + + def __call__(self, variables, domains, assignments, forwardcheck=False): + """ + Perform the constraint checking + + If the forwardcheck parameter is not false, besides telling if + the constraint is currently broken or not, the constraint + implementation may choose to hide values from the domains of + unassigned variables to prevent them from being used, and thus + prune the search space. + + @param variables: Variables affected by that constraint, in the + same order provided by the user + @type variables: sequence + @param domains: Dictionary mapping variables to their domains + @type domains: dict + @param assignments: Dictionary mapping assigned variables to their + current assumed value + @type assignments: dict + @param forwardcheck: Boolean value stating whether forward checking + should be performed or not + @return: Boolean value stating if this constraint is currently + broken or not + @rtype: bool + """#""" + return True + + def preProcess(self, variables, domains, constraints, vconstraints): + """ + Preprocess variable domains + + This method is called before starting to look for solutions, + and is used to prune domains with specific constraint logic + when possible. For instance, any constraints with a single + variable may be applied on all possible values and removed, + since they may act on individual values even without further + knowledge about other assignments. + + @param variables: Variables affected by that constraint, in the + same order provided by the user + @type variables: sequence + @param domains: Dictionary mapping variables to their domains + @type domains: dict + @param constraints: List of pairs of (constraint, variables) + @type constraints: list + @param vconstraints: Dictionary mapping variables to a list of + constraints affecting the given variables. + @type vconstraints: dict + """#""" + if len(variables) == 1: + variable = variables[0] + domain = domains[variable] + for value in domain[:]: + if not self(variables, domains, {variable: value}): + domain.remove(value) + constraints.remove((self, variables)) + vconstraints[variable].remove((self, variables)) + + def forwardCheck(self, variables, domains, assignments, + _unassigned=Unassigned): + """ + Helper method for generic forward checking + + Currently, this method acts only when there's a single + unassigned variable. + + @param variables: Variables affected by that constraint, in the + same order provided by the user + @type variables: sequence + @param domains: Dictionary mapping variables to their domains + @type domains: dict + @param assignments: Dictionary mapping assigned variables to their + current assumed value + @type assignments: dict + @return: Boolean value stating if this constraint is currently + broken or not + @rtype: bool + """#""" + unassignedvariable = _unassigned + for variable in variables: + if variable not in assignments: + if unassignedvariable is _unassigned: + unassignedvariable = variable + else: + break + else: + if unassignedvariable is not _unassigned: + # Remove from the unassigned variable domain's all + # values which break our variable's constraints. + domain = domains[unassignedvariable] + if domain: + for value in domain[:]: + assignments[unassignedvariable] = value + if not self(variables, domains, assignments): + domain.hideValue(value) + del assignments[unassignedvariable] + if not domain: + return False + return True + +class FunctionConstraint(Constraint): + """ + Constraint which wraps a function defining the constraint logic + + Examples: + + >>> problem = Problem() + >>> problem.addVariables(["a", "b"], [1, 2]) + >>> def func(a, b): + ... return b > a + >>> problem.addConstraint(func, ["a", "b"]) + >>> problem.getSolution() + {'a': 1, 'b': 2} + + >>> problem = Problem() + >>> problem.addVariables(["a", "b"], [1, 2]) + >>> def func(a, b): + ... return b > a + >>> problem.addConstraint(FunctionConstraint(func), ["a", "b"]) + >>> problem.getSolution() + {'a': 1, 'b': 2} + """#""" + + def __init__(self, func, assigned=True): + """ + @param func: Function wrapped and queried for constraint logic + @type func: callable object + @param assigned: Whether the function may receive unassigned + variables or not + @type assigned: bool + """ + self._func = func + self._assigned = assigned + + def __call__(self, variables, domains, assignments, forwardcheck=False, + _unassigned=Unassigned): + parms = [assignments.get(x, _unassigned) for x in variables] + missing = parms.count(_unassigned) + if missing: + return ((self._assigned or self._func(*parms)) and + (not forwardcheck or missing != 1 or + self.forwardCheck(variables, domains, assignments))) + return self._func(*parms) + +class AllDifferentConstraint(Constraint): + """ + Constraint enforcing that values of all given variables are different + + Example: + + >>> problem = Problem() + >>> problem.addVariables(["a", "b"], [1, 2]) + >>> problem.addConstraint(AllDifferentConstraint()) + >>> sorted(sorted(x.items()) for x in problem.getSolutions()) + [[('a', 1), ('b', 2)], [('a', 2), ('b', 1)]] + """#""" + + def __call__(self, variables, domains, assignments, forwardcheck=False, + _unassigned=Unassigned): + seen = {} + for variable in variables: + value = assignments.get(variable, _unassigned) + if value is not _unassigned: + if value in seen: + return False + seen[value] = True + if forwardcheck: + for variable in variables: + if variable not in assignments: + domain = domains[variable] + for value in seen: + if value in domain: + domain.hideValue(value) + if not domain: + return False + return True + +class AllEqualConstraint(Constraint): + """ + Constraint enforcing that values of all given variables are equal + + Example: + + >>> problem = Problem() + >>> problem.addVariables(["a", "b"], [1, 2]) + >>> problem.addConstraint(AllEqualConstraint()) + >>> sorted(sorted(x.items()) for x in problem.getSolutions()) + [[('a', 1), ('b', 1)], [('a', 2), ('b', 2)]] + """#""" + + def __call__(self, variables, domains, assignments, forwardcheck=False, + _unassigned=Unassigned): + singlevalue = _unassigned + for variable in variables: + value = assignments.get(variable, _unassigned) + if singlevalue is _unassigned: + singlevalue = value + elif value is not _unassigned and value != singlevalue: + return False + if forwardcheck and singlevalue is not _unassigned: + for variable in variables: + if variable not in assignments: + domain = domains[variable] + if singlevalue not in domain: + return False + for value in domain[:]: + if value != singlevalue: + domain.hideValue(value) + return True + +class MaxSumConstraint(Constraint): + """ + Constraint enforcing that values of given variables sum up to + a given amount + + Example: + + >>> problem = Problem() + >>> problem.addVariables(["a", "b"], [1, 2]) + >>> problem.addConstraint(MaxSumConstraint(3)) + >>> sorted(sorted(x.items()) for x in problem.getSolutions()) + [[('a', 1), ('b', 1)], [('a', 1), ('b', 2)], [('a', 2), ('b', 1)]] + """#""" + + def __init__(self, maxsum, multipliers=None): + """ + @param maxsum: Value to be considered as the maximum sum + @type maxsum: number + @param multipliers: If given, variable values will be multiplied by + the given factors before being summed to be checked + @type multipliers: sequence of numbers + """ + self._maxsum = maxsum + self._multipliers = multipliers + + def preProcess(self, variables, domains, constraints, vconstraints): + Constraint.preProcess(self, variables, domains, + constraints, vconstraints) + multipliers = self._multipliers + maxsum = self._maxsum + if multipliers: + for variable, multiplier in zip(variables, multipliers): + domain = domains[variable] + for value in domain[:]: + if value*multiplier > maxsum: + domain.remove(value) + else: + for variable in variables: + domain = domains[variable] + for value in domain[:]: + if value > maxsum: + domain.remove(value) + + def __call__(self, variables, domains, assignments, forwardcheck=False): + multipliers = self._multipliers + maxsum = self._maxsum + sum = 0 + if multipliers: + for variable, multiplier in zip(variables, multipliers): + if variable in assignments: + sum += assignments[variable]*multiplier + if type(sum) is float: + sum = round(sum, 10) + if sum > maxsum: + return False + if forwardcheck: + for variable, multiplier in zip(variables, multipliers): + if variable not in assignments: + domain = domains[variable] + for value in domain[:]: + if sum+value*multiplier > maxsum: + domain.hideValue(value) + if not domain: + return False + else: + for variable in variables: + if variable in assignments: + sum += assignments[variable] + if type(sum) is float: + sum = round(sum, 10) + if sum > maxsum: + return False + if forwardcheck: + for variable in variables: + if variable not in assignments: + domain = domains[variable] + for value in domain[:]: + if sum+value > maxsum: + domain.hideValue(value) + if not domain: + return False + return True + +class ExactSumConstraint(Constraint): + """ + Constraint enforcing that values of given variables sum exactly + to a given amount + + Example: + + >>> problem = Problem() + >>> problem.addVariables(["a", "b"], [1, 2]) + >>> problem.addConstraint(ExactSumConstraint(3)) + >>> sorted(sorted(x.items()) for x in problem.getSolutions()) + [[('a', 1), ('b', 2)], [('a', 2), ('b', 1)]] + """#""" + + def __init__(self, exactsum, multipliers=None): + """ + @param exactsum: Value to be considered as the exact sum + @type exactsum: number + @param multipliers: If given, variable values will be multiplied by + the given factors before being summed to be checked + @type multipliers: sequence of numbers + """ + self._exactsum = exactsum + self._multipliers = multipliers + + def preProcess(self, variables, domains, constraints, vconstraints): + Constraint.preProcess(self, variables, domains, + constraints, vconstraints) + multipliers = self._multipliers + exactsum = self._exactsum + if multipliers: + for variable, multiplier in zip(variables, multipliers): + domain = domains[variable] + for value in domain[:]: + if value*multiplier > exactsum: + domain.remove(value) + else: + for variable in variables: + domain = domains[variable] + for value in domain[:]: + if value > exactsum: + domain.remove(value) + + def __call__(self, variables, domains, assignments, forwardcheck=False): + multipliers = self._multipliers + exactsum = self._exactsum + sum = 0 + missing = False + if multipliers: + for variable, multiplier in zip(variables, multipliers): + if variable in assignments: + sum += assignments[variable]*multiplier + else: + missing = True + if type(sum) is float: + sum = round(sum, 10) + if sum > exactsum: + return False + if forwardcheck and missing: + for variable, multiplier in zip(variables, multipliers): + if variable not in assignments: + domain = domains[variable] + for value in domain[:]: + if sum+value*multiplier > exactsum: + domain.hideValue(value) + if not domain: + return False + else: + for variable in variables: + if variable in assignments: + sum += assignments[variable] + else: + missing = True + if type(sum) is float: + sum = round(sum, 10) + if sum > exactsum: + return False + if forwardcheck and missing: + for variable in variables: + if variable not in assignments: + domain = domains[variable] + for value in domain[:]: + if sum+value > exactsum: + domain.hideValue(value) + if not domain: + return False + if missing: + return sum <= exactsum + else: + return sum == exactsum + +class MinSumConstraint(Constraint): + """ + Constraint enforcing that values of given variables sum at least + to a given amount + + Example: + + >>> problem = Problem() + >>> problem.addVariables(["a", "b"], [1, 2]) + >>> problem.addConstraint(MinSumConstraint(3)) + >>> sorted(sorted(x.items()) for x in problem.getSolutions()) + [[('a', 1), ('b', 2)], [('a', 2), ('b', 1)], [('a', 2), ('b', 2)]] + """#""" + + def __init__(self, minsum, multipliers=None): + """ + @param minsum: Value to be considered as the minimum sum + @type minsum: number + @param multipliers: If given, variable values will be multiplied by + the given factors before being summed to be checked + @type multipliers: sequence of numbers + """ + self._minsum = minsum + self._multipliers = multipliers + + def __call__(self, variables, domains, assignments, forwardcheck=False): + for variable in variables: + if variable not in assignments: + return True + else: + multipliers = self._multipliers + minsum = self._minsum + sum = 0 + if multipliers: + for variable, multiplier in zip(variables, multipliers): + sum += assignments[variable]*multiplier + else: + for variable in variables: + sum += assignments[variable] + if type(sum) is float: + sum = round(sum, 10) + return sum >= minsum + +class InSetConstraint(Constraint): + """ + Constraint enforcing that values of given variables are present in + the given set + + Example: + + >>> problem = Problem() + >>> problem.addVariables(["a", "b"], [1, 2]) + >>> problem.addConstraint(InSetConstraint([1])) + >>> sorted(sorted(x.items()) for x in problem.getSolutions()) + [[('a', 1), ('b', 1)]] + """#""" + + def __init__(self, set): + """ + @param set: Set of allowed values + @type set: set + """ + self._set = set + + def __call__(self, variables, domains, assignments, forwardcheck=False): + # preProcess() will remove it. + raise RuntimeError, "Can't happen" + + def preProcess(self, variables, domains, constraints, vconstraints): + set = self._set + for variable in variables: + domain = domains[variable] + for value in domain[:]: + if value not in set: + domain.remove(value) + vconstraints[variable].remove((self, variables)) + constraints.remove((self, variables)) + +class NotInSetConstraint(Constraint): + """ + Constraint enforcing that values of given variables are not present in + the given set + + Example: + + >>> problem = Problem() + >>> problem.addVariables(["a", "b"], [1, 2]) + >>> problem.addConstraint(NotInSetConstraint([1])) + >>> sorted(sorted(x.items()) for x in problem.getSolutions()) + [[('a', 2), ('b', 2)]] + """#""" + + def __init__(self, set): + """ + @param set: Set of disallowed values + @type set: set + """ + self._set = set + + def __call__(self, variables, domains, assignments, forwardcheck=False): + # preProcess() will remove it. + raise RuntimeError, "Can't happen" + + def preProcess(self, variables, domains, constraints, vconstraints): + set = self._set + for variable in variables: + domain = domains[variable] + for value in domain[:]: + if value in set: + domain.remove(value) + vconstraints[variable].remove((self, variables)) + constraints.remove((self, variables)) + +class SomeInSetConstraint(Constraint): + """ + Constraint enforcing that at least some of the values of given + variables must be present in a given set + + Example: + + >>> problem = Problem() + >>> problem.addVariables(["a", "b"], [1, 2]) + >>> problem.addConstraint(SomeInSetConstraint([1])) + >>> sorted(sorted(x.items()) for x in problem.getSolutions()) + [[('a', 1), ('b', 1)], [('a', 1), ('b', 2)], [('a', 2), ('b', 1)]] + """#""" + + def __init__(self, set, n=1, exact=False): + """ + @param set: Set of values to be checked + @type set: set + @param n: Minimum number of assigned values that should be present + in set (default is 1) + @type n: int + @param exact: Whether the number of assigned values which are + present in set must be exactly C{n} + @type exact: bool + """ + self._set = set + self._n = n + self._exact = exact + + def __call__(self, variables, domains, assignments, forwardcheck=False): + set = self._set + missing = 0 + found = 0 + for variable in variables: + if variable in assignments: + found += assignments[variable] in set + else: + missing += 1 + if missing: + if self._exact: + if not (found <= self._n <= missing+found): + return False + else: + if self._n > missing+found: + return False + if forwardcheck and self._n-found == missing: + # All unassigned variables must be assigned to + # values in the set. + for variable in variables: + if variable not in assignments: + domain = domains[variable] + for value in domain[:]: + if value not in set: + domain.hideValue(value) + if not domain: + return False + else: + if self._exact: + if found != self._n: + return False + else: + if found < self._n: + return False + return True + +class SomeNotInSetConstraint(Constraint): + """ + Constraint enforcing that at least some of the values of given + variables must not be present in a given set + + Example: + + >>> problem = Problem() + >>> problem.addVariables(["a", "b"], [1, 2]) + >>> problem.addConstraint(SomeNotInSetConstraint([1])) + >>> sorted(sorted(x.items()) for x in problem.getSolutions()) + [[('a', 1), ('b', 2)], [('a', 2), ('b', 1)], [('a', 2), ('b', 2)]] + """#""" + + def __init__(self, set, n=1, exact=False): + """ + @param set: Set of values to be checked + @type set: set + @param n: Minimum number of assigned values that should not be present + in set (default is 1) + @type n: int + @param exact: Whether the number of assigned values which are + not present in set must be exactly C{n} + @type exact: bool + """ + self._set = set + self._n = n + self._exact = exact + + def __call__(self, variables, domains, assignments, forwardcheck=False): + set = self._set + missing = 0 + found = 0 + for variable in variables: + if variable in assignments: + found += assignments[variable] not in set + else: + missing += 1 + if missing: + if self._exact: + if not (found <= self._n <= missing+found): + return False + else: + if self._n > missing+found: + return False + if forwardcheck and self._n-found == missing: + # All unassigned variables must be assigned to + # values not in the set. + for variable in variables: + if variable not in assignments: + domain = domains[variable] + for value in domain[:]: + if value in set: + domain.hideValue(value) + if not domain: + return False + else: + if self._exact: + if found != self._n: + return False + else: + if found < self._n: + return False + return True + +if __name__ == "__main__": + import doctest + doctest.testmod() + diff --git a/csp/python-constraint/trials/crosswords.py b/csp/python-constraint/trials/crosswords.py new file mode 100755 index 00000000..5cb502f0 --- /dev/null +++ b/csp/python-constraint/trials/crosswords.py @@ -0,0 +1,153 @@ +#!/usr/bin/python +from constraint import * +import random +import sys + +MINLEN = 3 + +def main(puzzle, lines): + puzzle = puzzle.rstrip().splitlines() + while puzzle and not puzzle[0]: + del puzzle[0] + + # Extract horizontal words + horizontal = [] + word = [] + predefined = {} + for row in range(len(puzzle)): + for col in range(len(puzzle[row])): + char = puzzle[row][col] + if not char.isspace(): + word.append((row, col)) + if char != "#": + predefined[row, col] = char + elif word: + if len(word) > MINLEN: + horizontal.append(word[:]) + del word[:] + if word: + if len(word) > MINLEN: + horizontal.append(word[:]) + del word[:] + + # Extract vertical words + vertical = [] + validcol = True + col = 0 + while validcol: + validcol = False + for row in range(len(puzzle)): + if col >= len(puzzle[row]): + if word: + if len(word) > MINLEN: + vertical.append(word[:]) + del word[:] + else: + validcol = True + char = puzzle[row][col] + if not char.isspace(): + word.append((row, col)) + if char != "#": + predefined[row, col] = char + elif word: + if len(word) > MINLEN: + vertical.append(word[:]) + del word[:] + if word: + if len(word) > MINLEN: + vertical.append(word[:]) + del word[:] + col += 1 + + hnames = ["h%d" % i for i in range(len(horizontal))] + vnames = ["v%d" % i for i in range(len(vertical))] + + #problem = Problem(MinConflictsSolver()) + problem = Problem() + + for hi, hword in enumerate(horizontal): + for vi, vword in enumerate(vertical): + for hchar in hword: + if hchar in vword: + hci = hword.index(hchar) + vci = vword.index(hchar) + problem.addConstraint(lambda hw, vw, hci=hci, vci=vci: + hw[hci] == vw[vci], + ("h%d" % hi, "v%d" % vi)) + + for char, letter in predefined.items(): + for hi, hword in enumerate(horizontal): + if char in hword: + hci = hword.index(char) + problem.addConstraint(lambda hw, hci=hci, letter=letter: + hw[hci] == letter, ("h%d" % hi,)) + for vi, vword in enumerate(vertical): + if char in vword: + vci = vword.index(char) + problem.addConstraint(lambda vw, vci=vci, letter=letter: + vw[vci] == letter, ("v%d" % vi,)) + + wordsbylen = {} + for hword in horizontal: + wordsbylen[len(hword)] = [] + for vword in vertical: + wordsbylen[len(vword)] = [] + + for line in lines: + line = line.strip() + l = len(line) + if l in wordsbylen: + wordsbylen[l].append(line.upper()) + + for hi, hword in enumerate(horizontal): + words = wordsbylen[len(hword)] + random.shuffle(words) + problem.addVariable("h%d" % hi, words) + for vi, vword in enumerate(vertical): + words = wordsbylen[len(vword)] + random.shuffle(words) + problem.addVariable("v%d" % vi, words) + + problem.addConstraint(AllDifferentConstraint()) + + solution = problem.getSolution() + if not solution: + print "No solution found!" + + maxcol = 0 + maxrow = 0 + for hword in horizontal: + for row, col in hword: + if row > maxrow: + maxrow = row + if col > maxcol: + maxcol = col + for vword in vertical: + for row, col in vword: + if row > maxrow: + maxrow = row + if col > maxcol: + maxcol = col + + matrix = [] + for row in range(maxrow+1): + matrix.append([" "]*(maxcol+1)) + + for variable in solution: + if variable[0] == "v": + word = vertical[int(variable[1:])] + else: + word = horizontal[int(variable[1:])] + for (row, col), char in zip(word, solution[variable]): + matrix[row][col] = char + + for row in range(maxrow+1): + for col in range(maxcol+1): + sys.stdout.write(matrix[row][col]) + sys.stdout.write("\n") + +if __name__ == "__main__": + if len(sys.argv) != 3: + sys.exit("Usage: crosswords.py ") + main(open(sys.argv[1]).read(), open(sys.argv[2])) + diff --git a/csp/python-constraint/trials/einstein.py b/csp/python-constraint/trials/einstein.py new file mode 100755 index 00000000..ede13f88 --- /dev/null +++ b/csp/python-constraint/trials/einstein.py @@ -0,0 +1,201 @@ +#!/usr/bin/python +# +# ALBERT EINSTEIN'S RIDDLE +# +# ARE YOU IN THE TOP 2% OF INTELLIGENT PEOPLE IN THE WORLD? +# SOLVE THE RIDDLE AND FIND OUT. +# +# There are no tricks, just pure logic, so good luck and don't give up. +# +# 1. In a street there are five houses, painted five different colours. +# 2. In each house lives a person of different nationality +# 3. These five homeowners each drink a different kind of beverage, smoke +# different brand of cigar and keep a different pet. +# +# THE QUESTION: WHO OWNS THE FISH? +# +# HINTS +# +# 1. The Brit lives in a red house. +# 2. The Swede keeps dogs as pets. +# 3. The Dane drinks tea. +# 4. The Green house is on the left of the White house. +# 5. The owner of the Green house drinks coffee. +# 6. The person who smokes Pall Mall rears birds. +# 7. The owner of the Yellow house smokes Dunhill. +# 8. The man living in the centre house drinks milk. +# 9. The Norwegian lives in the first house. +# 10. The man who smokes Blends lives next to the one who keeps cats. +# 11. The man who keeps horses lives next to the man who smokes Dunhill. +# 12. The man who smokes Blue Master drinks beer. +# 13. The German smokes Prince. +# 14. The Norwegian lives next to the blue house. +# 15. The man who smokes Blends has a neighbour who drinks water. +# +# ALBERT EINSTEIN WROTE THIS RIDDLE EARLY DURING THE 19th CENTURY. HE +# SAID THAT 98% OF THE WORLD POPULATION WOULD NOT BE ABLE TO SOLVE IT. + +from constraint import * + +# Check http://www.csc.fi/oppaat/f95/python/talot.py + +def main(): + problem = Problem() + for i in range(1,6): + problem.addVariable("color%d" % i, + ["red", "white", "green", "yellow", "blue"]) + problem.addVariable("nationality%d" % i, + ["brit", "swede", "dane", "norwegian", "german"]) + problem.addVariable("drink%d" % i, + ["tea", "coffee", "milk", "beer", "water"]) + problem.addVariable("smoke%d" % i, + ["pallmall", "dunhill", "blends", + "bluemaster", "prince"]) + problem.addVariable("pet%d" % i, + ["dogs", "birds", "cats", "horses", "fish"]) + + problem.addConstraint(AllDifferentConstraint(), + ["color%d" % i for i in range(1,6)]) + problem.addConstraint(AllDifferentConstraint(), + ["nationality%d" % i for i in range(1,6)]) + problem.addConstraint(AllDifferentConstraint(), + ["drink%d" % i for i in range(1,6)]) + problem.addConstraint(AllDifferentConstraint(), + ["smoke%d" % i for i in range(1,6)]) + problem.addConstraint(AllDifferentConstraint(), + ["pet%d" % i for i in range(1,6)]) + + for i in range(1,6): + + # Hint 1 + problem.addConstraint(lambda nationality, color: + nationality != "brit" or color == "red", + ("nationality%d" % i, "color%d" % i)) + + # Hint 2 + problem.addConstraint(lambda nationality, pet: + nationality != "swede" or pet == "dogs", + ("nationality%d" % i, "pet%d" % i)) + + # Hint 3 + problem.addConstraint(lambda nationality, drink: + nationality != "dane" or drink == "tea", + ("nationality%d" % i, "drink%d" % i)) + + # Hint 4 + if i < 5: + problem.addConstraint(lambda colora, colorb: + colora != "green" or colorb == "white", + ("color%d" % i, "color%d" % (i+1))) + else: + problem.addConstraint(lambda color: color != "green", + ("color%d" % i,)) + + # Hint 5 + problem.addConstraint(lambda color, drink: + color != "green" or drink == "coffee", + ("color%d" % i, "drink%d" % i)) + + # Hint 6 + problem.addConstraint(lambda smoke, pet: + smoke != "pallmall" or pet == "birds", + ("smoke%d" % i, "pet%d" % i)) + + # Hint 7 + problem.addConstraint(lambda color, smoke: + color != "yellow" or smoke == "dunhill", + ("color%d" % i, "smoke%d" % i)) + + # Hint 8 + if i == 3: + problem.addConstraint(lambda drink: drink == "milk", + ("drink%d" % i,)) + + # Hint 9 + if i == 1: + problem.addConstraint(lambda nationality: + nationality == "norwegian", + ("nationality%d" % i,)) + + # Hint 10 + if 1 < i < 5: + problem.addConstraint(lambda smoke, peta, petb: + smoke != "blends" or peta == "cats" or + petb == "cats", + ("smoke%d" % i, "pet%d" % (i-1), + "pet%d" % (i+1))) + else: + problem.addConstraint(lambda smoke, pet: + smoke != "blends" or pet == "cats", + ("smoke%d" % i, + "pet%d" % (i == 1 and 2 or 4))) + + # Hint 11 + if 1 < i < 5: + problem.addConstraint(lambda pet, smokea, smokeb: + pet != "horses" or smokea == "dunhill" or + smokeb == "dunhill", + ("pet%d" % i, "smoke%d" % (i-1), + "smoke%d" % (i+1))) + else: + problem.addConstraint(lambda pet, smoke: + pet != "horses" or smoke == "dunhill", + ("pet%d" % i, + "smoke%d" % (i == 1 and 2 or 4))) + + # Hint 12 + problem.addConstraint(lambda smoke, drink: + smoke != "bluemaster" or drink == "beer", + ("smoke%d" % i, "drink%d" % i)) + + # Hint 13 + problem.addConstraint(lambda nationality, smoke: + nationality != "german" or smoke == "prince", + ("nationality%d" % i, "smoke%d" % i)) + + # Hint 14 + if 1 < i < 5: + problem.addConstraint(lambda nationality, colora, colorb: + nationality != "norwegian" or + colora == "blue" or colorb == "blue", + ("nationality%d" % i, "color%d" % (i-1), + "color%d" % (i+1))) + else: + problem.addConstraint(lambda nationality, color: + nationality != "norwegian" or + color == "blue", + ("nationality%d" % i, + "color%d" % (i == 1 and 2 or 4))) + + # Hint 15 + if 1 < i < 5: + problem.addConstraint(lambda smoke, drinka, drinkb: + smoke != "blends" or + drinka == "water" or drinkb == "water", + ("smoke%d" % i, "drink%d" % (i-1), + "drink%d" % (i+1))) + else: + problem.addConstraint(lambda smoke, drink: + smoke != "blends" or drink == "water", + ("smoke%d" % i, + "drink%d" % (i == 1 and 2 or 4))) + + solutions = problem.getSolutions() + print "Found %d solution(s)!" % len(solutions) + print + for solution in solutions: + showSolution(solution) + +def showSolution(solution): + for i in range(1,6): + print "House %d" % i + print "--------" + print "Nationality: %s" % solution["nationality%d" % i] + print "Color: %s" % solution["color%d" % i] + print "Drink: %s" % solution["drink%d" % i] + print "Smoke: %s" % solution["smoke%d" % i] + print "Pet: %s" % solution["pet%d" % i] + print + +if __name__ == "__main__": + main() diff --git a/csp/python-constraint/trials/einstein2.py b/csp/python-constraint/trials/einstein2.py new file mode 100755 index 00000000..d1f7b86d --- /dev/null +++ b/csp/python-constraint/trials/einstein2.py @@ -0,0 +1,190 @@ +#!/usr/bin/python +# +# ALBERT EINSTEIN'S RIDDLE +# +# ARE YOU IN THE TOP 2% OF INTELLIGENT PEOPLE IN THE WORLD? +# SOLVE THE RIDDLE AND FIND OUT. +# +# There are no tricks, just pure logic, so good luck and don't give up. +# +# 1. In a street there are five houses, painted five different colours. +# 2. In each house lives a person of different nationality +# 3. These five homeowners each drink a different kind of beverage, smoke +# different brand of cigar and keep a different pet. +# +# THE QUESTION: WHO OWNS THE zebra? +# +# HINTS +# +# 1. The englishman lives in a red house. +# 2. The spaniard keeps dogs as pets. +# 5. The owner of the Green house drinks coffee. +# 3. The ukrainian drinks tea. +# 4. The Green house is on the left of the ivory house. +# 6. The person who smokes oldgold rears snails. +# 7. The owner of the Yellow house smokes kools. +# 8. The man living in the centre house drinks milk. +# 9. The Norwegian lives in the first house. +# 10. The man who smokes chesterfields lives next to the one who keeps foxes. +# 11. The man who keeps horses lives next to the man who smokes kools. +# 12. The man who smokes luckystrike drinks orangejuice. +# 13. The japanese smokes parliaments. +# 14. The Norwegian lives next to the blue house. +# 15. The man who smokes chesterfields has a neighbour who drinks water. +# +# ALBERT EINSTEIN WROTE THIS RIDDLE EARLY DURING THE 19th CENTURY. HE +# SAID THAT 98% OF THE WORLD POPULATION WOULD NOT BE ABLE TO SOLVE IT. + +from constraint import * + +# Check http://www.csc.fi/oppaat/f95/python/talot.py + +def main(): + problem = Problem() + for i in range(1,6): + problem.addVariable("color%d" % i, + ["red", "ivory", "green", "yellow", "blue"]) + problem.addVariable("nationality%d" % i, + ["englishman", "spaniard", "ukrainian", "norwegian", "japanese"]) + problem.addVariable("drink%d" % i, + ["tea", "coffee", "milk", "orangejuice", "water"]) + problem.addVariable("smoke%d" % i, + ["oldgold", "kools", "chesterfields", + "luckystrike", "parliaments"]) + problem.addVariable("pet%d" % i, + ["dogs", "snails", "foxes", "horses", "zebra"]) + + problem.addConstraint(AllDifferentConstraint(), + ["color%d" % i for i in range(1,6)]) + problem.addConstraint(AllDifferentConstraint(), + ["nationality%d" % i for i in range(1,6)]) + problem.addConstraint(AllDifferentConstraint(), + ["drink%d" % i for i in range(1,6)]) + problem.addConstraint(AllDifferentConstraint(), + ["smoke%d" % i for i in range(1,6)]) + problem.addConstraint(AllDifferentConstraint(), + ["pet%d" % i for i in range(1,6)]) + + for i in range(1,6): + + # Hint 1 + problem.addConstraint(lambda nationality, color: + nationality != "englishman" or color == "red", + ("nationality%d" % i, "color%d" % i)) + + # Hint 2 + problem.addConstraint(lambda nationality, pet: + nationality != "spaniard" or pet == "dogs", + ("nationality%d" % i, "pet%d" % i)) + + # Hint 3 + problem.addConstraint(lambda nationality, drink: + nationality != "ukrainian" or drink == "tea", + ("nationality%d" % i, "drink%d" % i)) + + # Hint 4 + if i < 5: + problem.addConstraint(lambda colora, colorb: + colora != "green" or colorb == "ivory", + ("color%d" % i, "color%d" % (i+1))) + else: + problem.addConstraint(lambda color: color != "green", + ("color%d" % i,)) + + # Hint 5 + problem.addConstraint(lambda color, drink: + color != "green" or drink == "coffee", + ("color%d" % i, "drink%d" % i)) + + # Hint 6 + problem.addConstraint(lambda smoke, pet: + smoke != "oldgold" or pet == "snails", + ("smoke%d" % i, "pet%d" % i)) + + # Hint 7 + problem.addConstraint(lambda color, smoke: + color != "yellow" or smoke == "kools", + ("color%d" % i, "smoke%d" % i)) + + # Hint 8 + if i == 3: + problem.addConstraint(lambda drink: drink == "milk", + ("drink%d" % i,)) + + # Hint 9 + if i == 1: + problem.addConstraint(lambda nationality: + nationality == "norwegian", + ("nationality%d" % i,)) + + # Hint 10 + if 1 < i < 5: + problem.addConstraint(lambda smoke, peta, petb: + smoke != "chesterfields" or peta == "foxes" or + petb == "foxes", + ("smoke%d" % i, "pet%d" % (i-1), + "pet%d" % (i+1))) + else: + problem.addConstraint(lambda smoke, pet: + smoke != "chesterfields" or pet == "foxes", + ("smoke%d" % i, + "pet%d" % (i == 1 and 2 or 4))) + + # Hint 11 + if 1 < i < 5: + problem.addConstraint(lambda pet, smokea, smokeb: + pet != "horses" or smokea == "kools" or + smokeb == "kools", + ("pet%d" % i, "smoke%d" % (i-1), + "smoke%d" % (i+1))) + else: + problem.addConstraint(lambda pet, smoke: + pet != "horses" or smoke == "kools", + ("pet%d" % i, + "smoke%d" % (i == 1 and 2 or 4))) + + # Hint 12 + problem.addConstraint(lambda smoke, drink: + smoke != "luckystrike" or drink == "orangejuice", + ("smoke%d" % i, "drink%d" % i)) + + # Hint 13 + problem.addConstraint(lambda nationality, smoke: + nationality != "japanese" or smoke == "parliaments", + ("nationality%d" % i, "smoke%d" % i)) + + # Hint 14 + if 1 < i < 5: + problem.addConstraint(lambda nationality, colora, colorb: + nationality != "norwegian" or + colora == "blue" or colorb == "blue", + ("nationality%d" % i, "color%d" % (i-1), + "color%d" % (i+1))) + else: + problem.addConstraint(lambda nationality, color: + nationality != "norwegian" or + color == "blue", + ("nationality%d" % i, + "color%d" % (i == 1 and 2 or 4))) + + + + solutions = problem.getSolutions() + print "Found %d solution(s)!" % len(solutions) + print + for solution in solutions: + showSolution(solution) + +def showSolution(solution): + for i in range(1,6): + print "House %d" % i + print "--------" + print "Nationality: %s" % solution["nationality%d" % i] + print "Color: %s" % solution["color%d" % i] + print "Drink: %s" % solution["drink%d" % i] + print "Smoke: %s" % solution["smoke%d" % i] + print "Pet: %s" % solution["pet%d" % i] + print + +if __name__ == "__main__": + main() diff --git a/csp/python-constraint/trials/large.mask b/csp/python-constraint/trials/large.mask new file mode 100644 index 00000000..ba5364c8 --- /dev/null +++ b/csp/python-constraint/trials/large.mask @@ -0,0 +1,27 @@ + +# ######## # +# # # # # +######## # # +# # # # # +# # ######## +# # # # # # +######## # # +# # # # # # + # # # +######## # # + # # # # # + # ######## + # # # # # + # # ######## + # # # # # # + # # ######## + # # # # +######## # # + # # # # # # + # # # # # # + ######## # # + # # # # + # ######## + # # # # +######## # # + diff --git a/csp/python-constraint/trials/medium.mask b/csp/python-constraint/trials/medium.mask new file mode 100644 index 00000000..3332a097 --- /dev/null +++ b/csp/python-constraint/trials/medium.mask @@ -0,0 +1,19 @@ + + # +######### +# # # +# # ###### +# # # +# # # # +# # # # +######## # +# # # + # # # + ######### + # # # + ######### + # # # + # # +####### + # + diff --git a/csp/python-constraint/trials/python.mask b/csp/python-constraint/trials/python.mask new file mode 100644 index 00000000..fe5a5767 --- /dev/null +++ b/csp/python-constraint/trials/python.mask @@ -0,0 +1,8 @@ + P + Y +####T#### + # H # + # O # +####N # + # # +######### diff --git a/csp/python-constraint/trials/queens.py b/csp/python-constraint/trials/queens.py new file mode 100755 index 00000000..deac7131 --- /dev/null +++ b/csp/python-constraint/trials/queens.py @@ -0,0 +1,47 @@ +#!/usr/bin/python +# +# http://mathworld.wolfram.com/QueensProblem.html +# +from constraint import * +import sys + +def main(show=False): + problem = Problem() + size = 8 + cols = range(size) + rows = range(size) + problem.addVariables(cols, rows) + for col1 in cols: + for col2 in cols: + if col1 < col2: + problem.addConstraint(lambda row1, row2, col1=col1, col2=col2: + abs(row1-row2) != abs(col1-col2) and + row1 != row2, (col1, col2)) + solutions = problem.getSolutions() + print "Found %d solution(s)!" % len(solutions) + if show: + for solution in solutions: + showSolution(solution, size) + +def showSolution(solution, size): + sys.stdout.write(" %s \n" % ("-"*((size*4)-1))) + for i in range(size): + sys.stdout.write(" |") + for j in range(size): + if solution[j] == i: + sys.stdout.write(" %d |" % j) + else: + sys.stdout.write(" |") + sys.stdout.write("\n") + if i != size-1: + sys.stdout.write(" |%s|\n" % ("-"*((size*4)-1))) + sys.stdout.write(" %s \n" % ("-"*((size*4)-1))) + +if __name__ == "__main__": + show = False + if len(sys.argv) == 2 and sys.argv[1] == "-s": + show = True + elif len(sys.argv) != 1: + sys.exit("Usage: queens.py [-s]") + main(show) + diff --git a/csp/python-constraint/trials/rooks.py b/csp/python-constraint/trials/rooks.py new file mode 100755 index 00000000..14f88b1e --- /dev/null +++ b/csp/python-constraint/trials/rooks.py @@ -0,0 +1,49 @@ +#!/usr/bin/python +# +# http://mathworld.wolfram.com/RooksProblem.html +# +from constraint import * +import sys + +def factorial(x): return x == 1 or factorial(x-1)*x + +def main(show=False): + problem = Problem() + size = 8 + cols = range(size) + rows = range(size) + problem.addVariables(cols, rows) + for col1 in cols: + for col2 in cols: + if col1 < col2: + problem.addConstraint(lambda row1, row2: row1 != row2, + (col1, col2)) + solutions = problem.getSolutions() + print "Found %d solution(s)!" % len(solutions) + assert len(solutions) == factorial(size) + if show: + for solution in solutions: + showSolution(solution, size) + +def showSolution(solution, size): + sys.stdout.write(" %s \n" % ("-"*((size*4)-1))) + for i in range(size): + sys.stdout.write(" |") + for j in range(size): + if solution[j] == i: + sys.stdout.write(" %d |" % j) + else: + sys.stdout.write(" |") + sys.stdout.write("\n") + if i != size-1: + sys.stdout.write(" |%s|\n" % ("-"*((size*4)-1))) + sys.stdout.write(" %s \n" % ("-"*((size*4)-1))) + +if __name__ == "__main__": + show = False + if len(sys.argv) == 2 and sys.argv[1] == "-s": + show = True + elif len(sys.argv) != 1: + sys.exit("Usage: rooks.py [-s]") + main(show) + diff --git a/csp/python-constraint/trials/seisseisdoze.py b/csp/python-constraint/trials/seisseisdoze.py new file mode 100755 index 00000000..b17956db --- /dev/null +++ b/csp/python-constraint/trials/seisseisdoze.py @@ -0,0 +1,32 @@ +#!/usr/bin/python +# +# Assign equal values to equal letters, and different values to +# different letters, in a way that satisfies the following sum: +# +# SEIS +# + SEIS +# ------ +# DOZE +# +from constraint import * + +def main(): + problem = Problem() + problem.addVariables("seidoz", range(10)) + problem.addConstraint(lambda s, e: (2*s)%10 == e, "se") + problem.addConstraint(lambda i, s, z, e: ((10*2*i)+(2*s))%100 == z*10+e, + "isze") + problem.addConstraint(lambda s, e, i, d, o, z: + 2*(s*1000+e*100+i*10+s) == d*1000+o*100+z*10+e, + "seidoz") + problem.addConstraint(lambda s: s != 0, "s") + problem.addConstraint(lambda d: d != 0, "d") + problem.addConstraint(AllDifferentConstraint()) + print "SEIS+SEIS=DOZE" + for s in problem.getSolutions(): + print ("%(s)d%(e)d%(i)d%(s)s+%(s)d%(e)d%(i)d%(s)d=" + "%(d)d%(o)d%(z)d%(e)d") % s + +if __name__ == "__main__": + main() + diff --git a/csp/python-constraint/trials/sendmoremoney.py b/csp/python-constraint/trials/sendmoremoney.py new file mode 100755 index 00000000..894b0cd5 --- /dev/null +++ b/csp/python-constraint/trials/sendmoremoney.py @@ -0,0 +1,34 @@ +#!/usr/bin/python +# +# Assign equal values to equal letters, and different values to +# different letters, in a way that satisfies the following sum: +# +# SEND +# + MORE +# ------ +# MONEY +# +from constraint import * + +def main(): + problem = Problem() + problem.addVariables("sendmory", range(10)) + problem.addConstraint(lambda d, e, y: (d+e)%10 == y, "dey") + problem.addConstraint(lambda n, d, r, e, y: (n*10+d+r*10+e)%100 == e*10+y, + "ndrey") + problem.addConstraint(lambda e, n, d, o, r, y: + (e*100+n*10+d+o*100+r*10+e)%1000 == n*100+e*10+y, + "endory") + problem.addConstraint(lambda s, e, n, d, m, o, r, y: + 1000*s+100*e+10*n+d + 1000*m+100*o+10*r+e == + 10000*m+1000*o+100*n+10*e+y, "sendmory") + problem.addConstraint(NotInSetConstraint([0]), "sm") + problem.addConstraint(AllDifferentConstraint()) + print "SEND+MORE=MONEY" + for s in problem.getSolutions(): + print "%(s)d%(e)d%(n)d%(d)d+" \ + "%(m)d%(o)d%(r)d%(e)d=" \ + "%(m)d%(o)d%(n)d%(e)d%(y)d" % s + +if __name__ == "__main__": + main() diff --git a/csp/python-constraint/trials/small.mask b/csp/python-constraint/trials/small.mask new file mode 100644 index 00000000..0e43ff78 --- /dev/null +++ b/csp/python-constraint/trials/small.mask @@ -0,0 +1,8 @@ + # + # +######### + # # + # # # # +##### # # + # # # +######### diff --git a/csp/python-constraint/trials/studentdesks.py b/csp/python-constraint/trials/studentdesks.py new file mode 100755 index 00000000..e8d47792 --- /dev/null +++ b/csp/python-constraint/trials/studentdesks.py @@ -0,0 +1,39 @@ +#!/usr/bin/python +# +# http://home.chello.no/~dudley/ +# +from constraint import * +import sys + +STUDENTDESKS = [[ 0, 1, 0, 0, 0, 0], + [ 0, 2, 3, 4, 5, 6], + [ 0, 7, 8, 9, 10, 0], + [ 0, 11, 12, 13, 14, 0], + [ 15, 16, 17, 18, 19, 0], + [ 0, 0, 0, 0, 20, 0]] + +def main(): + problem = Problem() + problem.addVariables(range(1,21), ["A", "B", "C", "D", "E"]) + problem.addConstraint(SomeInSetConstraint(["A"], 4, True)) + problem.addConstraint(SomeInSetConstraint(["B"], 4, True)) + problem.addConstraint(SomeInSetConstraint(["C"], 4, True)) + problem.addConstraint(SomeInSetConstraint(["D"], 4, True)) + problem.addConstraint(SomeInSetConstraint(["E"], 4, True)) + for row in range(len(STUDENTDESKS)-1): + for col in range(len(STUDENTDESKS[row])-1): + lst = [STUDENTDESKS[row][col], STUDENTDESKS[row][col+1], + STUDENTDESKS[row+1][col], STUDENTDESKS[row+1][col+1]] + lst = [x for x in lst if x] + problem.addConstraint(AllDifferentConstraint(), lst) + showSolution(problem.getSolution()) + +def showSolution(solution): + for row in range(len(STUDENTDESKS)): + for col in range(len(STUDENTDESKS[row])): + id = STUDENTDESKS[row][col] + sys.stdout.write(" %s" % (id and solution[id] or " ")) + sys.stdout.write("\n") + +if __name__ == "__main__": + main() diff --git a/csp/python-constraint/trials/sudoku.py b/csp/python-constraint/trials/sudoku.py new file mode 100644 index 00000000..e79698ea --- /dev/null +++ b/csp/python-constraint/trials/sudoku.py @@ -0,0 +1,61 @@ +# +# Sudoku puzzle solver by by Luigi Poderico (www.poderico.it). +# +from constraint import * + +problem = Problem() + +# Define the variables: 9 rows of 9 variables rangin in 1...9 +for i in range(1, 10) : + problem.addVariables(range(i*10+1, i*10+10), range(1, 10)) + +# Each row has different values +for i in range(1, 10) : + problem.addConstraint(AllDifferentConstraint(), range(i*10+1, i*10+10)) + +# Each colum has different values +for i in range(1, 10) : + problem.addConstraint(AllDifferentConstraint(), range(10+i, 100+i, 10)) + +# Each 3x3 box has different values +problem.addConstraint(AllDifferentConstraint(), [11,12,13,21,22,23,31,32,33]) +problem.addConstraint(AllDifferentConstraint(), [41,42,43,51,52,53,61,62,63]) +problem.addConstraint(AllDifferentConstraint(), [71,72,73,81,82,83,91,92,93]) + +problem.addConstraint(AllDifferentConstraint(), [14,15,16,24,25,26,34,35,36]) +problem.addConstraint(AllDifferentConstraint(), [44,45,46,54,55,56,64,65,66]) +problem.addConstraint(AllDifferentConstraint(), [74,75,76,84,85,86,94,95,96]) + +problem.addConstraint(AllDifferentConstraint(), [17,18,19,27,28,29,37,38,39]) +problem.addConstraint(AllDifferentConstraint(), [47,48,49,57,58,59,67,68,69]) +problem.addConstraint(AllDifferentConstraint(), [77,78,79,87,88,89,97,98,99]) + +# Some value is given. +initValue = [[0, 9, 0, 7, 0, 0, 8, 6, 0], + [0, 3, 1, 0, 0, 5, 0, 2, 0], + [8, 0, 6, 0, 0, 0, 0, 0, 0], + [0, 0, 7, 0, 5, 0, 0, 0, 6], + [0, 0, 0, 3, 0, 7, 0, 0, 0], + [5, 0, 0, 0, 1, 0, 7, 0, 0], + [0, 0, 0, 0, 0, 0, 1, 0, 9], + [0, 2, 0, 6, 0, 0, 0, 5, 0], + [0, 5, 4, 0, 0, 8, 0, 7, 0]] + +for i in range(1, 10) : + for j in range(1, 10): + if initValue[i-1][j-1] !=0 : + problem.addConstraint(lambda var, val=initValue[i-1][j-1]: + var==val, (i*10+j,)) + +# Get the solutions. +solutions = problem.getSolutions() + +# Print the solutions +for solution in solutions: + for i in range(1, 10): + for j in range(1, 10): + index = i*10+j + print solution[index], + print + print + diff --git a/csp/python-constraint/trials/twotwofour.py b/csp/python-constraint/trials/twotwofour.py new file mode 100755 index 00000000..b9e70d6a --- /dev/null +++ b/csp/python-constraint/trials/twotwofour.py @@ -0,0 +1,28 @@ +#!/usr/bin/python +# +# Assign equal values to equal letters, and different values to +# different letters, in a way that satisfies the following sum: +# +# TWO +# + TWO +# ----- +# FOUR +# +from constraint import * + +def main(): + problem = Problem() + problem.addVariables("twofur", range(10)) + problem.addConstraint(lambda o, r: (2*o)%10 == r, "or") + problem.addConstraint(lambda w, o, u, r: ((10*2*w)+(2*o))%100 == u*10+r, + "wour") + problem.addConstraint(lambda t, w, o, f, u, r: + 2*(t*100+w*10+o) == f*1000+o*100+u*10+r, "twofur") + problem.addConstraint(NotInSetConstraint([0]), "ft") + problem.addConstraint(AllDifferentConstraint()) + print "TWO+TWO=FOUR" + for s in problem.getSolutions(): + print "%(t)d%(w)d%(o)d+%(t)d%(w)d%(o)d=%(f)d%(o)d%(u)d%(r)d" % s + +if __name__ == "__main__": + main() diff --git a/csp/python-constraint/trials/xsum.py b/csp/python-constraint/trials/xsum.py new file mode 100755 index 00000000..0f5f70b6 --- /dev/null +++ b/csp/python-constraint/trials/xsum.py @@ -0,0 +1,37 @@ +#!/usr/bin/python +# +# Reorganize the following numbers in a way that each line of +# 5 numbers sum to 27. +# +# 1 6 +# 2 7 +# 3 +# 8 4 +# 9 5 +# +from constraint import * + +def main(): + problem = Problem() + problem.addVariables("abcdxefgh", range(1,10)) + problem.addConstraint(lambda a, b, c, d, x: + a < b < c < d and a+b+c+d+x == 27, "abcdx") + problem.addConstraint(lambda e, f, g, h, x: + e < f < g < h and e+f+g+h+x == 27, "efghx") + problem.addConstraint(AllDifferentConstraint()) + solutions = problem.getSolutions() + print "Found %d solutions!" % len(solutions) + showSolutions(solutions) + +def showSolutions(solutions): + for solution in solutions: + print " %d %d" % (solution["a"], solution["e"]) + print " %d %d " % (solution["b"], solution["f"]) + print " %d " % (solution["x"],) + print " %d %d " % (solution["g"], solution["c"]) + print " %d %d" % (solution["h"], solution["d"]) + print + +if __name__ == "__main__": + main() + From c524fcf057925bf2b1a69d278a2842a0c8b33994 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Tue, 30 Sep 2014 15:25:16 -0700 Subject: [PATCH 023/246] progress --- csp/constraint.rkt | 68 ++++++++++++++++++++++++++++++++++++---------- 1 file changed, 53 insertions(+), 15 deletions(-) diff --git a/csp/constraint.rkt b/csp/constraint.rkt index 7c0ed101..f960d725 100644 --- a/csp/constraint.rkt +++ b/csp/constraint.rkt @@ -72,13 +72,14 @@ (when (variable . in? . _variables) (error 'addVariable (format "Tried to insert duplicated variable ~a" variable))) (cond - [(list? domain) (report domain) (set! domain (new Domain [set domain]))] + [(list? domain) (set! domain (new Domain [set domain]))] ;; todo: test for `instance-of-Domain?` ; how to copy domain? - [(object? domain) (report 'foo) (report domain) (set! domain '(copy.copy domain))] + [(object? domain) (set! domain '(copy.copy domain))] [else (error 'addVariable "Domains must be instances of subclasses of Domain")]) + (when (not (object? domain)) (error 'fudge)) (when (not domain) ; todo: check this test (error 'addVariable "Domain is empty")) - (hash-set! _variables variable (get-field _list domain))) + (hash-set! _variables variable domain)) (define/public (addVariables variables domain) ;; Add one or more variables to the problem @@ -115,10 +116,10 @@ (for ([domain (in-list (hash-values domains))]) (send domain resetState) (when (not domain) - (set! result (values null null null)) + (set! result (list null null null)) (done))) - (set! result (values domains constraints vconstraints))) - result) + (set! result (list domains constraints vconstraints))) + (apply values result)) )) @@ -130,22 +131,17 @@ (define problem (new Problem)) (send problem addVariable "a" '(1 2)) - (check-equal? (hash-ref (get-field _variables problem) "a") '(1 2)) + (check-equal? (get-field _list (hash-ref (get-field _variables problem) "a")) '(1 2)) (send problem reset) (check-equal? (get-field _variables problem) (make-hash)) (send problem addVariables '("a" "b") '(1 2 3)) - (check-equal? (hash-ref (get-field _variables problem) "a") '(1 2 3)) - (check-equal? (hash-ref (get-field _variables problem) "b") '(1 2 3)) + (check-equal? (get-field _list (hash-ref (get-field _variables problem) "a")) '(1 2 3)) + (check-equal? (get-field _list (hash-ref (get-field _variables problem) "b")) '(1 2 3)) (get-field _variables problem) (send problem getSolutions) ) -(define BacktrackingSolver - (class object% - (super-new))) - - ;; ---------------------------------------------------------------------- ;; Domains ;; ---------------------------------------------------------------------- @@ -159,7 +155,49 @@ (class object% (super-new) (init-field set) - (field [_list set]))) + (field [_list set][_hidden null][_states null]) + + (define/public (resetState) + ;; Reset to the original domain state, including all possible values + (set! _list (append _list _hidden)) + (set! _hidden null) + (set! _states null)) + + )) + + +;; ---------------------------------------------------------------------- +;; Solvers +;; ---------------------------------------------------------------------- + +(define Solver + ;; Abstract base class for solvers + (class object% + (super-new) + (abstract getSolution) + (abstract getSolutions) + (abstract getSolutionIter))) + + +(define BacktrackingSolver + ;; Problem solver with backtracking capabilities + (class Solver + (super-new) + (init-field [forwardCheck #t]) + + (define/override (getSolutionIter domains constraints vconstraints) + ;; resume here + (void)) + + (define/override (getSolution domains constraints vconstraints) + ;; todo: repair this properly + (car (getSolutions domains constraints vconstraints))) + + (define/override (getSolutions domains constraints vconstraints) + (getSolutionIter domains constraints vconstraints)) + + )) + (module+ main (define p (new Problem)) From e775735a75684d8b7cfe4cba9cc187ec1bbafa15 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Tue, 30 Sep 2014 18:45:18 -0700 Subject: [PATCH 024/246] progresses --- csp/constraint.rkt | 57 ++++++++++++++++++++++++++++++++++++++++++---- 1 file changed, 52 insertions(+), 5 deletions(-) diff --git a/csp/constraint.rkt b/csp/constraint.rkt index f960d725..6b7c2ec6 100644 --- a/csp/constraint.rkt +++ b/csp/constraint.rkt @@ -1,5 +1,5 @@ #lang racket/base -(require racket/class racket/contract racket/match) +(require racket/class racket/contract racket/match racket/list racket/generator) (require sugar/container sugar/debug) (module+ test (require rackunit)) @@ -137,7 +137,8 @@ (send problem addVariables '("a" "b") '(1 2 3)) (check-equal? (get-field _list (hash-ref (get-field _variables problem) "a")) '(1 2 3)) (check-equal? (get-field _list (hash-ref (get-field _variables problem) "b")) '(1 2 3)) - (get-field _variables problem) + ; (get-field _variables problem) + (displayln (format "The solution to ~a:" problem)) (send problem getSolutions) ) @@ -183,11 +184,57 @@ ;; Problem solver with backtracking capabilities (class Solver (super-new) - (init-field [forwardCheck #t]) + (init-field [forwardcheck #t]) + (field [_forwardcheck forwardcheck]) (define/override (getSolutionIter domains constraints vconstraints) - ;; resume here - (void)) + (define forwardcheck _forwardcheck) + (define assignments (make-hash)) + (define queue null) + (define pushdomains null) + (define variable #f) + (let/ec done + ;; Mix the Degree and Minimum Remaing Values (MRV) heuristics + (define lst (sort (for/list ([variable (in-hash-keys domains)]) + (list (* -1 (length (hash-ref vconstraints variable))) + (length (get-field _list (hash-ref domains variable))) + variable)) < #:key car)) ;;todo: sort on multiple keys + (if (not (null? lst)) ; ? good translation of for–else? + (for ([item (in-list lst)]) + (when (not ((last item) . in? . assignments)) + ; Found unassigned variable + (define variable (last item)) + (define values (hash-ref domains variable)) + (set! pushdomains + (if forwardcheck + (for/list ([x (in-hash-keys domains)] + #:when (and (not (x . in? . assignments)) + (not (x . equal? . variable)))) + (hash-ref domains x)) + null)) + (done))) + (begin + ;; No unassigned variables. We've got a solution. Go back + ;; to last variable, if there's one. + (generator () + (yield '(copy assignments)) ;;todo: fix copy + (when (not queue) (done)) + (match-define (list variable values pushdomains) (take-right 1 queue)) + (set! queue (drop-right 1 queue)) + (when pushdomains + (for ([domain (in-list pushdomains)]) + (send domain popState)))))) + (let/ec done2 + ;; We have a variable. Do we have any values left? + (when (null? values) + ;; No. Go back to last variable, if there's one. + (hash-remove! assignments variable) + ;; resume @ line 492 + )) + ) + (list 'tada) ; todo: remove this dummy value + ) + (define/override (getSolution domains constraints vconstraints) ;; todo: repair this properly From 12919a96117a4da67559cc793c3ad4c6d8464db5 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Wed, 1 Oct 2014 12:52:51 -0700 Subject: [PATCH 025/246] lunchbreak --- csp/constraint.rkt | 140 ++++++++++++++++-------- csp/helpers.rkt | 49 +++++++++ csp/python-constraint/constraint.py | 5 + csp/python-constraint/testconstraint.py | 7 ++ 4 files changed, 157 insertions(+), 44 deletions(-) create mode 100644 csp/helpers.rkt create mode 100644 csp/python-constraint/testconstraint.py diff --git a/csp/constraint.rkt b/csp/constraint.rkt index 6b7c2ec6..af434387 100644 --- a/csp/constraint.rkt +++ b/csp/constraint.rkt @@ -1,7 +1,7 @@ #lang racket/base (require racket/class racket/contract racket/match racket/list racket/generator) (require sugar/container sugar/debug) - +(require "helpers.rkt") (module+ test (require rackunit)) ;; Adapted from work by Gustavo Niemeyer @@ -85,6 +85,13 @@ ;; Add one or more variables to the problem (for-each (λ(var) (addVariable var domain)) variables)) + (define/public (getSolution) + ;; Find and return a solution to the problem + (define-values (domains constraints vconstraints) (_getArgs)) + (if (not domains) + null + (send _solver getSolution domains constraints vconstraints))) + (define/public (getSolutions) ;; Find and return all solutions to the problem (define-values (domains constraints vconstraints) (_getArgs)) @@ -129,17 +136,21 @@ (check-equal? (get-field _constraints (new Problem)) null) (check-equal? (get-field _variables (new Problem)) (make-hash)) - (define problem (new Problem)) - (send problem addVariable "a" '(1 2)) - (check-equal? (get-field _list (hash-ref (get-field _variables problem) "a")) '(1 2)) + (define problem (new Problem)) ;; test from line 125 + (send problem addVariable "a" '(1)) + (check-equal? (get-field _list (hash-ref (get-field _variables problem) "a")) '(1)) + + (displayln (format "The solution to ~a is ~a" + problem + (send problem getSolutions))) + + (send problem reset) (check-equal? (get-field _variables problem) (make-hash)) (send problem addVariables '("a" "b") '(1 2 3)) (check-equal? (get-field _list (hash-ref (get-field _variables problem) "a")) '(1 2 3)) (check-equal? (get-field _list (hash-ref (get-field _variables problem) "b")) '(1 2 3)) - ; (get-field _variables problem) - (displayln (format "The solution to ~a:" problem)) - (send problem getSolutions) + ) @@ -153,17 +164,25 @@ ;; When list or tuples are used as domains, they are automatically ;; converted to an instance of that class. - (class object% + (class* object% (printable<%>) (super-new) (init-field set) (field [_list set][_hidden null][_states null]) + (define (repr) (format "" _list)) + (define/public (custom-print out quoting-depth) (print (repr) out)) + (define/public (custom-display out) (displayln (repr) out)) + (define/public (custom-write out) (write (repr) out)) + (define/public (resetState) ;; Reset to the original domain state, including all possible values - (set! _list (append _list _hidden)) + (py-extend! _list _hidden) (set! _hidden null) (set! _states null)) + (define/public (domain-pop!) + (py-pop! _list)) + )) @@ -191,6 +210,7 @@ (define forwardcheck _forwardcheck) (define assignments (make-hash)) (define queue null) + (define values null) (define pushdomains null) (define variable #f) (let/ec done @@ -198,50 +218,82 @@ (define lst (sort (for/list ([variable (in-hash-keys domains)]) (list (* -1 (length (hash-ref vconstraints variable))) (length (get-field _list (hash-ref domains variable))) - variable)) < #:key car)) ;;todo: sort on multiple keys - (if (not (null? lst)) ; ? good translation of for–else? - (for ([item (in-list lst)]) - (when (not ((last item) . in? . assignments)) - ; Found unassigned variable - (define variable (last item)) - (define values (hash-ref domains variable)) - (set! pushdomains - (if forwardcheck - (for/list ([x (in-hash-keys domains)] - #:when (and (not (x . in? . assignments)) - (not (x . equal? . variable)))) - (hash-ref domains x)) - null)) - (done))) - (begin - ;; No unassigned variables. We've got a solution. Go back - ;; to last variable, if there's one. - (generator () - (yield '(copy assignments)) ;;todo: fix copy - (when (not queue) (done)) - (match-define (list variable values pushdomains) (take-right 1 queue)) - (set! queue (drop-right 1 queue)) - (when pushdomains - (for ([domain (in-list pushdomains)]) - (send domain popState)))))) - (let/ec done2 + variable)) list-comparator)) + (report lst) + (let/ec bonk + (if (not (null? lst)) ; ? good translation of for–else? + (for ([item (in-list lst)]) + (when (not ((last item) . in? . assignments)) + ; Found unassigned variable + (set! variable (last item)) + (set! values (hash-ref domains variable)) + (set! pushdomains + (if forwardcheck + (for/list ([x (in-hash-keys domains)] + #:when (and (not (x . in? . assignments)) + (not (x . equal? . variable)))) + (hash-ref domains x)) + null)) + (bonk))) + (begin + ;; No unassigned variables. We've got a solution. Go back + ;; to last variable, if there's one. + (generator () + (yield (hash-copy assignments)) + (when (not queue) (done)) + (match-define (list variable values pushdomains) (py-pop! queue)) + (when (not (null? pushdomains)) + (for ([domain (in-list pushdomains)]) + (send domain popState))))))) + (report variable) + (report values) + (report assignments) + + (let/ec inner-done ;; We have a variable. Do we have any values left? + (report values) (when (null? values) ;; No. Go back to last variable, if there's one. (hash-remove! assignments variable) - ;; resume @ line 492 - )) - ) - (list 'tada) ; todo: remove this dummy value - ) + (let loop () + (if (not (null? queue)) + (let () + (define-values (variable values pushdomains) (py-pop! queue)) + (when pushdomains + (for ([domain (in-list pushdomains)]) + (send domain popState))) + (when values (inner-done)) + (hash-remove! assignments variable) + (loop)) + (error 'todo "return from function")))) + ;; Got a value. Check it. + (hash-set! assignments variable (send values domain-pop!)) + (when (not (null? pushdomains)) + (for ([domain (in-list pushdomains)]) + (send domain pushState))) + ;; todo: ok replacement for for/else? + (if (not (null? (hash-ref vconstraints variable))) + (for ([cvpair (in-list (hash-ref vconstraints variable))]) + (match-define (cons constraint variables) cvpair) + (when (not (constraint variables domains assignments pushdomains)) + ;; Value is not good. + (inner-done))) + (inner-done)) + (when (not (null? pushdomains)) + (for ([domain (in-list pushdomains)]) + (send domain popState))) + ;; Push state before looking for next variable. + (py-append! queue (list variable values pushdomains)))) + (error 'getSolutionIter "Whoops, broken solver")) + (define/override (getSolution domains constraints vconstraints) - ;; todo: repair this properly - (car (getSolutions domains constraints vconstraints))) + ;; todo: fix this + (void)) (define/override (getSolutions domains constraints vconstraints) - (getSolutionIter domains constraints vconstraints)) + (for/list ([solution (in-generator (getSolutionIter domains constraints vconstraints))]) solution)) )) diff --git a/csp/helpers.rkt b/csp/helpers.rkt new file mode 100644 index 00000000..e845fe10 --- /dev/null +++ b/csp/helpers.rkt @@ -0,0 +1,49 @@ +#lang racket/base +(require racket/list) +(provide (all-defined-out)) + +(module+ test (require rackunit)) + +(define (list-comparator xs ys) + ;; For use in sort. Compares two lists element by element. + (cond + [(equal? xs ys) #f] ; elements are same, so no sort preference + [(and (null? xs) (not (null? ys))) #t] ; ys is longer, so #t + [(and (not (null? xs)) (null? ys)) #f] ; xs is longer, so #f makes it sort later + [else (let ([x (car xs)][y (car ys)]) + (cond + [(equal? x y) (list-comparator (cdr xs) (cdr ys))] + [(and (real? x) (real? y)) (< x y)] + [(and (string? x) (string? y)) (string Date: Wed, 1 Oct 2014 15:43:59 -0700 Subject: [PATCH 026/246] gingersteps --- csp/constraint.rkt | 175 +++++++++++++++++----------- csp/python-constraint/constraint.py | 17 ++- 2 files changed, 120 insertions(+), 72 deletions(-) diff --git a/csp/constraint.rkt b/csp/constraint.rkt index af434387..15040ba9 100644 --- a/csp/constraint.rkt +++ b/csp/constraint.rkt @@ -183,8 +183,16 @@ (define/public (domain-pop!) (py-pop! _list)) + (define/public (copy) + (define copied-domain (new Domain [set _list])) + (set-field! _hidden copied-domain _hidden) + (set-field! _states copied-domain _states) + copied-domain) + + )) +(define Domain? (is-a?/c Domain)) ;; ---------------------------------------------------------------------- ;; Solvers @@ -213,78 +221,107 @@ (define values null) (define pushdomains null) (define variable #f) - (let/ec done - ;; Mix the Degree and Minimum Remaing Values (MRV) heuristics - (define lst (sort (for/list ([variable (in-hash-keys domains)]) + (define lst null) + (define want-to-return #f) + (define return-k #f) + (let/ec break-loop1 + (set! return-k break-loop1) + (let loop1 () + (displayln "starting while loop 1") + ;; Mix the Degree and Minimum Remaing Values (MRV) heuristics + (set! lst (sort (for/list ([variable (in-hash-keys domains)]) (list (* -1 (length (hash-ref vconstraints variable))) (length (get-field _list (hash-ref domains variable))) variable)) list-comparator)) - (report lst) - (let/ec bonk - (if (not (null? lst)) ; ? good translation of for–else? - (for ([item (in-list lst)]) - (when (not ((last item) . in? . assignments)) - ; Found unassigned variable - (set! variable (last item)) - (set! values (hash-ref domains variable)) - (set! pushdomains - (if forwardcheck - (for/list ([x (in-hash-keys domains)] - #:when (and (not (x . in? . assignments)) - (not (x . equal? . variable)))) - (hash-ref domains x)) - null)) - (bonk))) - (begin - ;; No unassigned variables. We've got a solution. Go back - ;; to last variable, if there's one. - (generator () - (yield (hash-copy assignments)) - (when (not queue) (done)) - (match-define (list variable values pushdomains) (py-pop! queue)) - (when (not (null? pushdomains)) - (for ([domain (in-list pushdomains)]) - (send domain popState))))))) - (report variable) - (report values) - (report assignments) - - (let/ec inner-done - ;; We have a variable. Do we have any values left? - (report values) - (when (null? values) - ;; No. Go back to last variable, if there's one. - (hash-remove! assignments variable) - (let loop () - (if (not (null? queue)) - (let () - (define-values (variable values pushdomains) (py-pop! queue)) - (when pushdomains - (for ([domain (in-list pushdomains)]) - (send domain popState))) - (when values (inner-done)) - (hash-remove! assignments variable) - (loop)) - (error 'todo "return from function")))) - ;; Got a value. Check it. - (hash-set! assignments variable (send values domain-pop!)) - (when (not (null? pushdomains)) - (for ([domain (in-list pushdomains)]) - (send domain pushState))) - ;; todo: ok replacement for for/else? - (if (not (null? (hash-ref vconstraints variable))) - (for ([cvpair (in-list (hash-ref vconstraints variable))]) - (match-define (cons constraint variables) cvpair) - (when (not (constraint variables domains assignments pushdomains)) - ;; Value is not good. - (inner-done))) - (inner-done)) - (when (not (null? pushdomains)) - (for ([domain (in-list pushdomains)]) - (send domain popState))) - ;; Push state before looking for next variable. - (py-append! queue (list variable values pushdomains)))) - (error 'getSolutionIter "Whoops, broken solver")) + (let/ec break-for-loop + (if (not (null? (report lst))) ; ? good translation of for–else? + (for ([item (in-list lst)]) + (when (not ((last item) . in? . assignments)) + ; Found unassigned variable + (set! variable (last item)) + (let ([unassigned-variable variable]) (report unassigned-variable)) + (set! values (send (hash-ref domains variable) copy)) + (set! pushdomains + (if forwardcheck + (for/list ([x (in-hash-keys domains)] + #:when (and (not (x . in? . assignments)) + (not (x . equal? . variable)))) + (hash-ref domains x)) + null)) + (break-for-loop))) + (begin + ;; No unassigned variables. We've got a solution. Go back + ;; to last variable, if there's one. + (displayln "solution time") + (generator () + (yield (hash-copy assignments)) + (when (not queue) (break-loop1)) + (match-define (list variable values pushdomains) (py-pop! queue)) + (when (not (null? pushdomains)) + (for ([domain (in-list pushdomains)]) + (send domain popState))))))) + (report variable) + (report assignments) + + (let/ec break-loop2 + (let loop2 () + (displayln "starting while loop 2") + ;; We have a variable. Do we have any values left? + (displayln (format "values tested ~a" values)) + (when (null? (get-field _list values)) + ;; No. Go back to last variable, if there's one. + (hash-remove! assignments variable) + (let/ec break-loop3 + (let loop3 () + (if (not (null? queue)) + (let () + (define variable-values-pushdomains (py-pop! queue)) + (set! variable (first variable-values-pushdomains)) + (set-field! _list values (second variable-values-pushdomains)) + (set! pushdomains (third variable-values-pushdomains)) + (when (not (null? pushdomains)) + (for ([domain (in-list pushdomains)]) + (send domain popState))) + (when (not (null? (get-field _list values))) (break-loop3)) + (hash-remove! assignments variable) + (loop3)) + (begin + (set! want-to-return #t) + (return-k)))))) + ;; Got a value. Check it. + (let ([values1 values])(report values1)) + ;;!!!!!! + (report (eq? values (hash-ref domains "a"))) + (report (get-field _list (hash-ref domains "a"))) + (let ([popped (send values domain-pop!)]) + (report popped) (report values) + (hash-set! assignments variable popped)) + (report (get-field _list (hash-ref domains "a"))) + (let ([values2 values])(report values2)) + + + (when (not (null? pushdomains)) + (for ([domain (in-list pushdomains)]) + (send domain pushState))) + ;; todo: ok replacement for for/else? + (if (not (null? (hash-ref vconstraints variable))) + (let/ec break-for-loop + (for ([cvpair (in-list (hash-ref vconstraints variable))]) + (match-define (cons constraint variables) cvpair) + (when (not (constraint variables domains assignments pushdomains)) + ;; Value is not good. + (break-for-loop)))) + (break-loop2)) + (when (not (null? pushdomains)) + (for ([domain (in-list pushdomains)]) + (send domain popState))) + (loop2)) + ;; Push state before looking for next variable. + (py-append! queue (list variable values pushdomains))) + (loop1))) + (if want-to-return + (void) + (error 'getSolutionIter "Whoops, broken solver"))) diff --git a/csp/python-constraint/constraint.py b/csp/python-constraint/constraint.py index d64630f3..ba741059 100644 --- a/csp/python-constraint/constraint.py +++ b/csp/python-constraint/constraint.py @@ -456,6 +456,7 @@ class BacktrackingSolver(Solver): queue = [] while True: + print "starting while loop 1" # Mix the Degree and Minimum Remaing Values (MRV) heuristics lst = [(-len(vconstraints[variable]), @@ -465,6 +466,7 @@ class BacktrackingSolver(Solver): for item in lst: if item[-1] not in assignments: # Found unassigned variable + print "unassigned variable", variable variable = item[-1] values = domains[variable][:] if forwardcheck: @@ -477,6 +479,7 @@ class BacktrackingSolver(Solver): else: # No unassigned variables. We've got a solution. Go back # to last variable, if there's one. + print "solution time" yield assignments.copy() if not queue: return @@ -486,11 +489,11 @@ class BacktrackingSolver(Solver): domain.popState() print "variable", variable - print "values", values print "assignments", assignments while True: + print "starting while loop 2" # We have a variable. Do we have any values left? - print "values", values + print "values tested", values if not values: # No. Go back to last variable, if there's one. del assignments[variable] @@ -506,7 +509,15 @@ class BacktrackingSolver(Solver): return # Got a value. Check it. - assignments[variable] = values.pop() + print "values1", values + print "equality", values is domains["a"] + print "(domains[a1])", domains["a"] + popped = values.pop() + print "popped", popped + print "values", values + assignments[variable] = popped + print "(domains[a2])", domains["a"] + print "values2", values if pushdomains: for domain in pushdomains: From a0d0cb87e55842edc2d13a11a3cfdebbebadb70d Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Wed, 1 Oct 2014 16:47:28 -0700 Subject: [PATCH 027/246] better --- csp/constraint.rkt | 92 +++++++++++++++-------------- csp/python-constraint/constraint.py | 18 +++--- 2 files changed, 56 insertions(+), 54 deletions(-) diff --git a/csp/constraint.rkt b/csp/constraint.rkt index 15040ba9..7cb337ec 100644 --- a/csp/constraint.rkt +++ b/csp/constraint.rkt @@ -138,7 +138,7 @@ (define problem (new Problem)) ;; test from line 125 (send problem addVariable "a" '(1)) - (check-equal? (get-field _list (hash-ref (get-field _variables problem) "a")) '(1)) + ; (check-equal? (get-field _list (hash-ref (get-field _variables problem) "a")) '(1)) (displayln (format "The solution to ~a is ~a" problem @@ -233,35 +233,41 @@ (list (* -1 (length (hash-ref vconstraints variable))) (length (get-field _list (hash-ref domains variable))) variable)) list-comparator)) + (report lst) (let/ec break-for-loop - (if (not (null? (report lst))) ; ? good translation of for–else? - (for ([item (in-list lst)]) - (when (not ((last item) . in? . assignments)) - ; Found unassigned variable - (set! variable (last item)) - (let ([unassigned-variable variable]) (report unassigned-variable)) - (set! values (send (hash-ref domains variable) copy)) - (set! pushdomains - (if forwardcheck - (for/list ([x (in-hash-keys domains)] - #:when (and (not (x . in? . assignments)) - (not (x . equal? . variable)))) - (hash-ref domains x)) - null)) - (break-for-loop))) - (begin - ;; No unassigned variables. We've got a solution. Go back - ;; to last variable, if there's one. - (displayln "solution time") - (generator () - (yield (hash-copy assignments)) - (when (not queue) (break-loop1)) - (match-define (list variable values pushdomains) (py-pop! queue)) - (when (not (null? pushdomains)) - (for ([domain (in-list pushdomains)]) - (send domain popState))))))) - (report variable) - (report assignments) + (for ([item (in-list lst)]) + (when (not ((last item) . in? . assignments)) + ; Found unassigned variable + (set! variable (last item)) + (let ([unassigned-variable variable]) (report unassigned-variable)) + (set! values (send (hash-ref domains variable) copy)) + (set! pushdomains + (if forwardcheck + (for/list ([x (in-hash-keys domains)] + #:when (and (not (x . in? . assignments)) + (not (x . equal? . variable)))) + (hash-ref domains x)) + null)) + (break-for-loop))) + ;; if it makes it through the loop without breaking, then there are + ;; No unassigned variables. We've got a solution. Go back + ;; to last variable, if there's one. + (displayln "solution time") + (report assignments solution-assignments) + (yield (hash-copy assignments)) + (report queue) + (when (null? queue) (begin + (set! want-to-return #t) + (return-k))) + (define variable-values-pushdomains (py-pop! queue)) + (set! variable (first variable-values-pushdomains)) + (set-field! _list values (second variable-values-pushdomains)) + (set! pushdomains (third variable-values-pushdomains)) + (when (not (null? pushdomains)) + (for ([domain (in-list pushdomains)]) + (send domain popState)))) + (report variable variable-preloop-2) + (report assignments assignments-preloop-2) (let/ec break-loop2 (let loop2 () @@ -288,21 +294,15 @@ (begin (set! want-to-return #t) (return-k)))))) - ;; Got a value. Check it. - (let ([values1 values])(report values1)) - ;;!!!!!! - (report (eq? values (hash-ref domains "a"))) - (report (get-field _list (hash-ref domains "a"))) - (let ([popped (send values domain-pop!)]) - (report popped) (report values) - (hash-set! assignments variable popped)) - (report (get-field _list (hash-ref domains "a"))) - (let ([values2 values])(report values2)) + ;; Got a value. Check it. + (report values) + (hash-set! assignments variable (send values domain-pop!)) (when (not (null? pushdomains)) (for ([domain (in-list pushdomains)]) (send domain pushState))) + ;; todo: ok replacement for for/else? (if (not (null? (hash-ref vconstraints variable))) (let/ec break-for-loop @@ -311,14 +311,20 @@ (when (not (constraint variables domains assignments pushdomains)) ;; Value is not good. (break-for-loop)))) - (break-loop2)) + (begin (displayln "now breaking loop 2") (break-loop2))) + (when (not (null? pushdomains)) (for ([domain (in-list pushdomains)]) (send domain popState))) - (loop2)) - ;; Push state before looking for next variable. - (py-append! queue (list variable values pushdomains))) + + (loop2))) + + ;; Push state before looking for next variable. + (py-append! queue (list variable (get-field _list (send values copy)) pushdomains)) + (report queue new-queue) + (loop1))) + (if want-to-return (void) (error 'getSolutionIter "Whoops, broken solver"))) diff --git a/csp/python-constraint/constraint.py b/csp/python-constraint/constraint.py index ba741059..bafcfcc1 100644 --- a/csp/python-constraint/constraint.py +++ b/csp/python-constraint/constraint.py @@ -480,7 +480,9 @@ class BacktrackingSolver(Solver): # No unassigned variables. We've got a solution. Go back # to last variable, if there's one. print "solution time" + print "solution assignments", assignments yield assignments.copy() + print "queue", queue if not queue: return variable, values, pushdomains = queue.pop() @@ -488,8 +490,8 @@ class BacktrackingSolver(Solver): for domain in pushdomains: domain.popState() - print "variable", variable - print "assignments", assignments + print "variable-preloop-2", variable + print "assignments-preloop-2", assignments while True: print "starting while loop 2" # We have a variable. Do we have any values left? @@ -509,15 +511,7 @@ class BacktrackingSolver(Solver): return # Got a value. Check it. - print "values1", values - print "equality", values is domains["a"] - print "(domains[a1])", domains["a"] - popped = values.pop() - print "popped", popped - print "values", values - assignments[variable] = popped - print "(domains[a2])", domains["a"] - print "values2", values + assignments[variable] = values.pop() if pushdomains: for domain in pushdomains: @@ -529,6 +523,7 @@ class BacktrackingSolver(Solver): # Value is not good. break else: + print "now breaking loop 2" break if pushdomains: @@ -537,6 +532,7 @@ class BacktrackingSolver(Solver): # Push state before looking for next variable. queue.append((variable, values, pushdomains)) + print "new queue", queue raise RuntimeError, "Can't happen" From 072466ecc78bc67c642b8d097ab461c0970d4b86 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Wed, 1 Oct 2014 17:19:52 -0700 Subject: [PATCH 028/246] works, a little --- csp/constraint.rkt | 19 ++++++++++++++++++- csp/python-constraint/testconstraint.py | 3 ++- 2 files changed, 20 insertions(+), 2 deletions(-) diff --git a/csp/constraint.rkt b/csp/constraint.rkt index 7cb337ec..11e630f8 100644 --- a/csp/constraint.rkt +++ b/csp/constraint.rkt @@ -137,7 +137,8 @@ (check-equal? (get-field _variables (new Problem)) (make-hash)) (define problem (new Problem)) ;; test from line 125 - (send problem addVariable "a" '(1)) + (send problem addVariable "ab" '(1 2)) + (send problem addVariable "c" '(3)) ; (check-equal? (get-field _list (hash-ref (get-field _variables problem) "a")) '(1)) (displayln (format "The solution to ~a is ~a" @@ -180,6 +181,22 @@ (set! _hidden null) (set! _states null)) + (define/public (pushState) + ;; Save current domain state + ;; Variables hidden after that call are restored when that state + ;; is popped from the stack. + (py-append! _states (length _list))) + + (define/public (popState) + ;; Restore domain state from the top of the stack + + ;; Variables hidden since the last popped state are then available + ;; again. + (define diff (- (py-pop! _states) (length _list))) + (when (not (= 0 diff)) + (py-extend! _list (take-right _hidden diff)) + (set! _hidden (take _hidden (- (length _hidden) diff))))) + (define/public (domain-pop!) (py-pop! _list)) diff --git a/csp/python-constraint/testconstraint.py b/csp/python-constraint/testconstraint.py index 186fc7c2..a5093279 100644 --- a/csp/python-constraint/testconstraint.py +++ b/csp/python-constraint/testconstraint.py @@ -3,5 +3,6 @@ from constraint import * p = Problem() -p.addVariable("a", [1]) +p.addVariable("ab", [1, 2]) +p.addVariable("c", [3]) print p.getSolutions() \ No newline at end of file From 260f934c55e31fa0ab40325aab6b5c5b77edd750 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Wed, 1 Oct 2014 20:00:15 -0700 Subject: [PATCH 029/246] works, a little more --- csp/constraint.rkt | 247 +++++++++++++++++++----- csp/python-constraint/constraint.py | 26 ++- csp/python-constraint/testconstraint.py | 15 +- 3 files changed, 233 insertions(+), 55 deletions(-) diff --git a/csp/constraint.rkt b/csp/constraint.rkt index 11e630f8..33b4de72 100644 --- a/csp/constraint.rkt +++ b/csp/constraint.rkt @@ -46,7 +46,7 @@ ;; todo: tighten `object?` contract [addVariable (any/c (or/c list? object?) . ->m . void?)] [getSolutions (->m list?)]) - (class object% + (class* object% (printable<%>) (super-new) (init-field [solver #f]) @@ -54,6 +54,12 @@ [_constraints null] [_variables (make-hash)]) + + (define (repr) (format "" _variables)) + (define/public (custom-print out quoting-depth) (print (repr) out)) + (define/public (custom-display out) (displayln (repr) out)) + (define/public (custom-write out) (write (repr) out)) + (define/public (reset) ;; Reset the current problem definition (set! _constraints null) @@ -85,6 +91,15 @@ ;; Add one or more variables to the problem (for-each (λ(var) (addVariable var domain)) variables)) + (define/public (addConstraint constraint [variables null]) + ;; Add a constraint to the problem + + (when (not (Constraint? constraint)) + (if (procedure? constraint) + (set! constraint (new FunctionConstraint [func constraint])) + (error 'addConstraint "Constraints must be instances of class Constraint"))) + (py-append! _constraints (cons constraint variables))) + (define/public (getSolution) ;; Find and return a solution to the problem (define-values (domains constraints vconstraints) (_getArgs)) @@ -137,29 +152,20 @@ (check-equal? (get-field _variables (new Problem)) (make-hash)) (define problem (new Problem)) ;; test from line 125 - (send problem addVariable "ab" '(1 2)) - (send problem addVariable "c" '(3)) - ; (check-equal? (get-field _list (hash-ref (get-field _variables problem) "a")) '(1)) - - (displayln (format "The solution to ~a is ~a" - problem - (send problem getSolutions))) - + (send problem addVariable "a" '(1)) + (check-equal? (get-field _list (hash-ref (get-field _variables problem) "a")) '(1)) (send problem reset) (check-equal? (get-field _variables problem) (make-hash)) (send problem addVariables '("a" "b") '(1 2 3)) (check-equal? (get-field _list (hash-ref (get-field _variables problem) "a")) '(1 2 3)) - (check-equal? (get-field _list (hash-ref (get-field _variables problem) "b")) '(1 2 3)) - - ) + (check-equal? (get-field _list (hash-ref (get-field _variables problem) "b")) '(1 2 3))) ;; ---------------------------------------------------------------------- ;; Domains ;; ---------------------------------------------------------------------- - (define Domain ;; Class used to control possible values for variables ;; When list or tuples are used as domains, they are automatically @@ -189,7 +195,7 @@ (define/public (popState) ;; Restore domain state from the top of the stack - + ;; Variables hidden since the last popped state are then available ;; again. (define diff (- (py-pop! _states) (length _list))) @@ -197,6 +203,16 @@ (py-extend! _list (take-right _hidden diff)) (set! _hidden (take _hidden (- (length _hidden) diff))))) + (define/public (hideValue value) + ;; Hide the given value from the domain + + ;; After that call the given value won't be seen as a possible value + ;; on that domain anymore. The hidden value will be restored when the + ;; previous saved state is popped. + (set! _list (remove value _list)) + (py-append! _hidden value)) + + (define/public (domain-pop!) (py-pop! _list)) @@ -208,9 +224,130 @@ )) - (define Domain? (is-a?/c Domain)) + + +;; ---------------------------------------------------------------------- +;; Constraints +;; ---------------------------------------------------------------------- + +(define Constraint + (class object% + (super-new) + + (define/public (call variables domains assignments [forwardcheck #f]) + ;; Perform the constraint checking + + ;; If the forwardcheck parameter is not false, besides telling if + ;; the constraint is currently broken or not, the constraint + ;; implementation may choose to hide values from the domains of + ;; unassigned variables to prevent them from being used, and thus + ;; prune the search space. + #t) + + (define/public (preProcess variables domains constraints vconstraints) + ;; Preprocess variable domains + ;; This method is called before starting to look for solutions, + ;; and is used to prune domains with specific constraint logic + ;; when possible. For instance, any constraints with a single + ;; variable may be applied on all possible values and removed, + ;; since they may act on individual values even without further + ;; knowledge about other assignments. + (when (= (length variables) 1) + (define variable (list-ref variables 0)) + (define domain (hash-ref domains variable)) + (for ([value (in-list domain)]) + (when (not (call variables domains (make-hash (list (cons variable value))))) + (set! domain (remove value domain)))) + (set! constraints (remove (cons this variables) constraints)) + (hash-remove! vconstraints variable (cons this variables)))) + + (define/public (forwardCheck variables domains assignments [_unassigned Unassigned]) + ;; Helper method for generic forward checking + ;; Currently, this method acts only when there's a single + ;; unassigned variable. + (define return-result #t) + + (define unassignedvariable _unassigned) + (report assignments) + (let/ec break + (for ([variable (in-list (report variables))]) + (when (not (variable . in? . assignments)) + (if (equal? unassignedvariable _unassigned) + (begin (displayln "boom") + (set! unassignedvariable variable)) + (break)))) + (when (not (equal? unassignedvariable _unassigned)) + ;; Remove from the unassigned variable domain's all + ;; values which break our variable's constraints. + (define domain (hash-ref domains unassignedvariable)) + (report domain domain-fc) + (when (not (null? (get-field _list domain))) + (for ([value (in-list (get-field _list domain))]) + (hash-set! assignments unassignedvariable value) + (when (not (send this call variables domains assignments)) + (send domain hideValue value))) + (hash-remove! assignments unassignedvariable)) + (when (null? (get-field _list domain)) + (set! return-result #f) + (break)))) + return-result) + )) + +(define Constraint? (is-a?/c Constraint)) + +(define FunctionConstraint + (class Constraint + (super-new) + (init-field func [assigned #t]) + (field [_func func][_assigned assigned]) + + (inherit forwardCheck) + (define/override (call variables domains assignments [forwardcheck #f] [_unassigned Unassigned]) + (displayln "in call") + (report assignments assignments-before) + (define parms (for/list ([x (in-list variables)]) + (if (hash-has-key? assignments x) (hash-ref assignments x) _unassigned))) + (report assignments assignments-after) + (define missing (length (filter (λ(v) (equal? v _unassigned)) parms))) + (displayln "dang") + (if (> missing 0) + (begin + (report missing) + (report _assigned) + (report parms) + (report (apply _func parms)) + (report forwardcheck) + (report assignments assignments-to-fc) + (and (or _assigned (apply _func parms)) + (or (not forwardcheck) (not (= missing 1)) + (forwardCheck variables domains assignments)))) + (apply _func parms))) + + )) +(define FunctionConstraint? (is-a?/c FunctionConstraint)) + + +;; ---------------------------------------------------------------------- +;; Variables +;; ---------------------------------------------------------------------- + + +(define Variable + (class* object% (printable<%>) + (super-new) + (define (repr) (format "" _name)) + (define/public (custom-print out quoting-depth) (print (repr) out)) + (define/public (custom-display out) (displayln (repr) out)) + (define/public (custom-write out) (write (repr) out)) + + (init-field name) + (field [_name name]))) +(define Variable? (is-a?/c Variable)) + +(define Unassigned (new Variable [name "Unassigned"])) + ;; ---------------------------------------------------------------------- ;; Solvers ;; ---------------------------------------------------------------------- @@ -245,18 +382,21 @@ (set! return-k break-loop1) (let loop1 () (displayln "starting while loop 1") + + ;; Mix the Degree and Minimum Remaing Values (MRV) heuristics (set! lst (sort (for/list ([variable (in-hash-keys domains)]) (list (* -1 (length (hash-ref vconstraints variable))) (length (get-field _list (hash-ref domains variable))) - variable)) list-comparator)) + variable)) list-comparator)) (report lst) (let/ec break-for-loop (for ([item (in-list lst)]) (when (not ((last item) . in? . assignments)) + ; Found unassigned variable (set! variable (last item)) - (let ([unassigned-variable variable]) (report unassigned-variable)) + (report variable unassigned-variable) (set! values (send (hash-ref domains variable) copy)) (set! pushdomains (if forwardcheck @@ -266,13 +406,11 @@ (hash-ref domains x)) null)) (break-for-loop))) + ;; if it makes it through the loop without breaking, then there are ;; No unassigned variables. We've got a solution. Go back ;; to last variable, if there's one. - (displayln "solution time") - (report assignments solution-assignments) (yield (hash-copy assignments)) - (report queue) (when (null? queue) (begin (set! want-to-return #t) (return-k))) @@ -280,18 +418,20 @@ (set! variable (first variable-values-pushdomains)) (set-field! _list values (second variable-values-pushdomains)) (set! pushdomains (third variable-values-pushdomains)) - (when (not (null? pushdomains)) - (for ([domain (in-list pushdomains)]) - (send domain popState)))) + (for ([domain (in-list pushdomains)]) + (send domain popState))) + (report variable variable-preloop-2) (report assignments assignments-preloop-2) (let/ec break-loop2 (let loop2 () (displayln "starting while loop 2") + ;; We have a variable. Do we have any values left? - (displayln (format "values tested ~a" values)) + (report values values-tested) (when (null? (get-field _list values)) + ;; No. Go back to last variable, if there's one. (hash-remove! assignments variable) (let/ec break-loop3 @@ -313,33 +453,33 @@ (return-k)))))) ;; Got a value. Check it. - (report values) (hash-set! assignments variable (send values domain-pop!)) - (when (not (null? pushdomains)) - (for ([domain (in-list pushdomains)]) - (send domain pushState))) + (for ([domain (in-list pushdomains)]) + (send domain pushState)) + (report pushdomains pushdomains1) + (report domains domains1) - ;; todo: ok replacement for for/else? - (if (not (null? (hash-ref vconstraints variable))) - (let/ec break-for-loop - (for ([cvpair (in-list (hash-ref vconstraints variable))]) - (match-define (cons constraint variables) cvpair) - (when (not (constraint variables domains assignments pushdomains)) - ;; Value is not good. - (break-for-loop)))) - (begin (displayln "now breaking loop 2") (break-loop2))) + (let/ec break-for-loop + (for ([cvpair (in-list (hash-ref vconstraints variable))]) + (match-define (cons constraint variables) cvpair) + (define the_result (send constraint call variables domains assignments pushdomains)) + (report pushdomains pushdomains2) + (report domains domains2) + (report the_result) + (when (not the_result) + ;; Value is not good. + (break-for-loop))) + (begin (displayln "now breaking loop 2") (break-loop2))) - (when (not (null? pushdomains)) - (for ([domain (in-list pushdomains)]) - (send domain popState))) + (for ([domain (in-list pushdomains)]) + (send domain popState)) (loop2))) ;; Push state before looking for next variable. (py-append! queue (list variable (get-field _list (send values copy)) pushdomains)) (report queue new-queue) - (loop1))) (if want-to-return @@ -347,18 +487,29 @@ (error 'getSolutionIter "Whoops, broken solver"))) + (define (call-solution-generator domains constraints vconstraints #:first-only [first-only #f]) + (for/list ([solution (in-generator (getSolutionIter domains constraints vconstraints))] #:final first-only) + solution)) - (define/override (getSolution domains constraints vconstraints) - ;; todo: fix this - (void)) + (define/override (getSolution . args) + (apply call-solution-generator #:first-only #t args)) - (define/override (getSolutions domains constraints vconstraints) - (for/list ([solution (in-generator (getSolutionIter domains constraints vconstraints))]) solution)) + (define/override (getSolutions . args) + (apply call-solution-generator args)) )) (module+ main - (define p (new Problem)) - (define d (new Domain [set '(1 2)])) + (define problem (new Problem)) + (send problem addVariables '("a" "b") '(1 2 3 4)) + (define (func a b) + (cond + [(and (real? b) (real? a)) (> b a)] + [(Variable? b) #t] + [else #f])) + (send problem addConstraint func '("a" "b")) + (displayln (format "The solution to ~a is ~a" + problem + (send problem getSolutions))) ) \ No newline at end of file diff --git a/csp/python-constraint/constraint.py b/csp/python-constraint/constraint.py index bafcfcc1..58e25d00 100644 --- a/csp/python-constraint/constraint.py +++ b/csp/python-constraint/constraint.py @@ -466,8 +466,8 @@ class BacktrackingSolver(Solver): for item in lst: if item[-1] not in assignments: # Found unassigned variable - print "unassigned variable", variable variable = item[-1] + print "unassigned variable", variable values = domains[variable][:] if forwardcheck: pushdomains = [domains[x] for x in domains @@ -516,10 +516,17 @@ class BacktrackingSolver(Solver): if pushdomains: for domain in pushdomains: domain.pushState() + print "pushdomains1", pushdomains + print "domains1", domains for constraint, variables in vconstraints[variable]: - if not constraint(variables, domains, assignments, - pushdomains): + the_result = constraint(variables, domains, assignments, + pushdomains) + print "pushdomains2", pushdomains + print "domains2", domains + print "the_result", the_result + raise KeyError("stop") + if not the_result: # Value is not good. break else: @@ -892,9 +899,11 @@ class Constraint(object): @rtype: bool """#""" unassignedvariable = _unassigned + print "assignments", assignments for variable in variables: if variable not in assignments: if unassignedvariable is _unassigned: + print "boom" unassignedvariable = variable else: break @@ -903,6 +912,7 @@ class Constraint(object): # Remove from the unassigned variable domain's all # values which break our variable's constraints. domain = domains[unassignedvariable] + print "domain-fc", domain if domain: for value in domain[:]: assignments[unassignedvariable] = value @@ -949,9 +959,19 @@ class FunctionConstraint(Constraint): def __call__(self, variables, domains, assignments, forwardcheck=False, _unassigned=Unassigned): + print "in call" + print "assignments-before", assignments parms = [assignments.get(x, _unassigned) for x in variables] + print "assignments-after", assignments missing = parms.count(_unassigned) + print "dang" if missing: + print "missing", missing + print "self._assigned", self._assigned + print "parms", parms + print "self._func(*parms)", self._func(*parms) + print "forwardcheck", forwardcheck + print "assignments-to-fc", assignments return ((self._assigned or self._func(*parms)) and (not forwardcheck or missing != 1 or self.forwardCheck(variables, domains, assignments))) diff --git a/csp/python-constraint/testconstraint.py b/csp/python-constraint/testconstraint.py index a5093279..5fa2b484 100644 --- a/csp/python-constraint/testconstraint.py +++ b/csp/python-constraint/testconstraint.py @@ -2,7 +2,14 @@ from constraint import * -p = Problem() -p.addVariable("ab", [1, 2]) -p.addVariable("c", [3]) -print p.getSolutions() \ No newline at end of file +#p = Problem() +#p.addVariable("ab", [1, 2]) +#p.addVariable("c", [3]) +#print p.getSolutions() + +problem = Problem() +problem.addVariables(["a", "b"], [1, 2]) +def func(a, b): + return b > a +problem.addConstraint(func, ["a", "b"]) +problem.getSolution() From b6102f22eea98692b9a11cf28cc7a21a3b9d8f75 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Wed, 1 Oct 2014 20:41:27 -0700 Subject: [PATCH 030/246] improvements --- csp/constraint.rkt | 80 +++++++++++------------ csp/python-constraint/constraint.py | 63 +++++++++--------- csp/python-constraint/examples/abc/abc.py | 2 +- csp/python-constraint/testconstraint.py | 6 +- csp/python-constraint/trials/abc.py | 17 +++-- 5 files changed, 82 insertions(+), 86 deletions(-) diff --git a/csp/constraint.rkt b/csp/constraint.rkt index 33b4de72..76807042 100644 --- a/csp/constraint.rkt +++ b/csp/constraint.rkt @@ -55,7 +55,7 @@ [_variables (make-hash)]) - (define (repr) (format "" _variables)) + (define (repr) (format "" (hash-keys _variables))) (define/public (custom-print out quoting-depth) (print (repr) out)) (define/public (custom-display out) (displayln (repr) out)) (define/public (custom-write out) (write (repr) out)) @@ -270,19 +270,18 @@ (define return-result #t) (define unassignedvariable _unassigned) - (report assignments) + ;(report assignments) (let/ec break - (for ([variable (in-list (report variables))]) + (for ([variable (in-list variables)]) (when (not (variable . in? . assignments)) (if (equal? unassignedvariable _unassigned) - (begin (displayln "boom") - (set! unassignedvariable variable)) + (set! unassignedvariable variable) (break)))) (when (not (equal? unassignedvariable _unassigned)) ;; Remove from the unassigned variable domain's all ;; values which break our variable's constraints. (define domain (hash-ref domains unassignedvariable)) - (report domain domain-fc) + ;(report domain domain-fc) (when (not (null? (get-field _list domain))) (for ([value (in-list (get-field _list domain))]) (hash-set! assignments unassignedvariable value) @@ -304,22 +303,20 @@ (field [_func func][_assigned assigned]) (inherit forwardCheck) - (define/override (call variables domains assignments [forwardcheck #f] [_unassigned Unassigned]) - (displayln "in call") - (report assignments assignments-before) + (define/override (call variables domains assignments [forwardcheck #f] [_unassigned Unassigned])1 + ;(report assignments assignments-before) (define parms (for/list ([x (in-list variables)]) (if (hash-has-key? assignments x) (hash-ref assignments x) _unassigned))) - (report assignments assignments-after) + ;(report assignments assignments-after) (define missing (length (filter (λ(v) (equal? v _unassigned)) parms))) - (displayln "dang") (if (> missing 0) (begin - (report missing) - (report _assigned) - (report parms) - (report (apply _func parms)) - (report forwardcheck) - (report assignments assignments-to-fc) + ;(report missing) + ;(report _assigned) + ;(report parms) + ;(report (apply _func parms)) + ;(report forwardcheck) + ;(report assignments assignments-to-fc) (and (or _assigned (apply _func parms)) (or (not forwardcheck) (not (= missing 1)) (forwardCheck variables domains assignments)))) @@ -333,7 +330,6 @@ ;; Variables ;; ---------------------------------------------------------------------- - (define Variable (class* object% (printable<%>) (super-new) @@ -381,7 +377,7 @@ (let/ec break-loop1 (set! return-k break-loop1) (let loop1 () - (displayln "starting while loop 1") + ;(displayln "starting while loop 1") ;; Mix the Degree and Minimum Remaing Values (MRV) heuristics @@ -389,14 +385,14 @@ (list (* -1 (length (hash-ref vconstraints variable))) (length (get-field _list (hash-ref domains variable))) variable)) list-comparator)) - (report lst) + ;(report lst) (let/ec break-for-loop (for ([item (in-list lst)]) (when (not ((last item) . in? . assignments)) ; Found unassigned variable (set! variable (last item)) - (report variable unassigned-variable) + ;(report variable unassigned-variable) (set! values (send (hash-ref domains variable) copy)) (set! pushdomains (if forwardcheck @@ -421,15 +417,15 @@ (for ([domain (in-list pushdomains)]) (send domain popState))) - (report variable variable-preloop-2) - (report assignments assignments-preloop-2) + ;(report variable variable-preloop-2) + ;(report assignments assignments-preloop-2) (let/ec break-loop2 (let loop2 () - (displayln "starting while loop 2") + ;(displayln "starting while loop 2") ;; We have a variable. Do we have any values left? - (report values values-tested) + ;(report values values-tested) (when (null? (get-field _list values)) ;; No. Go back to last variable, if there's one. @@ -457,20 +453,21 @@ (for ([domain (in-list pushdomains)]) (send domain pushState)) - (report pushdomains pushdomains1) - (report domains domains1) + ;(report pushdomains pushdomains1) + ;(report domains domains1) (let/ec break-for-loop (for ([cvpair (in-list (hash-ref vconstraints variable))]) (match-define (cons constraint variables) cvpair) (define the_result (send constraint call variables domains assignments pushdomains)) - (report pushdomains pushdomains2) - (report domains domains2) - (report the_result) + ;(report pushdomains pushdomains2) + ;(report domains domains2) + ;(report the_result) (when (not the_result) ;; Value is not good. (break-for-loop))) - (begin (displayln "now breaking loop 2") (break-loop2))) + (begin ;(displayln "now breaking loop 2") + (break-loop2))) (for ([domain (in-list pushdomains)]) (send domain popState)) @@ -479,7 +476,7 @@ ;; Push state before looking for next variable. (py-append! queue (list variable (get-field _list (send values copy)) pushdomains)) - (report queue new-queue) + ;(report queue new-queue) (loop1))) (if want-to-return @@ -502,14 +499,15 @@ (module+ main (define problem (new Problem)) - (send problem addVariables '("a" "b") '(1 2 3 4)) - (define (func a b) - (cond - [(and (real? b) (real? a)) (> b a)] - [(Variable? b) #t] - [else #f])) - (send problem addConstraint func '("a" "b")) + (send problem addVariables '("a" "b" "c") (range 1 10)) +; (send problem addConstraint (λ(a b) (and (> a 0) (= b (* 211 a)))) '("a" "b")) + (displayln (format "The solution to ~a is ~a" problem - (send problem getSolutions))) - ) \ No newline at end of file + (argmin (λ(h) + (let ([a (hash-ref h "a")] + [b (hash-ref h "b")] + [c (hash-ref h "c")]) + (/ (+ (* 100 a) (* 10 b) c) (+ a b c)))) + (send problem getSolutions))))) + \ No newline at end of file diff --git a/csp/python-constraint/constraint.py b/csp/python-constraint/constraint.py index 58e25d00..3ec9b1a4 100644 --- a/csp/python-constraint/constraint.py +++ b/csp/python-constraint/constraint.py @@ -376,7 +376,7 @@ class Solver(object): constraints affecting the given variables. @type vconstraints: dict """ - raise NotImplementedError, \ + NotImplementedError, \ "%s is an abstract class" % self.__class__.__name__ def getSolutions(self, domains, constraints, vconstraints): @@ -456,18 +456,18 @@ class BacktrackingSolver(Solver): queue = [] while True: - print "starting while loop 1" + #print "starting while loop 1" # Mix the Degree and Minimum Remaing Values (MRV) heuristics lst = [(-len(vconstraints[variable]), len(domains[variable]), variable) for variable in domains] lst.sort() - print "lst", lst + #print "lst", lst for item in lst: if item[-1] not in assignments: # Found unassigned variable variable = item[-1] - print "unassigned variable", variable + #print "unassigned variable", variable values = domains[variable][:] if forwardcheck: pushdomains = [domains[x] for x in domains @@ -479,10 +479,10 @@ class BacktrackingSolver(Solver): else: # No unassigned variables. We've got a solution. Go back # to last variable, if there's one. - print "solution time" - print "solution assignments", assignments + #print "solution time" + #print "solution assignments", assignments yield assignments.copy() - print "queue", queue + #print "queue", queue if not queue: return variable, values, pushdomains = queue.pop() @@ -490,12 +490,12 @@ class BacktrackingSolver(Solver): for domain in pushdomains: domain.popState() - print "variable-preloop-2", variable - print "assignments-preloop-2", assignments + #print "variable-preloop-2", variable + #print "assignments-preloop-2", assignments while True: - print "starting while loop 2" + #print "starting while loop 2" # We have a variable. Do we have any values left? - print "values tested", values + #print "values tested", values if not values: # No. Go back to last variable, if there's one. del assignments[variable] @@ -516,21 +516,20 @@ class BacktrackingSolver(Solver): if pushdomains: for domain in pushdomains: domain.pushState() - print "pushdomains1", pushdomains - print "domains1", domains + #print "pushdomains1", pushdomains + #print "domains1", domains for constraint, variables in vconstraints[variable]: the_result = constraint(variables, domains, assignments, pushdomains) - print "pushdomains2", pushdomains - print "domains2", domains - print "the_result", the_result - raise KeyError("stop") + #print "pushdomains2", pushdomains + #print "domains2", domains + #print "the_result", the_result if not the_result: # Value is not good. break else: - print "now breaking loop 2" + #print "now breaking loop 2" break if pushdomains: @@ -539,7 +538,7 @@ class BacktrackingSolver(Solver): # Push state before looking for next variable. queue.append((variable, values, pushdomains)) - print "new queue", queue + #print "new queue", queue raise RuntimeError, "Can't happen" @@ -899,11 +898,11 @@ class Constraint(object): @rtype: bool """#""" unassignedvariable = _unassigned - print "assignments", assignments + #print "assignments", assignments for variable in variables: if variable not in assignments: if unassignedvariable is _unassigned: - print "boom" + #print "boom" unassignedvariable = variable else: break @@ -912,7 +911,7 @@ class Constraint(object): # Remove from the unassigned variable domain's all # values which break our variable's constraints. domain = domains[unassignedvariable] - print "domain-fc", domain + #print "domain-fc", domain if domain: for value in domain[:]: assignments[unassignedvariable] = value @@ -959,19 +958,19 @@ class FunctionConstraint(Constraint): def __call__(self, variables, domains, assignments, forwardcheck=False, _unassigned=Unassigned): - print "in call" - print "assignments-before", assignments + #print "in call" + #print "assignments-before", assignments parms = [assignments.get(x, _unassigned) for x in variables] - print "assignments-after", assignments + #print "assignments-after", assignments missing = parms.count(_unassigned) - print "dang" + #print "dang" if missing: - print "missing", missing - print "self._assigned", self._assigned - print "parms", parms - print "self._func(*parms)", self._func(*parms) - print "forwardcheck", forwardcheck - print "assignments-to-fc", assignments + #print "missing", missing + #print "self._assigned", self._assigned + #print "parms", parms + #print "self._func(*parms)", self._func(*parms) + #print "forwardcheck", forwardcheck + #print "assignments-to-fc", assignments return ((self._assigned or self._func(*parms)) and (not forwardcheck or missing != 1 or self.forwardCheck(variables, domains, assignments))) diff --git a/csp/python-constraint/examples/abc/abc.py b/csp/python-constraint/examples/abc/abc.py index c10bc675..ddc23bb7 100755 --- a/csp/python-constraint/examples/abc/abc.py +++ b/csp/python-constraint/examples/abc/abc.py @@ -13,7 +13,7 @@ from constraint import * def main(): problem = Problem() problem.addVariables("abc", range(1,10)) - problem.getSolutions() + print min(problem.getSolutions()) minvalue = 999/(9*3) minsolution = {} for solution in problem.getSolutions(): diff --git a/csp/python-constraint/testconstraint.py b/csp/python-constraint/testconstraint.py index 5fa2b484..21dd89fc 100644 --- a/csp/python-constraint/testconstraint.py +++ b/csp/python-constraint/testconstraint.py @@ -8,8 +8,8 @@ from constraint import * #print p.getSolutions() problem = Problem() -problem.addVariables(["a", "b"], [1, 2]) +problem.addVariables(["a", "b"], range(500)) def func(a, b): - return b > a + return a > 0 and b == 211 * a problem.addConstraint(func, ["a", "b"]) -problem.getSolution() +print problem.getSolutions() diff --git a/csp/python-constraint/trials/abc.py b/csp/python-constraint/trials/abc.py index 800cf2c0..55bedaca 100755 --- a/csp/python-constraint/trials/abc.py +++ b/csp/python-constraint/trials/abc.py @@ -13,18 +13,17 @@ from constraint import * def main(): problem = Problem() problem.addVariables("abc", range(1,10)) - problem.getSolutions() - minvalue = 999/(9*3) - minsolution = {} - for solution in problem.getSolutions(): + results = [] + for solution in problem.getSolutions(): a = solution["a"] b = solution["b"] c = solution["c"] - value = (a*100+b*10+c)/(a+b+c) - if value < minvalue: - minsolution = solution - print (minsolution["a"]*100+minsolution["b"]*10+minsolution["c"])/(minsolution["a"]+minsolution["b"]+minsolution["c"]) - print minsolution + results.append((((a*100) + (b*10) + c) / (a + b + c + 0.0), (a*100) + (b*10) + c)) + + results.sort() + + print results[0] + if __name__ == "__main__": main() From cf1bd38a9e106e7a4be8ac236202b9c1a3abb5fb Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Thu, 2 Oct 2014 12:30:16 -0700 Subject: [PATCH 031/246] progress --- csp/constraint-tests.rkt | 146 ++++++++++++++++++++++++ csp/constraint.rkt | 94 ++++++++++----- csp/helpers.rkt | 12 +- csp/python-constraint/constraint.py | 6 +- csp/python-constraint/testconstraint.py | 8 +- csp/python-constraint/trials/queens.py | 2 +- 6 files changed, 229 insertions(+), 39 deletions(-) create mode 100644 csp/constraint-tests.rkt diff --git a/csp/constraint-tests.rkt b/csp/constraint-tests.rkt new file mode 100644 index 00000000..f552d0b5 --- /dev/null +++ b/csp/constraint-tests.rkt @@ -0,0 +1,146 @@ +#lang racket +(require "constraint.rkt") +(require rackunit) + +(define-simple-check (check-hash-items h1 h2) + (for/and ([(k1 v1) (in-hash h1)]) + (equal? (hash-ref h2 k1) v1))) + +;; ABC problem: +;; what is the minimum value of + +;; ABC +;; ------- +;; A+B+C + + +(define abc-problem (new Problem)) +(send abc-problem addVariables '("a" "b" "c") (range 1 10)) +(define (test-solution s) (let ([a (hash-ref s "a")] + [b (hash-ref s "b")] + [c (hash-ref s "c")]) + (/ (+ (* 100 a) (* 10 b) c) (+ a b c)))) + +(check-hash-items (argmin test-solution (send abc-problem getSolutions)) + #hash(("c" . 9) ("b" . 9) ("a" . 1))) + + +;; quarter problem: +;; 26 coins, dollars and quarters +;; that add up to $17. + +(define quarter-problem (new Problem)) +(send quarter-problem addVariables '("dollars" "quarters") (range 1 27)) +(send quarter-problem addConstraint (λ(d q) (= 17 (+ d (* 0.25 q)))) '("dollars" "quarters")) +(send quarter-problem addConstraint (λ(d q) (= 26 (+ d q))) '("dollars" "quarters")) +(check-hash-items (send quarter-problem getSolution) '#hash(("dollars" . 14) ("quarters" . 12))) + +;; coin problem 2 +#| +A collection of 33 coins, consisting of nickels, dimes, and quarters, has a value of $3.30. If there are three times as many nickels as quarters, and one-half as many dimes as nickels, how many coins of each kind are there? +|# + +(define nickel-problem (new Problem)) +(send nickel-problem addVariables '(nickels dimes quarters) (range 1 34)) +(send nickel-problem addConstraint (λ(n d q) (= 33 (+ n d q))) '(nickels dimes quarters)) +(send nickel-problem addConstraint (λ(n d q) (= 3.30 (+ (* 0.05 n) (* 0.1 d) (* 0.25 q)))) '(nickels dimes quarters)) +(send nickel-problem addConstraint (λ(n q) (= n (* 3 q))) '(nickels quarters)) +(send nickel-problem addConstraint (λ(d n) (= n (* 2 d))) '(dimes nickels)) +(check-hash-items (send nickel-problem getSolution) #hash((nickels . 18) (quarters . 6) (dimes . 9))) + +;; word math +#| +# Assign equal values to equal letters, and different values to +# different letters, in a way that satisfies the following sum: +# +# TWO +# + TWO +# ----- +# FOUR +|# + + +(define two-four-problem (new Problem)) +(send two-four-problem addVariables '(t w o f u r) (range 10)) +(send two-four-problem addConstraint (new AllDifferentConstraint)) +(send two-four-problem addConstraint (λ(t w o) (> (word-value t w o) 99)) '(t w o)) +(send two-four-problem addConstraint (λ(f o u r) (> (word-value f o u r) 999)) '(f o u r)) +(send two-four-problem addConstraint + (λ (t w o f u r) + (let ([two (word-value t w o)] + [four (word-value f o u r)]) + ((two . + . two) . = . four))) '(t w o f u r)) +(check-equal? (length (send two-four-problem getSolutions)) 7) +(send two-four-problem addConstraint (λ(r) (= r 0)) '(r)) +(check-hash-items (send two-four-problem getSolution) #hash((o . 5) (w . 6) (u . 3) (f . 1) (r . 0) (t . 7))) + + +;; xsum +#| +# Reorganize the following numbers in a way that each line of +# 5 numbers sum to 27. +# +# 1 6 +# 2 7 +# 3 +# 8 4 +# 9 5 +# +|# + +(define xsum-problem (new Problem)) +(send xsum-problem addVariables '(l1 l2 l3 l4 r1 r2 r3 r4 x) (range 10)) +(send xsum-problem addConstraint (λ (l1 l2 l3 l4 x) + (and (< l1 l2 l3 l4) + (= 27 (+ l1 l2 l3 l4 x)))) '(l1 l2 l3 l4 x)) +(send xsum-problem addConstraint (λ (r1 r2 r3 r4 x) + (and (< r1 r2 r3 r4) + (= 27 (+ r1 r2 r3 r4 x)))) '(r1 r2 r3 r4 x)) +(send xsum-problem addConstraint (new AllDifferentConstraint)) +(check-equal? (length (send xsum-problem getSolutions)) 8) + + + +;; send more money problem +#| +# Assign equal values to equal letters, and different values to +# different letters, in a way that satisfies the following sum: +# +# SEND +# + MORE +# ------ +# MONEY +|# + +(define sm-problem (new Problem)) +(send sm-problem addVariables '(s e n d m o r y) (range 10)) +(send sm-problem addConstraint (λ(x) (> x 0)) '(s)) +(send sm-problem addConstraint (λ(x) (> x 0)) '(m)) +(send sm-problem addConstraint (λ(d e y) (= (modulo (+ d e) 10) y)) '(d e y)) +(send sm-problem addConstraint (λ(n d r e y) + (= (modulo (+ (word-value n d) (word-value r e)) 100) + (word-value e y))) '(n d r e y)) +(send sm-problem addConstraint (λ(e n d o r y) + (= (modulo (+ (word-value e n d) (word-value o r e)) 1000) (word-value n e y))) '(e n d o r y)) +(send sm-problem addConstraint (λ(s e n d m o r y) (= + (+ (word-value s e n d) + (word-value m o r e)) + (word-value m o n e y))) '(s e n d m o r y)) +(send sm-problem addConstraint (new AllDifferentConstraint)) + +(check-hash-items (send sm-problem getSolution) '#hash((m . 1) (e . 5) (r . 8) (n . 6) (y . 2) (o . 0) (d . 7) (s . 9))) + + +;; queens problem +(define qp (new Problem)) +(define cols (range 8)) +(define rows (range 8)) +(send qp addVariables cols rows) +(for* ([col1 (in-list cols)] [col2 (in-list cols)] #:when (< col1 col2)) + (send qp addConstraint (λ(row1 row2 [col1 col1][col2 col2]) + (and + ;; test if two cells are on a diagonal + (not (= (abs (- row1 row2)) (abs (- col1 col2)))) + ;; test if two cells are in same row + (not (= row1 row2)))) (list col1 col2))) +(check-equal? (length (send qp getSolutions)) 92) \ No newline at end of file diff --git a/csp/constraint.rkt b/csp/constraint.rkt index 76807042..d13c06ee 100644 --- a/csp/constraint.rkt +++ b/csp/constraint.rkt @@ -31,7 +31,7 @@ # OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. |# -(provide (all-defined-out)) +(provide (all-defined-out) (all-from-out "helpers.rkt")) ;(provide Problem Variable Domain Unassigned Solver BacktrackingSolver RecursiveBacktrackingSolver MinConflictsSolver Constraint FunctionConstraint AllDifferentConstraint AllEqualConstraint MaxSumConstraint ExactSumConstraint MinSumConstraint InSetConstraint NotInSetConstraint SomeInSetConstraint SomeNotInSetConstraint) ;(define Problem/c (λ(x) (is-a x Problem))) @@ -89,7 +89,11 @@ (define/public (addVariables variables domain) ;; Add one or more variables to the problem - (for-each (λ(var) (addVariable var domain)) variables)) + (define listified-variables + (cond + [(string? variables) (map (λ(c) (format "~a" c)) (string->list variables))] + [else variables])) + (for-each (λ(var) (addVariable var domain)) listified-variables)) (define/public (addConstraint constraint [variables null]) ;; Add a constraint to the problem @@ -98,7 +102,7 @@ (if (procedure? constraint) (set! constraint (new FunctionConstraint [func constraint])) (error 'addConstraint "Constraints must be instances of class Constraint"))) - (py-append! _constraints (cons constraint variables))) + (py-append! _constraints (list constraint variables))) (define/public (getSolution) ;; Find and return a solution to the problem @@ -119,19 +123,19 @@ (define allvariables (hash-keys domains)) (define constraints null) (for ([constraint-variables-pair (in-list _constraints)]) - (match-define (cons constraint variables) constraint-variables-pair) - (when (not variables) + (match-define (list constraint variables) constraint-variables-pair) + (when (null? variables) (set! variables allvariables)) - (set! constraints (append constraints (list (cons constraint variables))))) + (set! constraints (append constraints (list (list constraint variables))))) (define vconstraints (make-hash)) (for ([variable (in-hash-keys domains)]) (hash-set! vconstraints variable null)) (for ([constraint-variables-pair (in-list constraints)]) - (match-define (cons constraint variables) constraint-variables-pair) + (match-define (list constraint variables) constraint-variables-pair) (for ([variable (in-list variables)]) - (hash-update! vconstraints variable (λ(val) (append val (list (cons constraint variables))))))) + (hash-update! vconstraints variable (λ(val) (append val (list (list constraint variables))))))) (for ([constraint-variables-pair (in-list constraints)]) - (match-define (cons constraint variables) constraint-variables-pair) + (match-define (list constraint variables) constraint-variables-pair) (send constraint preProcess variables domains constraints vconstraints)) (define result #f) (let/ec done @@ -257,11 +261,13 @@ (when (= (length variables) 1) (define variable (list-ref variables 0)) (define domain (hash-ref domains variable)) - (for ([value (in-list domain)]) + (for ([value (in-list (get-field _list domain))]) + (when (not (call variables domains (make-hash (list (cons variable value))))) - (set! domain (remove value domain)))) - (set! constraints (remove (cons this variables) constraints)) - (hash-remove! vconstraints variable (cons this variables)))) + (set-field! _list domain (remove value (get-field _list domain))))) + + (set! constraints (remove (list this variables) constraints)) + (hash-update! vconstraints variable (λ(val) (remove (list this variables) val))))) (define/public (forwardCheck variables domains assignments [_unassigned Unassigned]) ;; Helper method for generic forward checking @@ -303,7 +309,7 @@ (field [_func func][_assigned assigned]) (inherit forwardCheck) - (define/override (call variables domains assignments [forwardcheck #f] [_unassigned Unassigned])1 + (define/override (call variables domains assignments [forwardcheck #f] [_unassigned Unassigned]) ;(report assignments assignments-before) (define parms (for/list ([x (in-list variables)]) (if (hash-has-key? assignments x) (hash-ref assignments x) _unassigned))) @@ -325,6 +331,42 @@ )) (define FunctionConstraint? (is-a?/c FunctionConstraint)) +(define AllDifferentConstraint + ;; Constraint enforcing that values of all given variables are different + + (class Constraint + (super-new) + + (define/override (call variables domains assignments [forwardcheck #f] [_unassigned Unassigned]) + (define seen (make-hash)) + (define value #f) + (define domain #f) + (define return-value (void)) + (let/ec return-k + (for ([variable (in-list variables)]) + (set! value (if (hash-has-key? assignments variable) + (hash-ref assignments variable) + _unassigned)) + (when (not (equal? value _unassigned)) + (when (value . in? . seen) + (set! return-value #f) + (return-k)) + (hash-set! seen value #t))) + (when forwardcheck + (for ([variable (in-list variables)]) + (when (not (variable . in? . assignments)) + (set! domain (hash-ref domains variable)) + (for ([value (in-hash-keys seen)]) + (when (value . in? . (get-field _list (hash-ref domains variable))) + (send domain hideValue value) + (when (null? (get-field _list (hash-ref domains variable))) + (set! return-value #f) + (return-k))))))) + (set! return-value #t) + (return-k)) + return-value))) + +(define AllDifferentConstraint? (is-a?/c AllDifferentConstraint)) ;; ---------------------------------------------------------------------- ;; Variables @@ -365,6 +407,9 @@ (field [_forwardcheck forwardcheck]) (define/override (getSolutionIter domains constraints vconstraints) + + + (define forwardcheck _forwardcheck) (define assignments (make-hash)) (define queue null) @@ -458,7 +503,7 @@ (let/ec break-for-loop (for ([cvpair (in-list (hash-ref vconstraints variable))]) - (match-define (cons constraint variables) cvpair) + (match-define (list constraint variables) cvpair) (define the_result (send constraint call variables domains assignments pushdomains)) ;(report pushdomains pushdomains2) ;(report domains domains2) @@ -489,7 +534,7 @@ solution)) (define/override (getSolution . args) - (apply call-solution-generator #:first-only #t args)) + (car (apply call-solution-generator #:first-only #t args))) (define/override (getSolutions . args) (apply call-solution-generator args)) @@ -497,17 +542,6 @@ )) -(module+ main - (define problem (new Problem)) - (send problem addVariables '("a" "b" "c") (range 1 10)) -; (send problem addConstraint (λ(a b) (and (> a 0) (= b (* 211 a)))) '("a" "b")) - - (displayln (format "The solution to ~a is ~a" - problem - (argmin (λ(h) - (let ([a (hash-ref h "a")] - [b (hash-ref h "b")] - [c (hash-ref h "c")]) - (/ (+ (* 100 a) (* 10 b) c) (+ a b c)))) - (send problem getSolutions))))) - \ No newline at end of file + + + diff --git a/csp/helpers.rkt b/csp/helpers.rkt index e845fe10..820cff34 100644 --- a/csp/helpers.rkt +++ b/csp/helpers.rkt @@ -14,6 +14,7 @@ (cond [(equal? x y) (list-comparator (cdr xs) (cdr ys))] [(and (real? x) (real? y)) (< x y)] + [(and (symbol? x) (symbol? y)) (apply stringstring (list x y)))] [(and (string? x) (string? y)) (string 0 and b == 211 * a -problem.addConstraint(func, ["a", "b"]) -print problem.getSolutions() +problem.addVariables(["a", "b"], [1, 2]) +problem.addConstraint(AllDifferentConstraint()) +print problem.getSolutions() \ No newline at end of file diff --git a/csp/python-constraint/trials/queens.py b/csp/python-constraint/trials/queens.py index deac7131..73ec4569 100755 --- a/csp/python-constraint/trials/queens.py +++ b/csp/python-constraint/trials/queens.py @@ -7,7 +7,7 @@ import sys def main(show=False): problem = Problem() - size = 8 + size = 12 cols = range(size) rows = range(size) problem.addVariables(cols, rows) From 9f14c444235f3cb3f6f3f6d4c065240fd4482096 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Thu, 2 Oct 2014 12:32:58 -0700 Subject: [PATCH 032/246] all tests working --- csp/constraint-tests.rkt | 2 ++ 1 file changed, 2 insertions(+) diff --git a/csp/constraint-tests.rkt b/csp/constraint-tests.rkt index f552d0b5..10c415a0 100644 --- a/csp/constraint-tests.rkt +++ b/csp/constraint-tests.rkt @@ -132,6 +132,8 @@ A collection of 33 coins, consisting of nickels, dimes, and quarters, has a valu ;; queens problem +;; place queens on chessboard so they do not intersect + (define qp (new Problem)) (define cols (range 8)) (define rows (range 8)) From dc19ddc1203760a7ba4b09fad9600590194ce516 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Thu, 2 Oct 2014 12:59:24 -0700 Subject: [PATCH 033/246] reorg --- csp/NOTICES | 33 ++ csp/constraint.rkt | 418 +----------------- csp/domain.rkt | 63 +++ csp/{helpers.rkt => helper.rkt} | 0 csp/main.rkt | 11 + csp/problem.rkt | 117 +++++ csp/solver.rkt | 155 +++++++ csp/test-classes.rkt | 16 + ...constraint-tests.rkt => test-problems.rkt} | 2 +- csp/variable.rkt | 17 + 10 files changed, 416 insertions(+), 416 deletions(-) create mode 100644 csp/NOTICES create mode 100644 csp/domain.rkt rename csp/{helpers.rkt => helper.rkt} (100%) create mode 100644 csp/main.rkt create mode 100644 csp/problem.rkt create mode 100644 csp/solver.rkt create mode 100644 csp/test-classes.rkt rename csp/{constraint-tests.rkt => test-problems.rkt} (98%) create mode 100644 csp/variable.rkt diff --git a/csp/NOTICES b/csp/NOTICES new file mode 100644 index 00000000..8d4bcdd4 --- /dev/null +++ b/csp/NOTICES @@ -0,0 +1,33 @@ +This software includes open-source software components that require the following legal notices. + +=============================================================================== + +python-constraint http://labix.org/python-constraint + +=============================================================================== + +Copyright (c) 2005-2014 - Gustavo Niemeyer + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + +1. Redistributions of source code must retain the above copyright notice, this + list of conditions and the following disclaimer. +2. Redistributions in binary form must reproduce the above copyright notice, + this list of conditions and the following disclaimer in the documentation + and/or other materials provided with the distribution. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE +DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE +FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + +=============================================================================== \ No newline at end of file diff --git a/csp/constraint.rkt b/csp/constraint.rkt index d13c06ee..1dfb73c6 100644 --- a/csp/constraint.rkt +++ b/csp/constraint.rkt @@ -1,240 +1,6 @@ #lang racket/base -(require racket/class racket/contract racket/match racket/list racket/generator) -(require sugar/container sugar/debug) -(require "helpers.rkt") -(module+ test (require rackunit)) - -;; Adapted from work by Gustavo Niemeyer -#| -# Copyright (c) 2005-2014 - Gustavo Niemeyer -# -# All rights reserved. -# -# Redistribution and use in source and binary forms, with or without -# modification, are permitted provided that the following conditions are met: -# -# 1. Redistributions of source code must retain the above copyright notice, this -# list of conditions and the following disclaimer. -# 2. Redistributions in binary form must reproduce the above copyright notice, -# this list of conditions and the following disclaimer in the documentation -# and/or other materials provided with the distribution. -# -# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" -# AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE -# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE -# DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE -# FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL -# DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR -# SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER -# CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, -# OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE -# OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -|# - -(provide (all-defined-out) (all-from-out "helpers.rkt")) -;(provide Problem Variable Domain Unassigned Solver BacktrackingSolver RecursiveBacktrackingSolver MinConflictsSolver Constraint FunctionConstraint AllDifferentConstraint AllEqualConstraint MaxSumConstraint ExactSumConstraint MinSumConstraint InSetConstraint NotInSetConstraint SomeInSetConstraint SomeNotInSetConstraint) - -;(define Problem/c (λ(x) (is-a x Problem))) - -(define/contract Problem - ;; Class used to define a problem and retrieve solutions - - (class/c [reset (->m void?)] - ;; todo: tighten `object?` contracts - [setSolver (object? . ->m . void?)] - [getSolver (->m object?)] - ;; todo: tighten `object?` contract - [addVariable (any/c (or/c list? object?) . ->m . void?)] - [getSolutions (->m list?)]) - (class* object% (printable<%>) - (super-new) - - (init-field [solver #f]) - (field [_solver (or solver (new BacktrackingSolver))] - [_constraints null] - [_variables (make-hash)]) - - - (define (repr) (format "" (hash-keys _variables))) - (define/public (custom-print out quoting-depth) (print (repr) out)) - (define/public (custom-display out) (displayln (repr) out)) - (define/public (custom-write out) (write (repr) out)) - - (define/public (reset) - ;; Reset the current problem definition - (set! _constraints null) - (hash-clear! _variables)) - - (define/public (setSolver solver) - ;; Change the problem solver currently in use - (set! _solver solver)) - - (define/public (getSolver) - ;; Obtain the problem solver currently in use - _solver) - - (define/public (addVariable variable domain) - ;; Add a variable to the problem - (when (variable . in? . _variables) - (error 'addVariable (format "Tried to insert duplicated variable ~a" variable))) - (cond - [(list? domain) (set! domain (new Domain [set domain]))] - ;; todo: test for `instance-of-Domain?` ; how to copy domain? - [(object? domain) (set! domain '(copy.copy domain))] - [else (error 'addVariable "Domains must be instances of subclasses of Domain")]) - (when (not (object? domain)) (error 'fudge)) - (when (not domain) ; todo: check this test - (error 'addVariable "Domain is empty")) - (hash-set! _variables variable domain)) - - (define/public (addVariables variables domain) - ;; Add one or more variables to the problem - (define listified-variables - (cond - [(string? variables) (map (λ(c) (format "~a" c)) (string->list variables))] - [else variables])) - (for-each (λ(var) (addVariable var domain)) listified-variables)) - - (define/public (addConstraint constraint [variables null]) - ;; Add a constraint to the problem - - (when (not (Constraint? constraint)) - (if (procedure? constraint) - (set! constraint (new FunctionConstraint [func constraint])) - (error 'addConstraint "Constraints must be instances of class Constraint"))) - (py-append! _constraints (list constraint variables))) - - (define/public (getSolution) - ;; Find and return a solution to the problem - (define-values (domains constraints vconstraints) (_getArgs)) - (if (not domains) - null - (send _solver getSolution domains constraints vconstraints))) - - (define/public (getSolutions) - ;; Find and return all solutions to the problem - (define-values (domains constraints vconstraints) (_getArgs)) - (if (not domains) - null - (send _solver getSolutions domains constraints vconstraints))) - - (define/public (_getArgs) - (define domains (hash-copy _variables)) - (define allvariables (hash-keys domains)) - (define constraints null) - (for ([constraint-variables-pair (in-list _constraints)]) - (match-define (list constraint variables) constraint-variables-pair) - (when (null? variables) - (set! variables allvariables)) - (set! constraints (append constraints (list (list constraint variables))))) - (define vconstraints (make-hash)) - (for ([variable (in-hash-keys domains)]) - (hash-set! vconstraints variable null)) - (for ([constraint-variables-pair (in-list constraints)]) - (match-define (list constraint variables) constraint-variables-pair) - (for ([variable (in-list variables)]) - (hash-update! vconstraints variable (λ(val) (append val (list (list constraint variables))))))) - (for ([constraint-variables-pair (in-list constraints)]) - (match-define (list constraint variables) constraint-variables-pair) - (send constraint preProcess variables domains constraints vconstraints)) - (define result #f) - (let/ec done - (for ([domain (in-list (hash-values domains))]) - (send domain resetState) - (when (not domain) - (set! result (list null null null)) - (done))) - (set! result (list domains constraints vconstraints))) - (apply values result)) - - - )) - -(module+ test - (check-equal? (get-field _solver (new Problem [solver 'solver-in])) 'solver-in) - (check-equal? (get-field _constraints (new Problem)) null) - (check-equal? (get-field _variables (new Problem)) (make-hash)) - - (define problem (new Problem)) ;; test from line 125 - (send problem addVariable "a" '(1)) - (check-equal? (get-field _list (hash-ref (get-field _variables problem) "a")) '(1)) - - (send problem reset) - (check-equal? (get-field _variables problem) (make-hash)) - (send problem addVariables '("a" "b") '(1 2 3)) - (check-equal? (get-field _list (hash-ref (get-field _variables problem) "a")) '(1 2 3)) - (check-equal? (get-field _list (hash-ref (get-field _variables problem) "b")) '(1 2 3))) - - -;; ---------------------------------------------------------------------- -;; Domains -;; ---------------------------------------------------------------------- - -(define Domain - ;; Class used to control possible values for variables - ;; When list or tuples are used as domains, they are automatically - ;; converted to an instance of that class. - - (class* object% (printable<%>) - (super-new) - (init-field set) - (field [_list set][_hidden null][_states null]) - - (define (repr) (format "" _list)) - (define/public (custom-print out quoting-depth) (print (repr) out)) - (define/public (custom-display out) (displayln (repr) out)) - (define/public (custom-write out) (write (repr) out)) - - (define/public (resetState) - ;; Reset to the original domain state, including all possible values - (py-extend! _list _hidden) - (set! _hidden null) - (set! _states null)) - - (define/public (pushState) - ;; Save current domain state - ;; Variables hidden after that call are restored when that state - ;; is popped from the stack. - (py-append! _states (length _list))) - - (define/public (popState) - ;; Restore domain state from the top of the stack - - ;; Variables hidden since the last popped state are then available - ;; again. - (define diff (- (py-pop! _states) (length _list))) - (when (not (= 0 diff)) - (py-extend! _list (take-right _hidden diff)) - (set! _hidden (take _hidden (- (length _hidden) diff))))) - - (define/public (hideValue value) - ;; Hide the given value from the domain - - ;; After that call the given value won't be seen as a possible value - ;; on that domain anymore. The hidden value will be restored when the - ;; previous saved state is popped. - (set! _list (remove value _list)) - (py-append! _hidden value)) - - - (define/public (domain-pop!) - (py-pop! _list)) - - (define/public (copy) - (define copied-domain (new Domain [set _list])) - (set-field! _hidden copied-domain _hidden) - (set-field! _states copied-domain _states) - copied-domain) - - - )) -(define Domain? (is-a?/c Domain)) - - - -;; ---------------------------------------------------------------------- -;; Constraints -;; ---------------------------------------------------------------------- +(require racket/class sugar/container "helper.rkt" "variable.rkt") +(provide (all-defined-out)) (define Constraint (class object% @@ -366,182 +132,4 @@ (return-k)) return-value))) -(define AllDifferentConstraint? (is-a?/c AllDifferentConstraint)) - -;; ---------------------------------------------------------------------- -;; Variables -;; ---------------------------------------------------------------------- - -(define Variable - (class* object% (printable<%>) - (super-new) - (define (repr) (format "" _name)) - (define/public (custom-print out quoting-depth) (print (repr) out)) - (define/public (custom-display out) (displayln (repr) out)) - (define/public (custom-write out) (write (repr) out)) - - (init-field name) - (field [_name name]))) -(define Variable? (is-a?/c Variable)) - -(define Unassigned (new Variable [name "Unassigned"])) - -;; ---------------------------------------------------------------------- -;; Solvers -;; ---------------------------------------------------------------------- - -(define Solver - ;; Abstract base class for solvers - (class object% - (super-new) - (abstract getSolution) - (abstract getSolutions) - (abstract getSolutionIter))) - - -(define BacktrackingSolver - ;; Problem solver with backtracking capabilities - (class Solver - (super-new) - (init-field [forwardcheck #t]) - (field [_forwardcheck forwardcheck]) - - (define/override (getSolutionIter domains constraints vconstraints) - - - - (define forwardcheck _forwardcheck) - (define assignments (make-hash)) - (define queue null) - (define values null) - (define pushdomains null) - (define variable #f) - (define lst null) - (define want-to-return #f) - (define return-k #f) - (let/ec break-loop1 - (set! return-k break-loop1) - (let loop1 () - ;(displayln "starting while loop 1") - - - ;; Mix the Degree and Minimum Remaing Values (MRV) heuristics - (set! lst (sort (for/list ([variable (in-hash-keys domains)]) - (list (* -1 (length (hash-ref vconstraints variable))) - (length (get-field _list (hash-ref domains variable))) - variable)) list-comparator)) - ;(report lst) - (let/ec break-for-loop - (for ([item (in-list lst)]) - (when (not ((last item) . in? . assignments)) - - ; Found unassigned variable - (set! variable (last item)) - ;(report variable unassigned-variable) - (set! values (send (hash-ref domains variable) copy)) - (set! pushdomains - (if forwardcheck - (for/list ([x (in-hash-keys domains)] - #:when (and (not (x . in? . assignments)) - (not (x . equal? . variable)))) - (hash-ref domains x)) - null)) - (break-for-loop))) - - ;; if it makes it through the loop without breaking, then there are - ;; No unassigned variables. We've got a solution. Go back - ;; to last variable, if there's one. - (yield (hash-copy assignments)) - (when (null? queue) (begin - (set! want-to-return #t) - (return-k))) - (define variable-values-pushdomains (py-pop! queue)) - (set! variable (first variable-values-pushdomains)) - (set-field! _list values (second variable-values-pushdomains)) - (set! pushdomains (third variable-values-pushdomains)) - (for ([domain (in-list pushdomains)]) - (send domain popState))) - - ;(report variable variable-preloop-2) - ;(report assignments assignments-preloop-2) - - (let/ec break-loop2 - (let loop2 () - ;(displayln "starting while loop 2") - - ;; We have a variable. Do we have any values left? - ;(report values values-tested) - (when (null? (get-field _list values)) - - ;; No. Go back to last variable, if there's one. - (hash-remove! assignments variable) - (let/ec break-loop3 - (let loop3 () - (if (not (null? queue)) - (let () - (define variable-values-pushdomains (py-pop! queue)) - (set! variable (first variable-values-pushdomains)) - (set-field! _list values (second variable-values-pushdomains)) - (set! pushdomains (third variable-values-pushdomains)) - (when (not (null? pushdomains)) - (for ([domain (in-list pushdomains)]) - (send domain popState))) - (when (not (null? (get-field _list values))) (break-loop3)) - (hash-remove! assignments variable) - (loop3)) - (begin - (set! want-to-return #t) - (return-k)))))) - - ;; Got a value. Check it. - (hash-set! assignments variable (send values domain-pop!)) - - (for ([domain (in-list pushdomains)]) - (send domain pushState)) - ;(report pushdomains pushdomains1) - ;(report domains domains1) - - (let/ec break-for-loop - (for ([cvpair (in-list (hash-ref vconstraints variable))]) - (match-define (list constraint variables) cvpair) - (define the_result (send constraint call variables domains assignments pushdomains)) - ;(report pushdomains pushdomains2) - ;(report domains domains2) - ;(report the_result) - (when (not the_result) - ;; Value is not good. - (break-for-loop))) - (begin ;(displayln "now breaking loop 2") - (break-loop2))) - - (for ([domain (in-list pushdomains)]) - (send domain popState)) - - (loop2))) - - ;; Push state before looking for next variable. - (py-append! queue (list variable (get-field _list (send values copy)) pushdomains)) - ;(report queue new-queue) - (loop1))) - - (if want-to-return - (void) - (error 'getSolutionIter "Whoops, broken solver"))) - - - (define (call-solution-generator domains constraints vconstraints #:first-only [first-only #f]) - (for/list ([solution (in-generator (getSolutionIter domains constraints vconstraints))] #:final first-only) - solution)) - - (define/override (getSolution . args) - (car (apply call-solution-generator #:first-only #t args))) - - (define/override (getSolutions . args) - (apply call-solution-generator args)) - - )) - - - - - +(define AllDifferentConstraint? (is-a?/c AllDifferentConstraint)) \ No newline at end of file diff --git a/csp/domain.rkt b/csp/domain.rkt new file mode 100644 index 00000000..39a66bfa --- /dev/null +++ b/csp/domain.rkt @@ -0,0 +1,63 @@ +#lang racket/base +(require racket/class racket/list "helper.rkt") +(provide (all-defined-out)) + +(define Domain + ;; Class used to control possible values for variables + ;; When list or tuples are used as domains, they are automatically + ;; converted to an instance of that class. + + (class* object% (printable<%>) + (super-new) + (init-field set) + (field [_list set][_hidden null][_states null]) + + (define (repr) (format "" _list)) + (define/public (custom-print out quoting-depth) (print (repr) out)) + (define/public (custom-display out) (displayln (repr) out)) + (define/public (custom-write out) (write (repr) out)) + + (define/public (resetState) + ;; Reset to the original domain state, including all possible values + (py-extend! _list _hidden) + (set! _hidden null) + (set! _states null)) + + (define/public (pushState) + ;; Save current domain state + ;; Variables hidden after that call are restored when that state + ;; is popped from the stack. + (py-append! _states (length _list))) + + (define/public (popState) + ;; Restore domain state from the top of the stack + + ;; Variables hidden since the last popped state are then available + ;; again. + (define diff (- (py-pop! _states) (length _list))) + (when (not (= 0 diff)) + (py-extend! _list (take-right _hidden diff)) + (set! _hidden (take _hidden (- (length _hidden) diff))))) + + (define/public (hideValue value) + ;; Hide the given value from the domain + + ;; After that call the given value won't be seen as a possible value + ;; on that domain anymore. The hidden value will be restored when the + ;; previous saved state is popped. + (set! _list (remove value _list)) + (py-append! _hidden value)) + + + (define/public (domain-pop!) + (py-pop! _list)) + + (define/public (copy) + (define copied-domain (new Domain [set _list])) + (set-field! _hidden copied-domain _hidden) + (set-field! _states copied-domain _states) + copied-domain) + + + )) +(define Domain? (is-a?/c Domain)) \ No newline at end of file diff --git a/csp/helpers.rkt b/csp/helper.rkt similarity index 100% rename from csp/helpers.rkt rename to csp/helper.rkt diff --git a/csp/main.rkt b/csp/main.rkt new file mode 100644 index 00000000..0e1f6385 --- /dev/null +++ b/csp/main.rkt @@ -0,0 +1,11 @@ +#lang racket/base +(require + "problem.rkt" + "constraint.rkt" + "helper.rkt") + +(provide (all-from-out + "problem.rkt" + "constraint.rkt" + "helper.rkt")) + diff --git a/csp/problem.rkt b/csp/problem.rkt new file mode 100644 index 00000000..373bf28e --- /dev/null +++ b/csp/problem.rkt @@ -0,0 +1,117 @@ +#lang racket/base +(require racket/class sugar/container racket/contract racket/match "domain.rkt" "helper.rkt" "constraint.rkt" "solver.rkt") +(provide (all-defined-out)) + +(define/contract Problem + ;; Class used to define a problem and retrieve solutions + + (class/c [reset (->m void?)] + ;; todo: tighten `object?` contracts + [setSolver (Solver? . ->m . void?)] + [getSolver (->m Solver?)] + ;; todo: tighten `object?` contract + [addVariable (any/c (or/c list? object?) . ->m . void?)] + [getSolutions (->m list?)]) + (class* object% (printable<%>) + (super-new) + + (init-field [solver #f]) + (field [_solver (or solver (new BacktrackingSolver))] + [_constraints null] + [_variables (make-hash)]) + + + (define (repr) (format "" (hash-keys _variables))) + (define/public (custom-print out quoting-depth) (print (repr) out)) + (define/public (custom-display out) (displayln (repr) out)) + (define/public (custom-write out) (write (repr) out)) + + (define/public (reset) + ;; Reset the current problem definition + (set! _constraints null) + (hash-clear! _variables)) + + (define/public (setSolver solver) + ;; Change the problem solver currently in use + (set! _solver solver)) + + (define/public (getSolver) + ;; Obtain the problem solver currently in use + _solver) + + (define/public (addVariable variable domain) + ;; Add a variable to the problem + (when (variable . in? . _variables) + (error 'addVariable (format "Tried to insert duplicated variable ~a" variable))) + (cond + [(list? domain) (set! domain (new Domain [set domain]))] + ;; todo: test for `instance-of-Domain?` ; how to copy domain? + [(object? domain) (set! domain '(copy.copy domain))] + [else (error 'addVariable "Domains must be instances of subclasses of Domain")]) + (when (not (object? domain)) (error 'fudge)) + (when (not domain) ; todo: check this test + (error 'addVariable "Domain is empty")) + (hash-set! _variables variable domain)) + + (define/public (addVariables variables domain) + ;; Add one or more variables to the problem + (define listified-variables + (cond + [(string? variables) (map (λ(c) (format "~a" c)) (string->list variables))] + [else variables])) + (for-each (λ(var) (addVariable var domain)) listified-variables)) + + (define/public (addConstraint constraint [variables null]) + ;; Add a constraint to the problem + + (when (not (Constraint? constraint)) + (if (procedure? constraint) + (set! constraint (new FunctionConstraint [func constraint])) + (error 'addConstraint "Constraints must be instances of class Constraint"))) + (py-append! _constraints (list constraint variables))) + + (define/public (getSolution) + ;; Find and return a solution to the problem + (define-values (domains constraints vconstraints) (_getArgs)) + (if (not domains) + null + (send _solver getSolution domains constraints vconstraints))) + + (define/public (getSolutions) + ;; Find and return all solutions to the problem + (define-values (domains constraints vconstraints) (_getArgs)) + (if (not domains) + null + (send _solver getSolutions domains constraints vconstraints))) + + (define/public (_getArgs) + (define domains (hash-copy _variables)) + (define allvariables (hash-keys domains)) + (define constraints null) + (for ([constraint-variables-pair (in-list _constraints)]) + (match-define (list constraint variables) constraint-variables-pair) + (when (null? variables) + (set! variables allvariables)) + (set! constraints (append constraints (list (list constraint variables))))) + (define vconstraints (make-hash)) + (for ([variable (in-hash-keys domains)]) + (hash-set! vconstraints variable null)) + (for ([constraint-variables-pair (in-list constraints)]) + (match-define (list constraint variables) constraint-variables-pair) + (for ([variable (in-list variables)]) + (hash-update! vconstraints variable (λ(val) (append val (list (list constraint variables))))))) + (for ([constraint-variables-pair (in-list constraints)]) + (match-define (list constraint variables) constraint-variables-pair) + (send constraint preProcess variables domains constraints vconstraints)) + (define result #f) + (let/ec done + (for ([domain (in-list (hash-values domains))]) + (send domain resetState) + (when (not domain) + (set! result (list null null null)) + (done))) + (set! result (list domains constraints vconstraints))) + (apply values result)) + + + )) \ No newline at end of file diff --git a/csp/solver.rkt b/csp/solver.rkt new file mode 100644 index 00000000..2223859b --- /dev/null +++ b/csp/solver.rkt @@ -0,0 +1,155 @@ +#lang racket/base +(require racket/class sugar/container racket/list racket/generator racket/match "helper.rkt") +(provide (all-defined-out)) + +(define Solver + ;; Abstract base class for solvers + (class object% + (super-new) + (abstract getSolution) + (abstract getSolutions) + (abstract getSolutionIter))) + +(define Solver? (is-a?/c Solver)) + +(define BacktrackingSolver + ;; Problem solver with backtracking capabilities + (class Solver + (super-new) + (init-field [forwardcheck #t]) + (field [_forwardcheck forwardcheck]) + + (define/override (getSolutionIter domains constraints vconstraints) + + + + (define forwardcheck _forwardcheck) + (define assignments (make-hash)) + (define queue null) + (define values null) + (define pushdomains null) + (define variable #f) + (define lst null) + (define want-to-return #f) + (define return-k #f) + (let/ec break-loop1 + (set! return-k break-loop1) + (let loop1 () + ;(displayln "starting while loop 1") + + + ;; Mix the Degree and Minimum Remaing Values (MRV) heuristics + (set! lst (sort (for/list ([variable (in-hash-keys domains)]) + (list (* -1 (length (hash-ref vconstraints variable))) + (length (get-field _list (hash-ref domains variable))) + variable)) list-comparator)) + ;(report lst) + (let/ec break-for-loop + (for ([item (in-list lst)]) + (when (not ((last item) . in? . assignments)) + + ; Found unassigned variable + (set! variable (last item)) + ;(report variable unassigned-variable) + (set! values (send (hash-ref domains variable) copy)) + (set! pushdomains + (if forwardcheck + (for/list ([x (in-hash-keys domains)] + #:when (and (not (x . in? . assignments)) + (not (x . equal? . variable)))) + (hash-ref domains x)) + null)) + (break-for-loop))) + + ;; if it makes it through the loop without breaking, then there are + ;; No unassigned variables. We've got a solution. Go back + ;; to last variable, if there's one. + (yield (hash-copy assignments)) + (when (null? queue) (begin + (set! want-to-return #t) + (return-k))) + (define variable-values-pushdomains (py-pop! queue)) + (set! variable (first variable-values-pushdomains)) + (set-field! _list values (second variable-values-pushdomains)) + (set! pushdomains (third variable-values-pushdomains)) + (for ([domain (in-list pushdomains)]) + (send domain popState))) + + ;(report variable variable-preloop-2) + ;(report assignments assignments-preloop-2) + + (let/ec break-loop2 + (let loop2 () + ;(displayln "starting while loop 2") + + ;; We have a variable. Do we have any values left? + ;(report values values-tested) + (when (null? (get-field _list values)) + + ;; No. Go back to last variable, if there's one. + (hash-remove! assignments variable) + (let/ec break-loop3 + (let loop3 () + (if (not (null? queue)) + (let () + (define variable-values-pushdomains (py-pop! queue)) + (set! variable (first variable-values-pushdomains)) + (set-field! _list values (second variable-values-pushdomains)) + (set! pushdomains (third variable-values-pushdomains)) + (when (not (null? pushdomains)) + (for ([domain (in-list pushdomains)]) + (send domain popState))) + (when (not (null? (get-field _list values))) (break-loop3)) + (hash-remove! assignments variable) + (loop3)) + (begin + (set! want-to-return #t) + (return-k)))))) + + ;; Got a value. Check it. + (hash-set! assignments variable (send values domain-pop!)) + + (for ([domain (in-list pushdomains)]) + (send domain pushState)) + ;(report pushdomains pushdomains1) + ;(report domains domains1) + + (let/ec break-for-loop + (for ([cvpair (in-list (hash-ref vconstraints variable))]) + (match-define (list constraint variables) cvpair) + (define the_result (send constraint call variables domains assignments pushdomains)) + ;(report pushdomains pushdomains2) + ;(report domains domains2) + ;(report the_result) + (when (not the_result) + ;; Value is not good. + (break-for-loop))) + (begin ;(displayln "now breaking loop 2") + (break-loop2))) + + (for ([domain (in-list pushdomains)]) + (send domain popState)) + + (loop2))) + + ;; Push state before looking for next variable. + (py-append! queue (list variable (get-field _list (send values copy)) pushdomains)) + ;(report queue new-queue) + (loop1))) + + (if want-to-return + (void) + (error 'getSolutionIter "Whoops, broken solver"))) + + + (define (call-solution-generator domains constraints vconstraints #:first-only [first-only #f]) + (for/list ([solution (in-generator (getSolutionIter domains constraints vconstraints))] #:final first-only) + solution)) + + (define/override (getSolution . args) + (car (apply call-solution-generator #:first-only #t args))) + + (define/override (getSolutions . args) + (apply call-solution-generator args)) + + )) diff --git a/csp/test-classes.rkt b/csp/test-classes.rkt new file mode 100644 index 00000000..a940df43 --- /dev/null +++ b/csp/test-classes.rkt @@ -0,0 +1,16 @@ +#lang racket +(require rackunit "main.rkt") + +(check-equal? (get-field _solver (new Problem [solver 'solver-in])) 'solver-in) +(check-equal? (get-field _constraints (new Problem)) null) +(check-equal? (get-field _variables (new Problem)) (make-hash)) + +(define problem (new Problem)) ;; test from line 125 +(send problem addVariable "a" '(1)) +(check-equal? (get-field _list (hash-ref (get-field _variables problem) "a")) '(1)) + +(send problem reset) +(check-equal? (get-field _variables problem) (make-hash)) +(send problem addVariables '("a" "b") '(1 2 3)) +(check-equal? (get-field _list (hash-ref (get-field _variables problem) "a")) '(1 2 3)) +(check-equal? (get-field _list (hash-ref (get-field _variables problem) "b")) '(1 2 3)) \ No newline at end of file diff --git a/csp/constraint-tests.rkt b/csp/test-problems.rkt similarity index 98% rename from csp/constraint-tests.rkt rename to csp/test-problems.rkt index 10c415a0..c2b85cf0 100644 --- a/csp/constraint-tests.rkt +++ b/csp/test-problems.rkt @@ -1,5 +1,5 @@ #lang racket -(require "constraint.rkt") +(require "main.rkt") (require rackunit) (define-simple-check (check-hash-items h1 h2) diff --git a/csp/variable.rkt b/csp/variable.rkt new file mode 100644 index 00000000..3c7213f1 --- /dev/null +++ b/csp/variable.rkt @@ -0,0 +1,17 @@ +#lang racket/base +(require racket/class "helper.rkt") +(provide (all-defined-out)) + +(define Variable + (class* object% (printable<%>) + (super-new) + (define (repr) (format "" _name)) + (define/public (custom-print out quoting-depth) (print (repr) out)) + (define/public (custom-display out) (displayln (repr) out)) + (define/public (custom-write out) (write (repr) out)) + + (init-field name) + (field [_name name]))) +(define Variable? (is-a?/c Variable)) + +(define Unassigned (new Variable [name "Unassigned"])) \ No newline at end of file From ecce81a6a8c3e647ee86e6e4afc7f68574582bba Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Thu, 2 Oct 2014 13:48:12 -0700 Subject: [PATCH 034/246] progress --- csp/constraint.rkt | 41 ++++++++++++++++++++++++++++++++++++++++- csp/domain.rkt | 3 ++- csp/helper.rkt | 5 ++++- csp/problem.rkt | 6 ++---- csp/test-classes.rkt | 32 +++++++++++++++++++++++++++++++- csp/test-problems.rkt | 3 --- 6 files changed, 79 insertions(+), 11 deletions(-) diff --git a/csp/constraint.rkt b/csp/constraint.rkt index 1dfb73c6..1f072654 100644 --- a/csp/constraint.rkt +++ b/csp/constraint.rkt @@ -2,6 +2,7 @@ (require racket/class sugar/container "helper.rkt" "variable.rkt") (provide (all-defined-out)) + (define Constraint (class object% (super-new) @@ -132,4 +133,42 @@ (return-k)) return-value))) -(define AllDifferentConstraint? (is-a?/c AllDifferentConstraint)) \ No newline at end of file +(define AllDifferentConstraint? (is-a?/c AllDifferentConstraint)) + + +(define AllEqualConstraint + ;; Constraint enforcing that values of all given variables are different + + (class Constraint + (super-new) + + (define/override (call variables domains assignments [forwardcheck #f] [_unassigned Unassigned]) + (define singlevalue _unassigned) + (define value #f) + (define domain #f) + (define return-value (void)) + (let/ec return-k + (for ([variable (in-list variables)]) + (set! value (if (hash-has-key? assignments variable) + (hash-ref assignments variable) + _unassigned)) + (cond + [(equal? singlevalue _unassigned) (set! singlevalue value)] + [(and (not (equal? value _unassigned)) (not (equal? value singlevalue))) + (set! return-value #f) + (return-k)])) + (when (and forwardcheck (not (equal? singlevalue _unassigned))) + (for ([variable (in-list variables)]) + (when (not (variable . in? . assignments)) + (set! domain (hash-ref domains variable)) + (when (not (singlevalue . in? . (get-field _list domain))) + (set! return-value #f) + (return-k)) + (for ([value (in-list (get-field _list domain))]) + (when (not (equal? value singlevalue)) + (send domain hideValue value)))))) + (set! return-value #t) + (return-k)) + return-value))) + +(define AllEqualConstraint? (is-a?/c AllEqualConstraint)) diff --git a/csp/domain.rkt b/csp/domain.rkt index 39a66bfa..6ba0b1f0 100644 --- a/csp/domain.rkt +++ b/csp/domain.rkt @@ -60,4 +60,5 @@ )) -(define Domain? (is-a?/c Domain)) \ No newline at end of file +(define Domain? (is-a?/c Domain)) + diff --git a/csp/helper.rkt b/csp/helper.rkt index 820cff34..ffb993ce 100644 --- a/csp/helper.rkt +++ b/csp/helper.rkt @@ -1,8 +1,11 @@ #lang racket/base (require racket/list) (provide (all-defined-out)) +(require rackunit) -(module+ test (require rackunit)) +(define-simple-check (check-hash-items h1 h2) + (for/and ([(k1 v1) (in-hash h1)]) + (equal? (hash-ref h2 k1) v1))) (define (list-comparator xs ys) ;; For use in sort. Compares two lists element by element. diff --git a/csp/problem.rkt b/csp/problem.rkt index 373bf28e..8b8de27a 100644 --- a/csp/problem.rkt +++ b/csp/problem.rkt @@ -6,11 +6,10 @@ ;; Class used to define a problem and retrieve solutions (class/c [reset (->m void?)] - ;; todo: tighten `object?` contracts [setSolver (Solver? . ->m . void?)] [getSolver (->m Solver?)] ;; todo: tighten `object?` contract - [addVariable (any/c (or/c list? object?) . ->m . void?)] + [addVariable (any/c (or/c list? Domain?) . ->m . void?)] [getSolutions (->m list?)]) (class* object% (printable<%>) (super-new) @@ -45,8 +44,7 @@ (error 'addVariable (format "Tried to insert duplicated variable ~a" variable))) (cond [(list? domain) (set! domain (new Domain [set domain]))] - ;; todo: test for `instance-of-Domain?` ; how to copy domain? - [(object? domain) (set! domain '(copy.copy domain))] + [(Domain? domain) (set! domain (send domain copy))] [else (error 'addVariable "Domains must be instances of subclasses of Domain")]) (when (not (object? domain)) (error 'fudge)) (when (not domain) ; todo: check this test diff --git a/csp/test-classes.rkt b/csp/test-classes.rkt index a940df43..086f2bdc 100644 --- a/csp/test-classes.rkt +++ b/csp/test-classes.rkt @@ -13,4 +13,34 @@ (check-equal? (get-field _variables problem) (make-hash)) (send problem addVariables '("a" "b") '(1 2 3)) (check-equal? (get-field _list (hash-ref (get-field _variables problem) "a")) '(1 2 3)) -(check-equal? (get-field _list (hash-ref (get-field _variables problem) "b")) '(1 2 3)) \ No newline at end of file +(check-equal? (get-field _list (hash-ref (get-field _variables problem) "b")) '(1 2 3)) + + +;; FunctionConstraint, two ways: implicit and explicit +(send problem reset) +(send problem addVariables '(a b) '(1 2)) +(send problem addConstraint >) ; implicit +(check-hash-items (send problem getSolution) #hash((a . 1) (b . 2))) +(send problem reset) +(send problem addVariables '(a b) '(1 2)) +(send problem addConstraint (new FunctionConstraint [func >])) ; explicit +(check-hash-items (send problem getSolution) #hash((a . 1) (b . 2))) + +;; AllDifferentConstraint +(send problem reset) +(send problem addVariables '(a b) '(1 2)) +(send problem addConstraint (new AllDifferentConstraint)) +(let ([solutions (send problem getSolutions)]) + (check-equal? (hash-ref (first solutions) 'a) (hash-ref (second solutions) 'b)) + (check-equal? (hash-ref (second solutions) 'a) (hash-ref (first solutions) 'b))) + + +;; AllEqualConstraint +(send problem reset) +(send problem addVariables '(a b) '(1 2)) +(send problem addConstraint (new AllEqualConstraint)) +(let ([solutions (send problem getSolutions)]) + (check-equal? (hash-ref (first solutions) 'a) (hash-ref (first solutions) 'b)) + (check-equal? (hash-ref (second solutions) 'a) (hash-ref (second solutions) 'b))) + + diff --git a/csp/test-problems.rkt b/csp/test-problems.rkt index c2b85cf0..976b9d93 100644 --- a/csp/test-problems.rkt +++ b/csp/test-problems.rkt @@ -2,9 +2,6 @@ (require "main.rkt") (require rackunit) -(define-simple-check (check-hash-items h1 h2) - (for/and ([(k1 v1) (in-hash h1)]) - (equal? (hash-ref h2 k1) v1))) ;; ABC problem: ;; what is the minimum value of From 066645b63e64eebc6f9caa5d2f603caf5c3c5001 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Thu, 2 Oct 2014 13:51:00 -0700 Subject: [PATCH 035/246] dump the chump --- csp/aima/agents.py | 533 ----------------------- csp/aima/csp.py | 451 -------------------- csp/aima/csp.txt | 8 - csp/aima/doctests.py | 43 -- csp/aima/doctests.txt | 21 - csp/aima/games.py | 286 ------------- csp/aima/learning.py | 586 -------------------------- csp/aima/logic.py | 888 --------------------------------------- csp/aima/logic.txt | 78 ---- csp/aima/mdp.py | 142 ------- csp/aima/mdp.txt | 27 -- csp/aima/nlp.py | 170 -------- csp/aima/nlp.txt | 23 - csp/aima/planning.py | 7 - csp/aima/probability.py | 171 -------- csp/aima/probability.txt | 32 -- csp/aima/rl.py | 15 - csp/aima/search.py | 736 -------------------------------- csp/aima/search.txt | 68 --- csp/aima/text.py | 365 ---------------- csp/aima/text.txt | 122 ------ csp/aima/utils.py | 714 ------------------------------- csp/aima/utils.txt | 169 -------- 23 files changed, 5655 deletions(-) delete mode 100644 csp/aima/agents.py delete mode 100644 csp/aima/csp.py delete mode 100644 csp/aima/csp.txt delete mode 100644 csp/aima/doctests.py delete mode 100644 csp/aima/doctests.txt delete mode 100644 csp/aima/games.py delete mode 100644 csp/aima/learning.py delete mode 100644 csp/aima/logic.py delete mode 100644 csp/aima/logic.txt delete mode 100644 csp/aima/mdp.py delete mode 100644 csp/aima/mdp.txt delete mode 100644 csp/aima/nlp.py delete mode 100644 csp/aima/nlp.txt delete mode 100644 csp/aima/planning.py delete mode 100644 csp/aima/probability.py delete mode 100644 csp/aima/probability.txt delete mode 100644 csp/aima/rl.py delete mode 100644 csp/aima/search.py delete mode 100644 csp/aima/search.txt delete mode 100644 csp/aima/text.py delete mode 100644 csp/aima/text.txt delete mode 100644 csp/aima/utils.py delete mode 100644 csp/aima/utils.txt diff --git a/csp/aima/agents.py b/csp/aima/agents.py deleted file mode 100644 index 8ed3fa1f..00000000 --- a/csp/aima/agents.py +++ /dev/null @@ -1,533 +0,0 @@ -"""Implement Agents and Environments (Chapters 1-2). - -The class hierarchies are as follows: - -Object ## A physical object that can exist in an environment - Agent - Wumpus - RandomAgent - ReflexVacuumAgent - ... - Dirt - Wall - ... - -Environment ## An environment holds objects, runs simulations - XYEnvironment - VacuumEnvironment - WumpusEnvironment - -EnvFrame ## A graphical representation of the Environment - -""" - -from utils import * -import random, copy - -#______________________________________________________________________________ - -class Object: - """This represents any physical object that can appear in an Environment. - You subclass Object to get the objects you want. Each object can have a - .__name__ slot (used for output only).""" - def __repr__(self): - return '<%s>' % getattr(self, '__name__', self.__class__.__name__) - - def is_alive(self): - """Objects that are 'alive' should return true.""" - return hasattr(self, 'alive') and self.alive - - def display(self, canvas, x, y, width, height): - """Display an image of this Object on the canvas.""" - pass - -class Agent(Object): - """An Agent is a subclass of Object with one required slot, - .program, which should hold a function that takes one argument, the - percept, and returns an action. (What counts as a percept or action - will depend on the specific environment in which the agent exists.) - Note that 'program' is a slot, not a method. If it were a method, - then the program could 'cheat' and look at aspects of the agent. - It's not supposed to do that: the program can only look at the - percepts. An agent program that needs a model of the world (and of - the agent itself) will have to build and maintain its own model. - There is an optional slots, .performance, which is a number giving - the performance measure of the agent in its environment.""" - - def __init__(self): - def program(percept): - return raw_input('Percept=%s; action? ' % percept) - self.program = program - self.alive = True - -def TraceAgent(agent): - """Wrap the agent's program to print its input and output. This will let - you see what the agent is doing in the environment.""" - old_program = agent.program - def new_program(percept): - action = old_program(percept) - print '%s perceives %s and does %s' % (agent, percept, action) - return action - agent.program = new_program - return agent - -#______________________________________________________________________________ - -class TableDrivenAgent(Agent): - """This agent selects an action based on the percept sequence. - It is practical only for tiny domains. - To customize it you provide a table to the constructor. [Fig. 2.7]""" - - def __init__(self, table): - "Supply as table a dictionary of all {percept_sequence:action} pairs." - ## The agent program could in principle be a function, but because - ## it needs to store state, we make it a callable instance of a class. - Agent.__init__(self) - percepts = [] - def program(percept): - percepts.append(percept) - action = table.get(tuple(percepts)) - return action - self.program = program - - -class RandomAgent(Agent): - "An agent that chooses an action at random, ignoring all percepts." - def __init__(self, actions): - Agent.__init__(self) - self.program = lambda percept: random.choice(actions) - - -#______________________________________________________________________________ - -loc_A, loc_B = (0, 0), (1, 0) # The two locations for the Vacuum world - -class ReflexVacuumAgent(Agent): - "A reflex agent for the two-state vacuum environment. [Fig. 2.8]" - - def __init__(self): - Agent.__init__(self) - def program((location, status)): - if status == 'Dirty': return 'Suck' - elif location == loc_A: return 'Right' - elif location == loc_B: return 'Left' - self.program = program - - -def RandomVacuumAgent(): - "Randomly choose one of the actions from the vaccum environment." - return RandomAgent(['Right', 'Left', 'Suck', 'NoOp']) - - -def TableDrivenVacuumAgent(): - "[Fig. 2.3]" - table = {((loc_A, 'Clean'),): 'Right', - ((loc_A, 'Dirty'),): 'Suck', - ((loc_B, 'Clean'),): 'Left', - ((loc_B, 'Dirty'),): 'Suck', - ((loc_A, 'Clean'), (loc_A, 'Clean')): 'Right', - ((loc_A, 'Clean'), (loc_A, 'Dirty')): 'Suck', - # ... - ((loc_A, 'Clean'), (loc_A, 'Clean'), (loc_A, 'Clean')): 'Right', - ((loc_A, 'Clean'), (loc_A, 'Clean'), (loc_A, 'Dirty')): 'Suck', - # ... - } - return TableDrivenAgent(table) - - -class ModelBasedVacuumAgent(Agent): - "An agent that keeps track of what locations are clean or dirty." - def __init__(self): - Agent.__init__(self) - model = {loc_A: None, loc_B: None} - def program((location, status)): - "Same as ReflexVacuumAgent, except if everything is clean, do NoOp" - model[location] = status ## Update the model here - if model[loc_A] == model[loc_B] == 'Clean': return 'NoOp' - elif status == 'Dirty': return 'Suck' - elif location == loc_A: return 'Right' - elif location == loc_B: return 'Left' - self.program = program - -#______________________________________________________________________________ - -class Environment: - """Abstract class representing an Environment. 'Real' Environment classes - inherit from this. Your Environment will typically need to implement: - percept: Define the percept that an agent sees. - execute_action: Define the effects of executing an action. - Also update the agent.performance slot. - The environment keeps a list of .objects and .agents (which is a subset - of .objects). Each agent has a .performance slot, initialized to 0. - Each object has a .location slot, even though some environments may not - need this.""" - - def __init__(self,): - self.objects = []; self.agents = [] - - object_classes = [] ## List of classes that can go into environment - - def percept(self, agent): - "Return the percept that the agent sees at this point. Override this." - abstract - - def execute_action(self, agent, action): - "Change the world to reflect this action. Override this." - abstract - - def default_location(self, object): - "Default location to place a new object with unspecified location." - return None - - def exogenous_change(self): - "If there is spontaneous change in the world, override this." - pass - - def is_done(self): - "By default, we're done when we can't find a live agent." - for agent in self.agents: - if agent.is_alive(): return False - return True - - def step(self): - """Run the environment for one time step. If the - actions and exogenous changes are independent, this method will - do. If there are interactions between them, you'll need to - override this method.""" - if not self.is_done(): - actions = [agent.program(self.percept(agent)) - for agent in self.agents] - for (agent, action) in zip(self.agents, actions): - self.execute_action(agent, action) - self.exogenous_change() - - def run(self, steps=1000): - """Run the Environment for given number of time steps.""" - for step in range(steps): - if self.is_done(): return - self.step() - - def add_object(self, object, location=None): - """Add an object to the environment, setting its location. Also keep - track of objects that are agents. Shouldn't need to override this.""" - object.location = location or self.default_location(object) - self.objects.append(object) - if isinstance(object, Agent): - object.performance = 0 - self.agents.append(object) - return self - - -class XYEnvironment(Environment): - """This class is for environments on a 2D plane, with locations - labelled by (x, y) points, either discrete or continuous. Agents - perceive objects within a radius. Each agent in the environment - has a .location slot which should be a location such as (0, 1), - and a .holding slot, which should be a list of objects that are - held """ - - def __init__(self, width=10, height=10): - update(self, objects=[], agents=[], width=width, height=height) - - def objects_at(self, location): - "Return all objects exactly at a given location." - return [obj for obj in self.objects if obj.location == location] - - def objects_near(self, location, radius): - "Return all objects within radius of location." - radius2 = radius * radius - return [obj for obj in self.objects - if distance2(location, obj.location) <= radius2] - - def percept(self, agent): - "By default, agent perceives objects within radius r." - return [self.object_percept(obj, agent) - for obj in self.objects_near(agent)] - - def execute_action(self, agent, action): - if action == 'TurnRight': - agent.heading = turn_heading(agent.heading, -1) - elif action == 'TurnLeft': - agent.heading = turn_heading(agent.heading, +1) - elif action == 'Forward': - self.move_to(agent, vector_add(agent.heading, agent.location)) - elif action == 'Grab': - objs = [obj for obj in self.objects_at(agent.location) - if obj.is_grabable(agent)] - if objs: - agent.holding.append(objs[0]) - elif action == 'Release': - if agent.holding: - agent.holding.pop() - agent.bump = False - - def object_percept(self, obj, agent): #??? Should go to object? - "Return the percept for this object." - return obj.__class__.__name__ - - def default_location(self, object): - return (random.choice(self.width), random.choice(self.height)) - - def move_to(object, destination): - "Move an object to a new location." - - def add_object(self, object, location=(1, 1)): - Environment.add_object(self, object, location) - object.holding = [] - object.held = None - self.objects.append(object) - - def add_walls(self): - "Put walls around the entire perimeter of the grid." - for x in range(self.width): - self.add_object(Wall(), (x, 0)) - self.add_object(Wall(), (x, self.height-1)) - for y in range(self.height): - self.add_object(Wall(), (0, y)) - self.add_object(Wall(), (self.width-1, y)) - -def turn_heading(self, heading, inc, - headings=[(1, 0), (0, 1), (-1, 0), (0, -1)]): - "Return the heading to the left (inc=+1) or right (inc=-1) in headings." - return headings[(headings.index(heading) + inc) % len(headings)] - -#______________________________________________________________________________ -## Vacuum environment - -class TrivialVacuumEnvironment(Environment): - """This environment has two locations, A and B. Each can be Dirty or Clean. - The agent perceives its location and the location's status. This serves as - an example of how to implement a simple Environment.""" - - def __init__(self): - Environment.__init__(self) - self.status = {loc_A:random.choice(['Clean', 'Dirty']), - loc_B:random.choice(['Clean', 'Dirty'])} - - def percept(self, agent): - "Returns the agent's location, and the location status (Dirty/Clean)." - return (agent.location, self.status[agent.location]) - - def execute_action(self, agent, action): - """Change agent's location and/or location's status; track performance. - Score 10 for each dirt cleaned; -1 for each move.""" - if action == 'Right': - agent.location = loc_B - agent.performance -= 1 - elif action == 'Left': - agent.location = loc_A - agent.performance -= 1 - elif action == 'Suck': - if self.status[agent.location] == 'Dirty': - agent.performance += 10 - self.status[agent.location] = 'Clean' - - def default_location(self, object): - "Agents start in either location at random." - return random.choice([loc_A, loc_B]) - -class Dirt(Object): pass -class Wall(Object): pass - -class VacuumEnvironment(XYEnvironment): - """The environment of [Ex. 2.12]. Agent perceives dirty or clean, - and bump (into obstacle) or not; 2D discrete world of unknown size; - performance measure is 100 for each dirt cleaned, and -1 for - each turn taken.""" - def __init__(self, width=10, height=10): - XYEnvironment.__init__(self, width, height) - self.add_walls() - - object_classes = [Wall, Dirt, ReflexVacuumAgent, RandomVacuumAgent, - TableDrivenVacuumAgent, ModelBasedVacuumAgent] - - def percept(self, agent): - """The percept is a tuple of ('Dirty' or 'Clean', 'Bump' or 'None'). - Unlike the TrivialVacuumEnvironment, location is NOT perceived.""" - status = if_(self.find_at(Dirt, agent.location), 'Dirty', 'Clean') - bump = if_(agent.bump, 'Bump', 'None') - return (status, bump) - - def execute_action(self, agent, action): - if action == 'Suck': - if self.find_at(Dirt, agent.location): - agent.performance += 100 - agent.performance -= 1 - XYEnvironment.execute_action(self, agent, action) - -#______________________________________________________________________________ - -class SimpleReflexAgent(Agent): - """This agent takes action based solely on the percept. [Fig. 2.13]""" - - def __init__(self, rules, interpret_input): - Agent.__init__(self) - def program(percept): - state = interpret_input(percept) - rule = rule_match(state, rules) - action = rule.action - return action - self.program = program - -class ReflexAgentWithState(Agent): - """This agent takes action based on the percept and state. [Fig. 2.16]""" - - def __init__(self, rules, udpate_state): - Agent.__init__(self) - state, action = None, None - def program(percept): - state = update_state(state, action, percept) - rule = rule_match(state, rules) - action = rule.action - return action - self.program = program - -#______________________________________________________________________________ -## The Wumpus World - -class Gold(Object): pass -class Pit(Object): pass -class Arrow(Object): pass -class Wumpus(Agent): pass -class Explorer(Agent): pass - -class WumpusEnvironment(XYEnvironment): - object_classes = [Wall, Gold, Pit, Arrow, Wumpus, Explorer] - def __init__(self, width=10, height=10): - XYEnvironment.__init__(self, width, height) - self.add_walls() - ## Needs a lot of work ... - - -#______________________________________________________________________________ - -def compare_agents(EnvFactory, AgentFactories, n=10, steps=1000): - """See how well each of several agents do in n instances of an environment. - Pass in a factory (constructor) for environments, and several for agents. - Create n instances of the environment, and run each agent in copies of - each one for steps. Return a list of (agent, average-score) tuples.""" - envs = [EnvFactory() for i in range(n)] - return [(A, test_agent(A, steps, copy.deepcopy(envs))) - for A in AgentFactories] - -def test_agent(AgentFactory, steps, envs): - "Return the mean score of running an agent in each of the envs, for steps" - total = 0 - for env in envs: - agent = AgentFactory() - env.add_object(agent) - env.run(steps) - total += agent.performance - return float(total)/len(envs) - -#______________________________________________________________________________ - -_docex = """ -a = ReflexVacuumAgent() -a.program -a.program((loc_A, 'Clean')) ==> 'Right' -a.program((loc_B, 'Clean')) ==> 'Left' -a.program((loc_A, 'Dirty')) ==> 'Suck' -a.program((loc_A, 'Dirty')) ==> 'Suck' - -e = TrivialVacuumEnvironment() -e.add_object(TraceAgent(ModelBasedVacuumAgent())) -e.run(5) - -## Environments, and some agents, are randomized, so the best we can -## give is a range of expected scores. If this test fails, it does -## not necessarily mean something is wrong. -envs = [TrivialVacuumEnvironment() for i in range(100)] -def testv(A): return test_agent(A, 4, copy.deepcopy(envs)) -testv(ModelBasedVacuumAgent) -(7 < _ < 11) ==> True -testv(ReflexVacuumAgent) -(5 < _ < 9) ==> True -testv(TableDrivenVacuumAgent) -(2 < _ < 6) ==> True -testv(RandomVacuumAgent) -(0.5 < _ < 3) ==> True -""" - -#______________________________________________________________________________ -# GUI - Graphical User Interface for Environments -# If you do not have Tkinter installed, either get a new installation of Python -# (Tkinter is standard in all new releases), or delete the rest of this file -# and muddle through without a GUI. - -''' -import Tkinter as tk - -class EnvFrame(tk.Frame): - def __init__(self, env, title='AIMA GUI', cellwidth=50, n=10): - update(self, cellwidth = cellwidth, running=False, delay=1.0) - self.n = n - self.running = 0 - self.delay = 1.0 - self.env = env - tk.Frame.__init__(self, None, width=(cellwidth+2)*n, height=(cellwidth+2)*n) - #self.title(title) - # Toolbar - toolbar = tk.Frame(self, relief='raised', bd=2) - toolbar.pack(side='top', fill='x') - for txt, cmd in [('Step >', self.env.step), ('Run >>', self.run), - ('Stop [ ]', self.stop)]: - tk.Button(toolbar, text=txt, command=cmd).pack(side='left') - tk.Label(toolbar, text='Delay').pack(side='left') - scale = tk.Scale(toolbar, orient='h', from_=0.0, to=10, resolution=0.5, - command=lambda d: setattr(self, 'delay', d)) - scale.set(self.delay) - scale.pack(side='left') - # Canvas for drawing on - self.canvas = tk.Canvas(self, width=(cellwidth+1)*n, - height=(cellwidth+1)*n, background="white") - self.canvas.bind('', self.left) ## What should this do? - self.canvas.bind('', self.edit_objects) - self.canvas.bind('', self.add_object) - if cellwidth: - c = self.canvas - for i in range(1, n+1): - c.create_line(0, i*cellwidth, n*cellwidth, i*cellwidth) - c.create_line(i*cellwidth, 0, i*cellwidth, n*cellwidth) - c.pack(expand=1, fill='both') - self.pack() - - - def background_run(self): - if self.running: - self.env.step() - ms = int(1000 * max(float(self.delay), 0.5)) - self.after(ms, self.background_run) - - def run(self): - print 'run' - self.running = 1 - self.background_run() - - def stop(self): - print 'stop' - self.running = 0 - - def left(self, event): - print 'left at ', event.x/50, event.y/50 - - def edit_objects(self, event): - """Choose an object within radius and edit its fields.""" - pass - - def add_object(self, event): - ## This is supposed to pop up a menu of Object classes; you choose the one - ## You want to put in this square. Not working yet. - menu = tk.Menu(self, title='Edit (%d, %d)' % (event.x/50, event.y/50)) - for (txt, cmd) in [('Wumpus', self.run), ('Pit', self.run)]: - menu.add_command(label=txt, command=cmd) - menu.tk_popup(event.x + self.winfo_rootx(), - event.y + self.winfo_rooty()) - - #image=PhotoImage(file=r"C:\Documents and Settings\pnorvig\Desktop\wumpus.gif") - #self.images = [] - #self.images.append(image) - #c.create_image(200,200,anchor=NW,image=image) - -#v = VacuumEnvironment(); w = EnvFrame(v); -''' diff --git a/csp/aima/csp.py b/csp/aima/csp.py deleted file mode 100644 index 935b2035..00000000 --- a/csp/aima/csp.py +++ /dev/null @@ -1,451 +0,0 @@ -"""CSP (Constraint Satisfaction Problems) problems and solvers. (Chapter 5).""" - -from __future__ import generators -from utils import * -import search -import types - -class CSP(search.Problem): - """This class describes finite-domain Constraint Satisfaction Problems. - A CSP is specified by the following three inputs: - vars A list of variables; each is atomic (e.g. int or string). - domains A dict of {var:[possible_value, ...]} entries. - neighbors A dict of {var:[var,...]} that for each variable lists - the other variables that participate in constraints. - constraints A function f(A, a, B, b) that returns true if neighbors - A, B satisfy the constraint when they have values A=a, B=b - In the textbook and in most mathematical definitions, the - constraints are specified as explicit pairs of allowable values, - but the formulation here is easier to express and more compact for - most cases. (For example, the n-Queens problem can be represented - in O(n) space using this notation, instead of O(N^4) for the - explicit representation.) In terms of describing the CSP as a - problem, that's all there is. - - However, the class also supports data structures and methods that help you - solve CSPs by calling a search function on the CSP. Methods and slots are - as follows, where the argument 'a' represents an assignment, which is a - dict of {var:val} entries: - assign(var, val, a) Assign a[var] = val; do other bookkeeping - unassign(var, a) Do del a[var], plus other bookkeeping - nconflicts(var, val, a) Return the number of other variables that - conflict with var=val - curr_domains[var] Slot: remaining consistent values for var - Used by constraint propagation routines. - The following methods are used only by graph_search and tree_search: - succ() Return a list of (action, state) pairs - goal_test(a) Return true if all constraints satisfied - The following are just for debugging purposes: - nassigns Slot: tracks the number of assignments made - display(a) Print a human-readable representation - """ - - def __init__(self, vars, domains, neighbors, constraints): - "Construct a CSP problem. If vars is empty, it becomes domains.keys()." - vars = vars or domains.keys() - update(self, vars=vars, domains=domains, - neighbors=neighbors, constraints=constraints, - initial={}, curr_domains=None, pruned=None, nassigns=0) - - def assign(self, var, val, assignment): - """Add {var: val} to assignment; Discard the old value if any. - Do bookkeeping for curr_domains and nassigns.""" - self.nassigns += 1 - assignment[var] = val - if self.curr_domains: - if self.fc: - self.forward_check(var, val, assignment) - if self.mac: - AC3(self, [(Xk, var) for Xk in self.neighbors[var]]) - - def unassign(self, var, assignment): - """Remove {var: val} from assignment; that is backtrack. - DO NOT call this if you are changing a variable to a new value; - just call assign for that.""" - if var in assignment: - # Reset the curr_domain to be the full original domain - if self.curr_domains: - self.curr_domains[var] = self.domains[var][:] - del assignment[var] - - def nconflicts(self, var, val, assignment): - "Return the number of conflicts var=val has with other variables." - # Subclasses may implement this more efficiently - def conflict(var2): - val2 = assignment.get(var2, None) - return val2 != None and not self.constraints(var, val, var2, val2) - return count_if(conflict, self.neighbors[var]) - - def forward_check(self, var, val, assignment): - "Do forward checking (current domain reduction) for this assignment." - if self.curr_domains: - # Restore prunings from previous value of var - for (B, b) in self.pruned[var]: - self.curr_domains[B].append(b) - self.pruned[var] = [] - # Prune any other B=b assignement that conflict with var=val - for B in self.neighbors[var]: - if B not in assignment: - for b in self.curr_domains[B][:]: - if not self.constraints(var, val, B, b): - self.curr_domains[B].remove(b) - self.pruned[var].append((B, b)) - - def display(self, assignment): - "Show a human-readable representation of the CSP." - # Subclasses can print in a prettier way, or display with a GUI - print 'CSP:', self, 'with assignment:', assignment - - ## These methods are for the tree and graph search interface: - - def succ(self, assignment): - "Return a list of (action, state) pairs." - if len(assignment) == len(self.vars): - return [] - else: - var = find_if(lambda v: v not in assignment, self.vars) - result = [] - for val in self.domains[var]: - if self.nconflicts(self, var, val, assignment) == 0: - a = assignment.copy; a[var] = val - result.append(((var, val), a)) - return result - - def goal_test(self, assignment): - "The goal is to assign all vars, with all constraints satisfied." - return (len(assignment) == len(self.vars) and - every(lambda var: self.nconflicts(var, assignment[var], - assignment) == 0, - self.vars)) - - ## This is for min_conflicts search - - def conflicted_vars(self, current): - "Return a list of variables in current assignment that are in conflict" - return [var for var in self.vars - if self.nconflicts(var, current[var], current) > 0] - -#______________________________________________________________________________ -# CSP Backtracking Search - -def backtracking_search(csp, mcv=False, lcv=False, fc=False, mac=False): - """Set up to do recursive backtracking search. Allow the following options: - mcv - If true, use Most Constrained Variable Heuristic - lcv - If true, use Least Constraining Value Heuristic - fc - If true, use Forward Checking - mac - If true, use Maintaining Arc Consistency. [Fig. 5.3] - >>> backtracking_search(australia) - {'WA': 'B', 'Q': 'B', 'T': 'B', 'V': 'B', 'SA': 'G', 'NT': 'R', 'NSW': 'R'} - """ - if fc or mac: - csp.curr_domains, csp.pruned = {}, {} - for v in csp.vars: - csp.curr_domains[v] = csp.domains[v][:] - csp.pruned[v] = [] - update(csp, mcv=mcv, lcv=lcv, fc=fc, mac=mac) - return recursive_backtracking({}, csp) - -def recursive_backtracking(assignment, csp): - """Search for a consistent assignment for the csp. - Each recursive call chooses a variable, and considers values for it.""" - if len(assignment) == len(csp.vars): - return assignment - var = select_unassigned_variable(assignment, csp) - for val in order_domain_values(var, assignment, csp): - if csp.fc or csp.nconflicts(var, val, assignment) == 0: - csp.assign(var, val, assignment) - result = recursive_backtracking(assignment, csp) - if result is not None: - return result - csp.unassign(var, assignment) - return None - -def select_unassigned_variable(assignment, csp): - "Select the variable to work on next. Find" - if csp.mcv: # Most Constrained Variable - unassigned = [v for v in csp.vars if v not in assignment] - return argmin_random_tie(unassigned, - lambda var: -num_legal_values(csp, var, assignment)) - else: # First unassigned variable - for v in csp.vars: - if v not in assignment: - return v - -def order_domain_values(var, assignment, csp): - "Decide what order to consider the domain variables." - if csp.curr_domains: - domain = csp.curr_domains[var] - else: - domain = csp.domains[var][:] - if csp.lcv: - # If LCV is specified, consider values with fewer conflicts first - key = lambda val: csp.nconflicts(var, val, assignment) - domain.sort(lambda(x,y): cmp(key(x), key(y))) - while domain: - yield domain.pop() - -def num_legal_values(csp, var, assignment): - if csp.curr_domains: - return len(csp.curr_domains[var]) - else: - return count_if(lambda val: csp.nconflicts(var, val, assignment) == 0, - csp.domains[var]) - -#______________________________________________________________________________ -# Constraint Propagation with AC-3 - -def AC3(csp, queue=None): - """[Fig. 5.7]""" - if queue == None: - queue = [(Xi, Xk) for Xi in csp.vars for Xk in csp.neighbors[Xi]] - while queue: - (Xi, Xj) = queue.pop() - if remove_inconsistent_values(csp, Xi, Xj): - for Xk in csp.neighbors[Xi]: - queue.append((Xk, Xi)) - -def remove_inconsistent_values(csp, Xi, Xj): - "Return true if we remove a value." - removed = False - for x in csp.curr_domains[Xi][:]: - # If Xi=x conflicts with Xj=y for every possible y, eliminate Xi=x - if every(lambda y: not csp.constraints(Xi, x, Xj, y), - csp.curr_domains[Xj]): - csp.curr_domains[Xi].remove(x) - removed = True - return removed - -#______________________________________________________________________________ -# Min-conflicts hillclimbing search for CSPs - -def min_conflicts(csp, max_steps=1000000): - """Solve a CSP by stochastic hillclimbing on the number of conflicts.""" - # Generate a complete assignement for all vars (probably with conflicts) - current = {}; csp.current = current - for var in csp.vars: - val = min_conflicts_value(csp, var, current) - csp.assign(var, val, current) - # Now repeapedly choose a random conflicted variable and change it - for i in range(max_steps): - print i - conflicted = csp.conflicted_vars(current) - if not conflicted: - return current - var = random.choice(conflicted) - val = min_conflicts_value(csp, var, current) - csp.assign(var, val, current) - return None - -def min_conflicts_value(csp, var, current): - """Return the value that will give var the least number of conflicts. - If there is a tie, choose at random.""" - return argmin_random_tie(csp.domains[var], - lambda val: csp.nconflicts(var, val, current)) - -#______________________________________________________________________________ -# Map-Coloring Problems - -class UniversalDict: - """A universal dict maps any key to the same value. We use it here - as the domains dict for CSPs in which all vars have the same domain. - >>> d = UniversalDict(42) - >>> d['life'] - 42 - """ - def __init__(self, value): self.value = value - def __getitem__(self, key): return self.value - def __repr__(self): return '{Any: %r}' % self.value - -def different_values_constraint(A, a, B, b): - "A constraint saying two neighboring variables must differ in value." - return a != b - -def MapColoringCSP(colors, neighbors): - """Make a CSP for the problem of coloring a map with different colors - for any two adjacent regions. Arguments are a list of colors, and a - dict of {region: [neighbor,...]} entries. This dict may also be - specified as a string of the form defined by parse_neighbors""" - - if isinstance(neighbors, str): - neighbors = parse_neighbors(neighbors) - return CSP(neighbors.keys(), UniversalDict(colors), neighbors, - different_values_constraint) - -def parse_neighbors(neighbors, vars=[]): - """Convert a string of the form 'X: Y Z; Y: Z' into a dict mapping - regions to neighbors. The syntax is a region name followed by a ':' - followed by zero or more region names, followed by ';', repeated for - each region name. If you say 'X: Y' you don't need 'Y: X'. - >>> parse_neighbors('X: Y Z; Y: Z') - {'Y': ['X', 'Z'], 'X': ['Y', 'Z'], 'Z': ['X', 'Y']} - """ - dict = DefaultDict([]) - for var in vars: - dict[var] = [] - specs = [spec.split(':') for spec in neighbors.split(';')] - for (A, Aneighbors) in specs: - A = A.strip(); - dict.setdefault(A, []) - for B in Aneighbors.split(): - dict[A].append(B) - dict[B].append(A) - return dict - -australia = MapColoringCSP(list('RGB'), - 'SA: WA NT Q NSW V; NT: WA Q; NSW: Q V; T: ') - -usa = MapColoringCSP(list('RGBY'), - """WA: OR ID; OR: ID NV CA; CA: NV AZ; NV: ID UT AZ; ID: MT WY UT; - UT: WY CO AZ; MT: ND SD WY; WY: SD NE CO; CO: NE KA OK NM; NM: OK TX; - ND: MN SD; SD: MN IA NE; NE: IA MO KA; KA: MO OK; OK: MO AR TX; - TX: AR LA; MN: WI IA; IA: WI IL MO; MO: IL KY TN AR; AR: MS TN LA; - LA: MS; WI: MI IL; IL: IN; IN: KY; MS: TN AL; AL: TN GA FL; MI: OH; - OH: PA WV KY; KY: WV VA TN; TN: VA NC GA; GA: NC SC FL; - PA: NY NJ DE MD WV; WV: MD VA; VA: MD DC NC; NC: SC; NY: VT MA CA NJ; - NJ: DE; DE: MD; MD: DC; VT: NH MA; MA: NH RI CT; CT: RI; ME: NH; - HI: ; AK: """) -#______________________________________________________________________________ -# n-Queens Problem - -def queen_constraint(A, a, B, b): - """Constraint is satisfied (true) if A, B are really the same variable, - or if they are not in the same row, down diagonal, or up diagonal.""" - return A == B or (a != b and A + a != B + b and A - a != B - b) - -class NQueensCSP(CSP): - """Make a CSP for the nQueens problem for search with min_conflicts. - Suitable for large n, it uses only data structures of size O(n). - Think of placing queens one per column, from left to right. - That means position (x, y) represents (var, val) in the CSP. - The main structures are three arrays to count queens that could conflict: - rows[i] Number of queens in the ith row (i.e val == i) - downs[i] Number of queens in the \ diagonal - such that their (x, y) coordinates sum to i - ups[i] Number of queens in the / diagonal - such that their (x, y) coordinates have x-y+n-1 = i - We increment/decrement these counts each time a queen is placed/moved from - a row/diagonal. So moving is O(1), as is nconflicts. But choosing - a variable, and a best value for the variable, are each O(n). - If you want, you can keep track of conflicted vars, then variable - selection will also be O(1). - >>> len(backtracking_search(NQueensCSP(8))) - 8 - >>> len(min_conflicts(NQueensCSP(8))) - 8 - """ - def __init__(self, n): - """Initialize data structures for n Queens.""" - CSP.__init__(self, range(n), UniversalDict(range(n)), - UniversalDict(range(n)), queen_constraint) - update(self, rows=[0]*n, ups=[0]*(2*n - 1), downs=[0]*(2*n - 1)) - - def nconflicts(self, var, val, assignment): - """The number of conflicts, as recorded with each assignment. - Count conflicts in row and in up, down diagonals. If there - is a queen there, it can't conflict with itself, so subtract 3.""" - n = len(self.vars) - c = self.rows[val] + self.downs[var+val] + self.ups[var-val+n-1] - if assignment.get(var, None) == val: - c -= 3 - return c - - def assign(self, var, val, assignment): - "Assign var, and keep track of conflicts." - oldval = assignment.get(var, None) - if val != oldval: - if oldval is not None: # Remove old val if there was one - self.record_conflict(assignment, var, oldval, -1) - self.record_conflict(assignment, var, val, +1) - CSP.assign(self, var, val, assignment) - - def unassign(self, var, assignment): - "Remove var from assignment (if it is there) and track conflicts." - if var in assignment: - self.record_conflict(assignment, var, assignment[var], -1) - CSP.unassign(self, var, assignment) - - def record_conflict(self, assignment, var, val, delta): - "Record conflicts caused by addition or deletion of a Queen." - n = len(self.vars) - self.rows[val] += delta - self.downs[var + val] += delta - self.ups[var - val + n - 1] += delta - - def display(self, assignment): - "Print the queens and the nconflicts values (for debugging)." - n = len(self.vars) - for val in range(n): - for var in range(n): - if assignment.get(var,'') == val: ch ='Q' - elif (var+val) % 2 == 0: ch = '.' - else: ch = '-' - print ch, - print ' ', - for var in range(n): - if assignment.get(var,'') == val: ch ='*' - else: ch = ' ' - print str(self.nconflicts(var, val, assignment))+ch, - print - -#______________________________________________________________________________ -# The Zebra Puzzle - -def Zebra(): - "Return an instance of the Zebra Puzzle." - Colors = 'Red Yellow Blue Green Ivory'.split() - Pets = 'Dog Fox Snails Horse Zebra'.split() - Drinks = 'OJ Tea Coffee Milk Water'.split() - Countries = 'Englishman Spaniard Norwegian Ukranian Japanese'.split() - Smokes = 'Kools Chesterfields Winston LuckyStrike Parliaments'.split() - vars = Colors + Pets + Drinks + Countries + Smokes - domains = {} - for var in vars: - domains[var] = range(1, 6) - domains['Norwegian'] = [1] - domains['Milk'] = [3] - neighbors = parse_neighbors("""Englishman: Red; - Spaniard: Dog; Kools: Yellow; Chesterfields: Fox; - Norwegian: Blue; Winston: Snails; LuckyStrike: OJ; - Ukranian: Tea; Japanese: Parliaments; Kools: Horse; - Coffee: Green; Green: Ivory""", vars) - for type in [Colors, Pets, Drinks, Countries, Smokes]: - for A in type: - for B in type: - if A != B: - if B not in neighbors[A]: neighbors[A].append(B) - if A not in neighbors[B]: neighbors[B].append(A) - def zebra_constraint(A, a, B, b, recurse=0): - same = (a == b) - next_to = abs(a - b) == 1 - if A == 'Englishman' and B == 'Red': return same - if A == 'Spaniard' and B == 'Dog': return same - if A == 'Chesterfields' and B == 'Fox': return next_to - if A == 'Norwegian' and B == 'Blue': return next_to - if A == 'Kools' and B == 'Yellow': return same - if A == 'Winston' and B == 'Snails': return same - if A == 'LuckyStrike' and B == 'OJ': return same - if A == 'Ukranian' and B == 'Tea': return same - if A == 'Japanese' and B == 'Parliaments': return same - if A == 'Kools' and B == 'Horse': return next_to - if A == 'Coffee' and B == 'Green': return same - if A == 'Green' and B == 'Ivory': return (a - 1) == b - if recurse == 0: return zebra_constraint(B, b, A, a, 1) - if ((A in Colors and B in Colors) or - (A in Pets and B in Pets) or - (A in Drinks and B in Drinks) or - (A in Countries and B in Countries) or - (A in Smokes and B in Smokes)): return not same - raise 'error' - return CSP(vars, domains, neighbors, zebra_constraint) - -def solve_zebra(algorithm=min_conflicts, **args): - z = Zebra() - ans = algorithm(z, **args) - for h in range(1, 6): - print 'House', h, - for (var, val) in ans.items(): - if val == h: print var, - print - return ans['Zebra'], ans['Water'], z.nassigns, ans, - -solve_zebra() diff --git a/csp/aima/csp.txt b/csp/aima/csp.txt deleted file mode 100644 index dbf45c47..00000000 --- a/csp/aima/csp.txt +++ /dev/null @@ -1,8 +0,0 @@ - -### demo - ->>> min_conflicts(australia) -{'WA': 'B', 'Q': 'B', 'T': 'G', 'V': 'B', 'SA': 'R', 'NT': 'G', 'NSW': 'G'} - ->>> min_conflicts(usa) -{'WA': 'B', 'DE': 'R', 'DC': 'Y', 'WI': 'G', 'WV': 'Y', 'HI': 'R', 'FL': 'B', 'WY': 'Y', 'NH': 'R', 'NJ': 'Y', 'NM': 'Y', 'TX': 'G', 'LA': 'R', 'NC': 'B', 'ND': 'Y', 'NE': 'B', 'TN': 'G', 'NY': 'R', 'PA': 'B', 'RI': 'R', 'NV': 'Y', 'VA': 'R', 'CO': 'R', 'CA': 'B', 'AL': 'R', 'AR': 'Y', 'VT': 'Y', 'IL': 'B', 'GA': 'Y', 'IN': 'Y', 'IA': 'Y', 'OK': 'B', 'AZ': 'R', 'ID': 'G', 'CT': 'Y', 'ME': 'B', 'MD': 'G', 'KA': 'Y', 'MA': 'B', 'OH': 'R', 'UT': 'B', 'MO': 'R', 'MN': 'R', 'MI': 'B', 'AK': 'B', 'MT': 'R', 'MS': 'B', 'SC': 'G', 'KY': 'B', 'OR': 'R', 'SD': 'G'} diff --git a/csp/aima/doctests.py b/csp/aima/doctests.py deleted file mode 100644 index 4782f172..00000000 --- a/csp/aima/doctests.py +++ /dev/null @@ -1,43 +0,0 @@ -"""Run all doctests from modules on the command line. For each -module, if there is a "module.txt" file, run that too. However, -if the module.txt file contains the comment "# demo", -then the remainder of the file has its ">>>" lines executed, -but not run through doctest. The idea is that you can use this -to demo statements that return random or otherwise variable results. - -Example usage: - - python doctests.py *.py -""" - -import doctest, re - -def run_tests(modules, verbose=None): - "Run tests for a list of modules; then summarize results." - for module in modules: - tests, demos = split_extra_tests(module.__name__ + ".txt") - if tests: - if '__doc__' not in dir(module): - module.__doc__ = '' - module.__doc__ += '\n' + tests + '\n' - doctest.testmod(module, report=0, verbose=verbose) - if demos: - for stmt in re.findall(">>> (.*)", demos): - exec stmt in module.__dict__ - doctest.master.summarize() - - -def split_extra_tests(filename): - """Take a filename and, if it exists, return a 2-tuple of - the parts before and after '# demo'.""" - try: - contents = open(filename).read() + '# demo' - return contents.split("# demo", 1) - except IOError: - return ('', '') - -if __name__ == "__main__": - import sys - modules = [__import__(name.replace('.py','')) - for name in sys.argv if name != "-v"] - run_tests(modules, ("-v" in sys.argv)) diff --git a/csp/aima/doctests.txt b/csp/aima/doctests.txt deleted file mode 100644 index 5f12b6b4..00000000 --- a/csp/aima/doctests.txt +++ /dev/null @@ -1,21 +0,0 @@ -### This is an example module.txt file. -### It should contain unit tests and their expected results: - ->>> 2 + 2 -4 - ->>> '2' + '2' -'22' - -### demo - -### After the part that says 'demo' we have statements that -### are intended not as unit tests, but as demos of how to -### use the functions and methods in the module. The -### statements are executed, but the results are not -### compared to the expected results. This can be useful -### for nondeterministic functions: - - ->>> import random; random.choice('abc') -'c' diff --git a/csp/aima/games.py b/csp/aima/games.py deleted file mode 100644 index 0fc986b0..00000000 --- a/csp/aima/games.py +++ /dev/null @@ -1,286 +0,0 @@ -"""Games, or Adversarial Search. (Chapters 6) - -""" - -from utils import * -import random - -#______________________________________________________________________________ -# Minimax Search - -def minimax_decision(state, game): - """Given a state in a game, calculate the best move by searching - forward all the way to the terminal states. [Fig. 6.4]""" - - player = game.to_move(state) - - def max_value(state): - if game.terminal_test(state): - return game.utility(state, player) - v = -infinity - for (a, s) in game.successors(state): - v = max(v, min_value(s)) - return v - - def min_value(state): - if game.terminal_test(state): - return game.utility(state, player) - v = infinity - for (a, s) in game.successors(state): - v = min(v, max_value(s)) - return v - - # Body of minimax_decision starts here: - action, state = argmax(game.successors(state), - lambda ((a, s)): min_value(s)) - return action - - -#______________________________________________________________________________ - -def alphabeta_full_search(state, game): - """Search game to determine best action; use alpha-beta pruning. - As in [Fig. 6.7], this version searches all the way to the leaves.""" - - player = game.to_move(state) - - def max_value(state, alpha, beta): - if game.terminal_test(state): - return game.utility(state, player) - v = -infinity - for (a, s) in game.successors(state): - v = max(v, min_value(s, alpha, beta)) - if v >= beta: - return v - alpha = max(alpha, v) - return v - - def min_value(state, alpha, beta): - if game.terminal_test(state): - return game.utility(state, player) - v = infinity - for (a, s) in game.successors(state): - v = min(v, max_value(s, alpha, beta)) - if v <= alpha: - return v - beta = min(beta, v) - return v - - # Body of alphabeta_search starts here: - action, state = argmax(game.successors(state), - lambda ((a, s)): min_value(s, -infinity, infinity)) - return action - -def alphabeta_search(state, game, d=4, cutoff_test=None, eval_fn=None): - """Search game to determine best action; use alpha-beta pruning. - This version cuts off search and uses an evaluation function.""" - - player = game.to_move(state) - - def max_value(state, alpha, beta, depth): - if cutoff_test(state, depth): - return eval_fn(state) - v = -infinity - for (a, s) in game.successors(state): - v = max(v, min_value(s, alpha, beta, depth+1)) - if v >= beta: - return v - alpha = max(alpha, v) - return v - - def min_value(state, alpha, beta, depth): - if cutoff_test(state, depth): - return eval_fn(state) - v = infinity - for (a, s) in game.successors(state): - v = min(v, max_value(s, alpha, beta, depth+1)) - if v <= alpha: - return v - beta = min(beta, v) - return v - - # Body of alphabeta_search starts here: - # The default test cuts off at depth d or at a terminal state - cutoff_test = (cutoff_test or - (lambda state,depth: depth>d or game.terminal_test(state))) - eval_fn = eval_fn or (lambda state: game.utility(state, player)) - action, state = argmax(game.successors(state), - lambda ((a, s)): min_value(s, -infinity, infinity, 0)) - return action - -#______________________________________________________________________________ -# Players for Games - -def query_player(game, state): - "Make a move by querying standard input." - game.display(state) - return num_or_str(raw_input('Your move? ')) - -def random_player(game, state): - "A player that chooses a legal move at random." - return random.choice(game.legal_moves()) - -def alphabeta_player(game, state): - return alphabeta_search(state, game) - -def play_game(game, *players): - "Play an n-person, move-alternating game." - state = game.initial - while True: - for player in players: - move = player(game, state) - state = game.make_move(move, state) - if game.terminal_test(state): - return game.utility(state, players[0]) - -#______________________________________________________________________________ -# Some Sample Games - -class Game: - """A game is similar to a problem, but it has a utility for each - state and a terminal test instead of a path cost and a goal - test. To create a game, subclass this class and implement - legal_moves, make_move, utility, and terminal_test. You may - override display and successors or you can inherit their default - methods. You will also need to set the .initial attribute to the - initial state; this can be done in the constructor.""" - - def legal_moves(self, state): - "Return a list of the allowable moves at this point." - abstract - - def make_move(self, move, state): - "Return the state that results from making a move from a state." - abstract - - def utility(self, state, player): - "Return the value of this final state to player." - abstract - - def terminal_test(self, state): - "Return True if this is a final state for the game." - return not self.legal_moves(state) - - def to_move(self, state): - "Return the player whose move it is in this state." - return state.to_move - - def display(self, state): - "Print or otherwise display the state." - print state - - def successors(self, state): - "Return a list of legal (move, state) pairs." - return [(move, self.make_move(move, state)) - for move in self.legal_moves(state)] - - def __repr__(self): - return '<%s>' % self.__class__.__name__ - -class Fig62Game(Game): - """The game represented in [Fig. 6.2]. Serves as a simple test case. - >>> g = Fig62Game() - >>> minimax_decision('A', g) - 'a1' - >>> alphabeta_full_search('A', g) - 'a1' - >>> alphabeta_search('A', g) - 'a1' - """ - succs = {'A': [('a1', 'B'), ('a2', 'C'), ('a3', 'D')], - 'B': [('b1', 'B1'), ('b2', 'B2'), ('b3', 'B3')], - 'C': [('c1', 'C1'), ('c2', 'C2'), ('c3', 'C3')], - 'D': [('d1', 'D1'), ('d2', 'D2'), ('d3', 'D3')]} - utils = Dict(B1=3, B2=12, B3=8, C1=2, C2=4, C3=6, D1=14, D2=5, D3=2) - initial = 'A' - - def successors(self, state): - return self.succs.get(state, []) - - def utility(self, state, player): - if player == 'MAX': - return self.utils[state] - else: - return -self.utils[state] - - def terminal_test(self, state): - return state not in ('A', 'B', 'C', 'D') - - def to_move(self, state): - return if_(state in 'BCD', 'MIN', 'MAX') - -class TicTacToe(Game): - """Play TicTacToe on an h x v board, with Max (first player) playing 'X'. - A state has the player to move, a cached utility, a list of moves in - the form of a list of (x, y) positions, and a board, in the form of - a dict of {(x, y): Player} entries, where Player is 'X' or 'O'.""" - def __init__(self, h=3, v=3, k=3): - update(self, h=h, v=v, k=k) - moves = [(x, y) for x in range(1, h+1) - for y in range(1, v+1)] - self.initial = Struct(to_move='X', utility=0, board={}, moves=moves) - - def legal_moves(self, state): - "Legal moves are any square not yet taken." - return state.moves - - def make_move(self, move, state): - if move not in state.moves: - return state # Illegal move has no effect - board = state.board.copy(); board[move] = state.to_move - moves = list(state.moves); moves.remove(move) - return Struct(to_move=if_(state.to_move == 'X', 'O', 'X'), - utility=self.compute_utility(board, move, state.to_move), - board=board, moves=moves) - - def utility(self, state): - "Return the value to X; 1 for win, -1 for loss, 0 otherwise." - return state.utility - - def terminal_test(self, state): - "A state is terminal if it is won or there are no empty squares." - return state.utility != 0 or len(state.moves) == 0 - - def display(self, state): - board = state.board - for x in range(1, self.h+1): - for y in range(1, self.v+1): - print board.get((x, y), '.'), - print - - def compute_utility(self, board, move, player): - "If X wins with this move, return 1; if O return -1; else return 0." - if (self.k_in_row(board, move, player, (0, 1)) or - self.k_in_row(board, move, player, (1, 0)) or - self.k_in_row(board, move, player, (1, -1)) or - self.k_in_row(board, move, player, (1, 1))): - return if_(player == 'X', +1, -1) - else: - return 0 - - def k_in_row(self, board, move, player, (delta_x, delta_y)): - "Return true if there is a line through move on board for player." - x, y = move - n = 0 # n is number of moves in row - while board.get((x, y)) == player: - n += 1 - x, y = x + delta_x, y + delta_y - x, y = move - while board.get((x, y)) == player: - n += 1 - x, y = x - delta_x, y - delta_y - n -= 1 # Because we counted move itself twice - return n >= self.k - -class ConnectFour(TicTacToe): - """A TicTacToe-like game in which you can only make a move on the bottom - row, or in a square directly above an occupied square. Traditionally - played on a 7x6 board and requiring 4 in a row.""" - - def __init__(self, h=7, v=6, k=4): - TicTacToe.__init__(self, h, v, k) - - def legal_moves(self, state): - "Legal moves are any square not yet taken." - return [(x, y) for (x, y) in state.moves - if y == 0 or (x, y-1) in state.board] diff --git a/csp/aima/learning.py b/csp/aima/learning.py deleted file mode 100644 index 3da30004..00000000 --- a/csp/aima/learning.py +++ /dev/null @@ -1,586 +0,0 @@ -"""Learn to estimate functions from examples. (Chapters 18-20)""" - -from utils import * -import agents, random, operator - -#______________________________________________________________________________ - -class DataSet: - """A data set for a machine learning problem. It has the following fields: - - d.examples A list of examples. Each one is a list of attribute values. - d.attrs A list of integers to index into an example, so example[attr] - gives a value. Normally the same as range(len(d.examples)). - d.attrnames Optional list of mnemonic names for corresponding attrs. - d.target The attribute that a learning algorithm will try to predict. - By default the final attribute. - d.inputs The list of attrs without the target. - d.values A list of lists, each sublist is the set of possible - values for the corresponding attribute. If None, it - is computed from the known examples by self.setproblem. - If not None, an erroneous value raises ValueError. - d.name Name of the data set (for output display only). - d.source URL or other source where the data came from. - - Normally, you call the constructor and you're done; then you just - access fields like d.examples and d.target and d.inputs.""" - - def __init__(self, examples=None, attrs=None, target=-1, values=None, - attrnames=None, name='', source='', - inputs=None, exclude=(), doc=''): - """Accepts any of DataSet's fields. Examples can - also be a string or file from which to parse examples using parse_csv. - >>> DataSet(examples='1, 2, 3') - - """ - update(self, name=name, source=source, values=values) - # Initialize .examples from string or list or data directory - if isinstance(examples, str): - self.examples = parse_csv(examples) - elif examples is None: - self.examples = parse_csv(DataFile(name+'.csv').read()) - else: - self.examples = examples - map(self.check_example, self.examples) - # Attrs are the indicies of examples, unless otherwise stated. - if not attrs and self.examples: - attrs = range(len(self.examples[0])) - self.attrs = attrs - # Initialize .attrnames from string, list, or by default - if isinstance(attrnames, str): - self.attrnames = attrnames.split() - else: - self.attrnames = attrnames or attrs - self.setproblem(target, inputs=inputs, exclude=exclude) - - def setproblem(self, target, inputs=None, exclude=()): - """Set (or change) the target and/or inputs. - This way, one DataSet can be used multiple ways. inputs, if specified, - is a list of attributes, or specify exclude as a list of attributes - to not put use in inputs. Attributes can be -n .. n, or an attrname. - Also computes the list of possible values, if that wasn't done yet.""" - self.target = self.attrnum(target) - exclude = map(self.attrnum, exclude) - if inputs: - self.inputs = removall(self.target, inputs) - else: - self.inputs = [a for a in self.attrs - if a is not self.target and a not in exclude] - if not self.values: - self.values = map(unique, zip(*self.examples)) - - def add_example(self, example): - """Add an example to the list of examples, checking it first.""" - self.check_example(example) - self.examples.append(example) - - def check_example(self, example): - """Raise ValueError if example has any invalid values.""" - if self.values: - for a in self.attrs: - if example[a] not in self.values[a]: - raise ValueError('Bad value %s for attribute %s in %s' % - (example[a], self.attrnames[a], example)) - - def attrnum(self, attr): - "Returns the number used for attr, which can be a name, or -n .. n." - if attr < 0: - return len(self.attrs) + attr - elif isinstance(attr, str): - return self.attrnames.index(attr) - else: - return attr - - def sanitize(self, example): - "Return a copy of example, with non-input attributes replaced by 0." - return [i in self.inputs and example[i] for i in range(len(example))] - - def __repr__(self): - return '' % ( - self.name, len(self.examples), len(self.attrs)) - -#______________________________________________________________________________ - -def parse_csv(input, delim=','): - r"""Input is a string consisting of lines, each line has comma-delimited - fields. Convert this into a list of lists. Blank lines are skipped. - Fields that look like numbers are converted to numbers. - The delim defaults to ',' but '\t' and None are also reasonable values. - >>> parse_csv('1, 2, 3 \n 0, 2, na') - [[1, 2, 3], [0, 2, 'na']] - """ - lines = [line for line in input.splitlines() if line.strip() is not ''] - return [map(num_or_str, line.split(delim)) for line in lines] - -def rms_error(predictions, targets): - return math.sqrt(ms_error(predictions, targets)) - -def ms_error(predictions, targets): - return mean([(p - t)**2 for p, t in zip(predictions, targets)]) - -def mean_error(predictions, targets): - return mean([abs(p - t) for p, t in zip(predictions, targets)]) - -def mean_boolean_error(predictions, targets): - return mean([(p != t) for p, t in zip(predictions, targets)]) - - -#______________________________________________________________________________ - -class Learner: - """A Learner, or Learning Algorithm, can be trained with a dataset, - and then asked to predict the target attribute of an example.""" - - def train(self, dataset): - self.dataset = dataset - - def predict(self, example): - abstract - -#______________________________________________________________________________ - -class MajorityLearner(Learner): - """A very dumb algorithm: always pick the result that was most popular - in the training data. Makes a baseline for comparison.""" - - def train(self, dataset): - "Find the target value that appears most often." - self.most_popular = mode([e[dataset.target] for e in dataset.examples]) - - def predict(self, example): - "Always return same result: the most popular from the training set." - return self.most_popular - -#______________________________________________________________________________ - -class NaiveBayesLearner(Learner): - - def train(self, dataset): - """Just count the target/attr/val occurences. - Count how many times each value of each attribute occurs. - Store count in N[targetvalue][attr][val]. Let N[attr][None] be the - sum over all vals.""" - N = {} - ## Initialize to 0 - for gv in self.dataset.values[self.dataset.target]: - N[gv] = {} - for attr in self.dataset.attrs: - N[gv][attr] = {} - for val in self.dataset.values[attr]: - N[gv][attr][val] = 0 - N[gv][attr][None] = 0 - ## Go thru examples - for example in self.dataset.examples: - Ngv = N[example[self.dataset.target]] - for attr in self.dataset.attrs: - Ngv[attr][example[attr]] += 1 - Ngv[attr][None] += 1 - self._N = N - - def N(self, targetval, attr, attrval): - "Return the count in the training data of this combination." - try: - return self._N[targetval][attr][attrval] - except KeyError: - return 0 - - def P(self, targetval, attr, attrval): - """Smooth the raw counts to give a probability estimate. - Estimate adds 1 to numerator and len(possible vals) to denominator.""" - return ((self.N(targetval, attr, attrval) + 1.0) / - (self.N(targetval, attr, None) + len(self.dataset.values[attr]))) - - def predict(self, example): - """Predict the target value for example. Consider each possible value, - choose the most likely, by looking at each attribute independently.""" - possible_values = self.dataset.values[self.dataset.target] - def class_probability(targetval): - return product([self.P(targetval, a, example[a]) - for a in self.dataset.inputs], 1) - return argmax(possible_values, class_probability) - -#______________________________________________________________________________ - -class NearestNeighborLearner(Learner): - - def __init__(self, k=1): - "k-NearestNeighbor: the k nearest neighbors vote." - self.k = k - - def predict(self, example): - """With k=1, find the point closest to example. - With k>1, find k closest, and have them vote for the best.""" - if self.k == 1: - neighbor = argmin(self.dataset.examples, - lambda e: self.distance(e, example)) - return neighbor[self.dataset.target] - else: - ## Maintain a sorted list of (distance, example) pairs. - ## For very large k, a PriorityQueue would be better - best = [] - for e in examples: - d = self.distance(e, example) - if len(best) < k: - e.append((d, e)) - elif d < best[-1][0]: - best[-1] = (d, e) - best.sort() - return mode([e[self.dataset.target] for (d, e) in best]) - - def distance(self, e1, e2): - return mean_boolean_error(e1, e2) - -#______________________________________________________________________________ - -class DecisionTree: - """A DecisionTree holds an attribute that is being tested, and a - dict of {attrval: Tree} entries. If Tree here is not a DecisionTree - then it is the final classification of the example.""" - - def __init__(self, attr, attrname=None, branches=None): - "Initialize by saying what attribute this node tests." - update(self, attr=attr, attrname=attrname or attr, - branches=branches or {}) - - def predict(self, example): - "Given an example, use the tree to classify the example." - child = self.branches[example[self.attr]] - if isinstance(child, DecisionTree): - return child.predict(example) - else: - return child - - def add(self, val, subtree): - "Add a branch. If self.attr = val, go to the given subtree." - self.branches[val] = subtree - return self - - def display(self, indent=0): - name = self.attrname - print 'Test', name - for (val, subtree) in self.branches.items(): - print ' '*4*indent, name, '=', val, '==>', - if isinstance(subtree, DecisionTree): - subtree.display(indent+1) - else: - print 'RESULT = ', subtree - - def __repr__(self): - return 'DecisionTree(%r, %r, %r)' % ( - self.attr, self.attrname, self.branches) - -Yes, No = True, False - -#______________________________________________________________________________ - -class DecisionTreeLearner(Learner): - - def predict(self, example): - if isinstance(self.dt, DecisionTree): - return self.dt.predict(example) - else: - return self.dt - - def train(self, dataset): - self.dataset = dataset - self.attrnames = dataset.attrnames - self.dt = self.decision_tree_learning(dataset.examples, dataset.inputs) - - def decision_tree_learning(self, examples, attrs, default=None): - if len(examples) == 0: - return default - elif self.all_same_class(examples): - return examples[0][self.dataset.target] - elif len(attrs) == 0: - return self.majority_value(examples) - else: - best = self.choose_attribute(attrs, examples) - tree = DecisionTree(best, self.attrnames[best]) - for (v, examples_i) in self.split_by(best, examples): - subtree = self.decision_tree_learning(examples_i, - removeall(best, attrs), self.majority_value(examples)) - tree.add(v, subtree) - return tree - - def choose_attribute(self, attrs, examples): - "Choose the attribute with the highest information gain." - return argmax(attrs, lambda a: self.information_gain(a, examples)) - - def all_same_class(self, examples): - "Are all these examples in the same target class?" - target = self.dataset.target - class0 = examples[0][target] - for e in examples: - if e[target] != class0: return False - return True - - def majority_value(self, examples): - """Return the most popular target value for this set of examples. - (If target is binary, this is the majority; otherwise plurality.)""" - g = self.dataset.target - return argmax(self.dataset.values[g], - lambda v: self.count(g, v, examples)) - - def count(self, attr, val, examples): - return count_if(lambda e: e[attr] == val, examples) - - def information_gain(self, attr, examples): - def I(examples): - target = self.dataset.target - return information_content([self.count(target, v, examples) - for v in self.dataset.values[target]]) - N = float(len(examples)) - remainder = 0 - for (v, examples_i) in self.split_by(attr, examples): - remainder += (len(examples_i) / N) * I(examples_i) - return I(examples) - remainder - - def split_by(self, attr, examples=None): - "Return a list of (val, examples) pairs for each val of attr." - if examples == None: - examples = self.dataset.examples - return [(v, [e for e in examples if e[attr] == v]) - for v in self.dataset.values[attr]] - -def information_content(values): - "Number of bits to represent the probability distribution in values." - # If the values do not sum to 1, normalize them to make them a Prob. Dist. - values = removeall(0, values) - s = float(sum(values)) - if s != 1.0: values = [v/s for v in values] - return sum([- v * log2(v) for v in values]) - -#______________________________________________________________________________ - -### A decision list is implemented as a list of (test, value) pairs. - -class DecisionListLearner(Learner): - - def train(self, dataset): - self.dataset = dataset - self.attrnames = dataset.attrnames - self.dl = self.decision_list_learning(Set(dataset.examples)) - - def decision_list_learning(self, examples): - """[Fig. 18.14]""" - if not examples: - return [(True, No)] - t, o, examples_t = self.find_examples(examples) - if not t: - raise Failure - return [(t, o)] + self.decision_list_learning(examples - examples_t) - - def find_examples(self, examples): - """Find a set of examples that all have the same outcome under some test. - Return a tuple of the test, outcome, and examples.""" - NotImplemented -#______________________________________________________________________________ - -class NeuralNetLearner(Learner): - """Layered feed-forward network.""" - - def __init__(self, sizes): - self.activations = map(lambda n: [0.0 for i in range(n)], sizes) - self.weights = [] - - def train(self, dataset): - NotImplemented - - def predict(self, example): - NotImplemented - -class NNUnit: - """Unit of a neural net.""" - def __init__(self): - NotImplemented - -class PerceptronLearner(NeuralNetLearner): - - def predict(self, example): - return sum([]) -#______________________________________________________________________________ - -class Linearlearner(Learner): - """Fit a linear model to the data.""" - - NotImplemented -#______________________________________________________________________________ - -class EnsembleLearner(Learner): - """Given a list of learning algorithms, have them vote.""" - - def __init__(self, learners=[]): - self.learners=learners - - def train(self, dataset): - for learner in self.learners: - learner.train(dataset) - - def predict(self, example): - return mode([learner.predict(example) for learner in self.learners]) - -#_____________________________________________________________________________ -# Functions for testing learners on examples - -def test(learner, dataset, examples=None, verbose=0): - """Return the proportion of the examples that are correctly predicted. - Assumes the learner has already been trained.""" - if examples == None: examples = dataset.examples - if len(examples) == 0: return 0.0 - right = 0.0 - for example in examples: - desired = example[dataset.target] - output = learner.predict(dataset.sanitize(example)) - if output == desired: - right += 1 - if verbose >= 2: - print ' OK: got %s for %s' % (desired, example) - elif verbose: - print 'WRONG: got %s, expected %s for %s' % ( - output, desired, example) - return right / len(examples) - -def train_and_test(learner, dataset, start, end): - """Reserve dataset.examples[start:end] for test; train on the remainder. - Return the proportion of examples correct on the test examples.""" - examples = dataset.examples - try: - dataset.examples = examples[:start] + examples[end:] - learner.dataset = dataset - learner.train(dataset) - return test(learner, dataset, examples[start:end]) - finally: - dataset.examples = examples - -def cross_validation(learner, dataset, k=10, trials=1): - """Do k-fold cross_validate and return their mean. - That is, keep out 1/k of the examples for testing on each of k runs. - Shuffle the examples first; If trials>1, average over several shuffles.""" - if k == None: - k = len(dataset.examples) - if trials > 1: - return mean([cross_validation(learner, dataset, k, trials=1) - for t in range(trials)]) - else: - n = len(dataset.examples) - random.shuffle(dataset.examples) - return mean([train_and_test(learner, dataset, i*(n/k), (i+1)*(n/k)) - for i in range(k)]) - -def leave1out(learner, dataset): - "Leave one out cross-validation over the dataset." - return cross_validation(learner, dataset, k=len(dataset.examples)) - -def learningcurve(learner, dataset, trials=10, sizes=None): - if sizes == None: - sizes = range(2, len(dataset.examples)-10, 2) - def score(learner, size): - random.shuffle(dataset.examples) - return train_and_test(learner, dataset, 0, size) - return [(size, mean([score(learner, size) for t in range(trials)])) - for size in sizes] - -#______________________________________________________________________________ -# The rest of this file gives Data sets for machine learning problems. - -orings = DataSet(name='orings', target='Distressed', - attrnames="Rings Distressed Temp Pressure Flightnum") - - -zoo = DataSet(name='zoo', target='type', exclude=['name'], - attrnames="name hair feathers eggs milk airborne aquatic " + - "predator toothed backbone breathes venomous fins legs tail " + - "domestic catsize type") - - -iris = DataSet(name="iris", target="class", - attrnames="sepal-len sepal-width petal-len petal-width class") - -#______________________________________________________________________________ -# The Restaurant example from Fig. 18.2 - -def RestaurantDataSet(examples=None): - "Build a DataSet of Restaurant waiting examples." - return DataSet(name='restaurant', target='Wait', examples=examples, - attrnames='Alternate Bar Fri/Sat Hungry Patrons Price ' - + 'Raining Reservation Type WaitEstimate Wait') - -restaurant = RestaurantDataSet() - -def T(attrname, branches): - return DecisionTree(restaurant.attrnum(attrname), attrname, branches) - -Fig[18,2] = T('Patrons', - {'None': 'No', 'Some': 'Yes', 'Full': - T('WaitEstimate', - {'>60': 'No', '0-10': 'Yes', - '30-60': - T('Alternate', {'No': - T('Reservation', {'Yes': 'Yes', 'No': - T('Bar', {'No':'No', - 'Yes':'Yes'})}), - 'Yes': - T('Fri/Sat', {'No': 'No', 'Yes': 'Yes'})}), - '10-30': - T('Hungry', {'No': 'Yes', 'Yes': - T('Alternate', - {'No': 'Yes', 'Yes': - T('Raining', {'No': 'No', 'Yes': 'Yes'})})})})}) - -def SyntheticRestaurant(n=20): - "Generate a DataSet with n examples." - def gen(): - example = map(random.choice, restaurant.values) - example[restaurant.target] = Fig[18,2].predict(example) - return example - return RestaurantDataSet([gen() for i in range(n)]) - -#______________________________________________________________________________ -# Artificial, generated examples. - -def Majority(k, n): - """Return a DataSet with n k-bit examples of the majority problem: - k random bits followed by a 1 if more than half the bits are 1, else 0.""" - examples = [] - for i in range(n): - bits = [random.choice([0, 1]) for i in range(k)] - bits.append(sum(bits) > k/2) - examples.append(bits) - return DataSet(name="majority", examples=examples) - -def Parity(k, n, name="parity"): - """Return a DataSet with n k-bit examples of the parity problem: - k random bits followed by a 1 if an odd number of bits are 1, else 0.""" - examples = [] - for i in range(n): - bits = [random.choice([0, 1]) for i in range(k)] - bits.append(sum(bits) % 2) - examples.append(bits) - return DataSet(name=name, examples=examples) - -def Xor(n): - """Return a DataSet with n examples of 2-input xor.""" - return Parity(2, n, name="xor") - -def ContinuousXor(n): - "2 inputs are chosen uniformly form (0.0 .. 2.0]; output is xor of ints." - examples = [] - for i in range(n): - x, y = [random.uniform(0.0, 2.0) for i in '12'] - examples.append([x, y, int(x) != int(y)]) - return DataSet(name="continuous xor", examples=examples) - -#______________________________________________________________________________ - -def compare(algorithms=[MajorityLearner, NaiveBayesLearner, - NearestNeighborLearner, DecisionTreeLearner], - datasets=[iris, orings, zoo, restaurant, SyntheticRestaurant(20), - Majority(7, 100), Parity(7, 100), Xor(100)], - k=10, trials=1): - """Compare various learners on various datasets using cross-validation. - Print results as a table.""" - print_table([[a.__name__.replace('Learner','')] + - [cross_validation(a(), d, k, trials) for d in datasets] - for a in algorithms], - header=[''] + [d.name[0:7] for d in datasets], round=2) - diff --git a/csp/aima/logic.py b/csp/aima/logic.py deleted file mode 100644 index 1c89a96b..00000000 --- a/csp/aima/logic.py +++ /dev/null @@ -1,888 +0,0 @@ -"""Representations and Inference for Logic (Chapters 7-10) - -Covers both Propositional and First-Order Logic. First we have four -important data types: - - KB Abstract class holds a knowledge base of logical expressions - KB_Agent Abstract class subclasses agents.Agent - Expr A logical expression - substitution Implemented as a dictionary of var:value pairs, {x:1, y:x} - -Be careful: some functions take an Expr as argument, and some take a KB. -Then we implement various functions for doing logical inference: - - pl_true Evaluate a propositional logical sentence in a model - tt_entails Say if a statement is entailed by a KB - pl_resolution Do resolution on propositional sentences - dpll_satisfiable See if a propositional sentence is satisfiable - WalkSAT (not yet implemented) - -And a few other functions: - - to_cnf Convert to conjunctive normal form - unify Do unification of two FOL sentences - diff, simp Symbolic differentiation and simplification -""" - -from __future__ import generators -import re -import agents -from utils import * - -#______________________________________________________________________________ - -class KB: - """A Knowledge base to which you can tell and ask sentences. - To create a KB, first subclass this class and implement - tell, ask_generator, and retract. Why ask_generator instead of ask? - The book is a bit vague on what ask means -- - For a Propositional Logic KB, ask(P & Q) returns True or False, but for an - FOL KB, something like ask(Brother(x, y)) might return many substitutions - such as {x: Cain, y: Able}, {x: Able, y: Cain}, {x: George, y: Jeb}, etc. - So ask_generator generates these one at a time, and ask either returns the - first one or returns False.""" - - def __init__(self, sentence=None): - abstract - - def tell(self, sentence): - "Add the sentence to the KB" - abstract - - def ask(self, query): - """Ask returns a substitution that makes the query true, or - it returns False. It is implemented in terms of ask_generator.""" - try: - return self.ask_generator(query).next() - except StopIteration: - return False - - def ask_generator(self, query): - "Yield all the substitutions that make query true." - abstract - - def retract(self, sentence): - "Remove the sentence from the KB" - abstract - - -class PropKB(KB): - "A KB for Propositional Logic. Inefficient, with no indexing." - - def __init__(self, sentence=None): - self.clauses = [] - if sentence: - self.tell(sentence) - - def tell(self, sentence): - "Add the sentence's clauses to the KB" - self.clauses.extend(conjuncts(to_cnf(sentence))) - - def ask_generator(self, query): - "Yield the empty substitution if KB implies query; else False" - if not tt_entails(Expr('&', *self.clauses), query): - return - yield {} - - def retract(self, sentence): - "Remove the sentence's clauses from the KB" - for c in conjuncts(to_cnf(sentence)): - if c in self.clauses: - self.clauses.remove(c) - -#______________________________________________________________________________ - -class KB_Agent(agents.Agent): - """A generic logical knowledge-based agent. [Fig. 7.1]""" - def __init__(self, KB): - t = 0 - def program(percept): - KB.tell(self.make_percept_sentence(percept, t)) - action = KB.ask(self.make_action_query(t)) - KB.tell(self.make_action_sentence(action, t)) - t = t + 1 - return action - self.program = program - - def make_percept_sentence(self, percept, t): - return(Expr("Percept")(percept, t)) - - def make_action_query(self, t): - return(expr("ShouldDo(action, %d)" % t)) - - def make_action_sentence(self, action, t): - return(Expr("Did")(action, t)) - -#______________________________________________________________________________ - -class Expr: - """A symbolic mathematical expression. We use this class for logical - expressions, and for terms within logical expressions. In general, an - Expr has an op (operator) and a list of args. The op can be: - Null-ary (no args) op: - A number, representing the number itself. (e.g. Expr(42) => 42) - A symbol, representing a variable or constant (e.g. Expr('F') => F) - Unary (1 arg) op: - '~', '-', representing NOT, negation (e.g. Expr('~', Expr('P')) => ~P) - Binary (2 arg) op: - '>>', '<<', representing forward and backward implication - '+', '-', '*', '/', '**', representing arithmetic operators - '<', '>', '>=', '<=', representing comparison operators - '<=>', '^', representing logical equality and XOR - N-ary (0 or more args) op: - '&', '|', representing conjunction and disjunction - A symbol, representing a function term or FOL proposition - - Exprs can be constructed with operator overloading: if x and y are Exprs, - then so are x + y and x & y, etc. Also, if F and x are Exprs, then so is - F(x); it works by overloading the __call__ method of the Expr F. Note - that in the Expr that is created by F(x), the op is the str 'F', not the - Expr F. See http://www.python.org/doc/current/ref/specialnames.html - to learn more about operator overloading in Python. - - WARNING: x == y and x != y are NOT Exprs. The reason is that we want - to write code that tests 'if x == y:' and if x == y were the same - as Expr('==', x, y), then the result would always be true; not what a - programmer would expect. But we still need to form Exprs representing - equalities and disequalities. We concentrate on logical equality (or - equivalence) and logical disequality (or XOR). You have 3 choices: - (1) Expr('<=>', x, y) and Expr('^', x, y) - Note that ^ is bitwose XOR in Python (and Java and C++) - (2) expr('x <=> y') and expr('x =/= y'). - See the doc string for the function expr. - (3) (x % y) and (x ^ y). - It is very ugly to have (x % y) mean (x <=> y), but we need - SOME operator to make (2) work, and this seems the best choice. - - WARNING: if x is an Expr, then so is x + 1, because the int 1 gets - coerced to an Expr by the constructor. But 1 + x is an error, because - 1 doesn't know how to add an Expr. (Adding an __radd__ method to Expr - wouldn't help, because int.__add__ is still called first.) Therefore, - you should use Expr(1) + x instead, or ONE + x, or expr('1 + x'). - """ - - def __init__(self, op, *args): - "Op is a string or number; args are Exprs (or are coerced to Exprs)." - assert isinstance(op, str) or (isnumber(op) and not args) - self.op = num_or_str(op) - self.args = map(expr, args) ## Coerce args to Exprs - - def __call__(self, *args): - """Self must be a symbol with no args, such as Expr('F'). Create a new - Expr with 'F' as op and the args as arguments.""" - assert is_symbol(self.op) and not self.args - return Expr(self.op, *args) - - def __repr__(self): - "Show something like 'P' or 'P(x, y)', or '~P' or '(P | Q | R)'" - if len(self.args) == 0: # Constant or proposition with arity 0 - return str(self.op) - elif is_symbol(self.op): # Functional or Propositional operator - return '%s(%s)' % (self.op, ', '.join(map(repr, self.args))) - elif len(self.args) == 1: # Prefix operator - return self.op + repr(self.args[0]) - else: # Infix operator - return '(%s)' % (' '+self.op+' ').join(map(repr, self.args)) - - def __eq__(self, other): - """x and y are equal iff their ops and args are equal.""" - return (other is self) or (isinstance(other, Expr) - and self.op == other.op and self.args == other.args) - - def __hash__(self): - "Need a hash method so Exprs can live in dicts." - return hash(self.op) ^ hash(tuple(self.args)) - - # See http://www.python.org/doc/current/lib/module-operator.html - # Not implemented: not, abs, pos, concat, contains, *item, *slice - def __lt__(self, other): return Expr('<', self, other) - def __le__(self, other): return Expr('<=', self, other) - def __ge__(self, other): return Expr('>=', self, other) - def __gt__(self, other): return Expr('>', self, other) - def __add__(self, other): return Expr('+', self, other) - def __sub__(self, other): return Expr('-', self, other) - def __and__(self, other): return Expr('&', self, other) - def __div__(self, other): return Expr('/', self, other) - def __truediv__(self, other):return Expr('/', self, other) - def __invert__(self): return Expr('~', self) - def __lshift__(self, other): return Expr('<<', self, other) - def __rshift__(self, other): return Expr('>>', self, other) - def __mul__(self, other): return Expr('*', self, other) - def __neg__(self): return Expr('-', self) - def __or__(self, other): return Expr('|', self, other) - def __pow__(self, other): return Expr('**', self, other) - def __xor__(self, other): return Expr('^', self, other) - def __mod__(self, other): return Expr('<=>', self, other) ## (x % y) - - - -def expr(s): - """Create an Expr representing a logic expression by parsing the input - string. Symbols and numbers are automatically converted to Exprs. - In addition you can use alternative spellings of these operators: - 'x ==> y' parses as (x >> y) # Implication - 'x <== y' parses as (x << y) # Reverse implication - 'x <=> y' parses as (x % y) # Logical equivalence - 'x =/= y' parses as (x ^ y) # Logical disequality (xor) - But BE CAREFUL; precedence of implication is wrong. expr('P & Q ==> R & S') - is ((P & (Q >> R)) & S); so you must use expr('(P & Q) ==> (R & S)'). - >>> expr('P <=> Q(1)') - (P <=> Q(1)) - >>> expr('P & Q | ~R(x, F(x))') - ((P & Q) | ~R(x, F(x))) - """ - if isinstance(s, Expr): return s - if isnumber(s): return Expr(s) - ## Replace the alternative spellings of operators with canonical spellings - s = s.replace('==>', '>>').replace('<==', '<<') - s = s.replace('<=>', '%').replace('=/=', '^') - ## Replace a symbol or number, such as 'P' with 'Expr("P")' - s = re.sub(r'([a-zA-Z0-9_.]+)', r'Expr("\1")', s) - ## Now eval the string. (A security hole; do not use with an adversary.) - return eval(s, {'Expr':Expr}) - -def is_symbol(s): - "A string s is a symbol if it starts with an alphabetic char." - return isinstance(s, str) and s[0].isalpha() - -def is_var_symbol(s): - "A logic variable symbol is an initial-lowercase string." - return is_symbol(s) and s[0].islower() - -def is_prop_symbol(s): - """A proposition logic symbol is an initial-uppercase string other than - TRUE or FALSE.""" - return is_symbol(s) and s[0].isupper() and s != 'TRUE' and s != 'FALSE' - - -## Useful constant Exprs used in examples and code: -TRUE, FALSE, ZERO, ONE, TWO = map(Expr, ['TRUE', 'FALSE', 0, 1, 2]) -A, B, C, F, G, P, Q, x, y, z = map(Expr, 'ABCFGPQxyz') - -#______________________________________________________________________________ - -def tt_entails(kb, alpha): - """Use truth tables to determine if KB entails sentence alpha. [Fig. 7.10] - >>> tt_entails(expr('P & Q'), expr('Q')) - True - """ - return tt_check_all(kb, alpha, prop_symbols(kb & alpha), {}) - -def tt_check_all(kb, alpha, symbols, model): - "Auxiliary routine to implement tt_entails." - if not symbols: - if pl_true(kb, model): return pl_true(alpha, model) - else: return True - assert result != None - else: - P, rest = symbols[0], symbols[1:] - return (tt_check_all(kb, alpha, rest, extend(model, P, True)) and - tt_check_all(kb, alpha, rest, extend(model, P, False))) - -def prop_symbols(x): - "Return a list of all propositional symbols in x." - if not isinstance(x, Expr): - return [] - elif is_prop_symbol(x.op): - return [x] - else: - s = set(()) - for arg in x.args: - for symbol in prop_symbols(arg): - s.add(symbol) - return list(s) - -def tt_true(alpha): - """Is the sentence alpha a tautology? (alpha will be coerced to an expr.) - >>> tt_true(expr("(P >> Q) <=> (~P | Q)")) - True - """ - return tt_entails(TRUE, expr(alpha)) - -def pl_true(exp, model={}): - """Return True if the propositional logic expression is true in the model, - and False if it is false. If the model does not specify the value for - every proposition, this may return None to indicate 'not obvious'; - this may happen even when the expression is tautological.""" - op, args = exp.op, exp.args - if exp == TRUE: - return True - elif exp == FALSE: - return False - elif is_prop_symbol(op): - return model.get(exp) - elif op == '~': - p = pl_true(args[0], model) - if p == None: return None - else: return not p - elif op == '|': - result = False - for arg in args: - p = pl_true(arg, model) - if p == True: return True - if p == None: result = None - return result - elif op == '&': - result = True - for arg in args: - p = pl_true(arg, model) - if p == False: return False - if p == None: result = None - return result - p, q = args - if op == '>>': - return pl_true(~p | q, model) - elif op == '<<': - return pl_true(p | ~q, model) - pt = pl_true(p, model) - if pt == None: return None - qt = pl_true(q, model) - if qt == None: return None - if op == '<=>': - return pt == qt - elif op == '^': - return pt != qt - else: - raise ValueError, "illegal operator in logic expression" + str(exp) - -#______________________________________________________________________________ - -## Convert to Conjunctive Normal Form (CNF) - -def to_cnf(s): - """Convert a propositional logical sentence s to conjunctive normal form. - That is, of the form ((A | ~B | ...) & (B | C | ...) & ...) [p. 215] - >>> to_cnf("~(B|C)") - (~B & ~C) - >>> to_cnf("B <=> (P1|P2)") - ((~P1 | B) & (~P2 | B) & (P1 | P2 | ~B)) - >>> to_cnf("a | (b & c) | d") - ((b | a | d) & (c | a | d)) - >>> to_cnf("A & (B | (D & E))") - (A & (D | B) & (E | B)) - """ - if isinstance(s, str): s = expr(s) - s = eliminate_implications(s) # Steps 1, 2 from p. 215 - s = move_not_inwards(s) # Step 3 - return distribute_and_over_or(s) # Step 4 - -def eliminate_implications(s): - """Change >>, <<, and <=> into &, |, and ~. That is, return an Expr - that is equivalent to s, but has only &, |, and ~ as logical operators. - >>> eliminate_implications(A >> (~B << C)) - ((~B | ~C) | ~A) - """ - if not s.args or is_symbol(s.op): return s ## (Atoms are unchanged.) - args = map(eliminate_implications, s.args) - a, b = args[0], args[-1] - if s.op == '>>': - return (b | ~a) - elif s.op == '<<': - return (a | ~b) - elif s.op == '<=>': - return (a | ~b) & (b | ~a) - else: - return Expr(s.op, *args) - -def move_not_inwards(s): - """Rewrite sentence s by moving negation sign inward. - >>> move_not_inwards(~(A | B)) - (~A & ~B) - >>> move_not_inwards(~(A & B)) - (~A | ~B) - >>> move_not_inwards(~(~(A | ~B) | ~~C)) - ((A | ~B) & ~C) - """ - if s.op == '~': - NOT = lambda b: move_not_inwards(~b) - a = s.args[0] - if a.op == '~': return move_not_inwards(a.args[0]) # ~~A ==> A - if a.op =='&': return NaryExpr('|', *map(NOT, a.args)) - if a.op =='|': return NaryExpr('&', *map(NOT, a.args)) - return s - elif is_symbol(s.op) or not s.args: - return s - else: - return Expr(s.op, *map(move_not_inwards, s.args)) - -def distribute_and_over_or(s): - """Given a sentence s consisting of conjunctions and disjunctions - of literals, return an equivalent sentence in CNF. - >>> distribute_and_over_or((A & B) | C) - ((A | C) & (B | C)) - """ - if s.op == '|': - s = NaryExpr('|', *s.args) - if len(s.args) == 0: - return FALSE - if len(s.args) == 1: - return distribute_and_over_or(s.args[0]) - conj = find_if((lambda d: d.op == '&'), s.args) - if not conj: - return NaryExpr(s.op, *s.args) - others = [a for a in s.args if a is not conj] - if len(others) == 1: - rest = others[0] - else: - rest = NaryExpr('|', *others) - return NaryExpr('&', *map(distribute_and_over_or, - [(c|rest) for c in conj.args])) - elif s.op == '&': - return NaryExpr('&', *map(distribute_and_over_or, s.args)) - else: - return s - -_NaryExprTable = {'&':TRUE, '|':FALSE, '+':ZERO, '*':ONE} - -def NaryExpr(op, *args): - """Create an Expr, but with an nary, associative op, so we can promote - nested instances of the same op up to the top level. - >>> NaryExpr('&', (A&B),(B|C),(B&C)) - (A & B & (B | C) & B & C) - """ - arglist = [] - for arg in args: - if arg.op == op: arglist.extend(arg.args) - else: arglist.append(arg) - if len(args) == 1: - return args[0] - elif len(args) == 0: - return _NaryExprTable[op] - else: - return Expr(op, *arglist) - -def conjuncts(s): - """Return a list of the conjuncts in the sentence s. - >>> conjuncts(A & B) - [A, B] - >>> conjuncts(A | B) - [(A | B)] - """ - if isinstance(s, Expr) and s.op == '&': - return s.args - else: - return [s] - -def disjuncts(s): - """Return a list of the disjuncts in the sentence s. - >>> disjuncts(A | B) - [A, B] - >>> disjuncts(A & B) - [(A & B)] - """ - if isinstance(s, Expr) and s.op == '|': - return s.args - else: - return [s] - -#______________________________________________________________________________ - -def pl_resolution(KB, alpha): - "Propositional Logic Resolution: say if alpha follows from KB. [Fig. 7.12]" - clauses = KB.clauses + conjuncts(to_cnf(~alpha)) - new = set() - while True: - n = len(clauses) - pairs = [(clauses[i], clauses[j]) for i in range(n) for j in range(i+1, n)] - for (ci, cj) in pairs: - resolvents = pl_resolve(ci, cj) - if FALSE in resolvents: return True - new.union_update(set(resolvents)) - if new.issubset(set(clauses)): return False - for c in new: - if c not in clauses: clauses.append(c) - -def pl_resolve(ci, cj): - """Return all clauses that can be obtained by resolving clauses ci and cj. - >>> pl_resolve(to_cnf(A|B|C), to_cnf(~B|~C|F)) - [(A | C | ~C | F), (A | B | ~B | F)] - """ - clauses = [] - for di in disjuncts(ci): - for dj in disjuncts(cj): - if di == ~dj or ~di == dj: - dnew = unique(removeall(di, disjuncts(ci)) + - removeall(dj, disjuncts(cj))) - clauses.append(NaryExpr('|', *dnew)) - return clauses - -#______________________________________________________________________________ - -class PropHornKB(PropKB): - "A KB of Propositional Horn clauses." - - def tell(self, sentence): - "Add a Horn Clauses to this KB." - op = sentence.op - assert op == '>>' or is_prop_symbol(op), "Must be Horn Clause" - self.clauses.append(sentence) - - def ask_generator(self, query): - "Yield the empty substitution if KB implies query; else False" - if not pl_fc_entails(self.clauses, query): - return - yield {} - - def retract(self, sentence): - "Remove the sentence's clauses from the KB" - for c in conjuncts(to_cnf(sentence)): - if c in self.clauses: - self.clauses.remove(c) - - def clauses_with_premise(self, p): - """The list of clauses in KB that have p in the premise. - This could be cached away for O(1) speed, but we'll recompute it.""" - return [c for c in self.clauses - if c.op == '>>' and p in conjuncts(c.args[0])] - -def pl_fc_entails(KB, q): - """Use forward chaining to see if a HornKB entails symbol q. [Fig. 7.14] - >>> pl_fc_entails(Fig[7,15], expr('Q')) - True - """ - count = dict([(c, len(conjuncts(c.args[0]))) for c in KB.clauses - if c.op == '>>']) - inferred = DefaultDict(False) - agenda = [s for s in KB.clauses if is_prop_symbol(s.op)] - if q in agenda: return True - while agenda: - p = agenda.pop() - if not inferred[p]: - inferred[p] = True - for c in KB.clauses_with_premise(p): - count[c] -= 1 - if count[c] == 0: - if c.args[1] == q: return True - agenda.append(c.args[1]) - return False - -## Wumpus World example [Fig. 7.13] -Fig[7,13] = expr("(B11 <=> (P12 | P21)) & ~B11") - -## Propositional Logic Forward Chanining example [Fig. 7.15] -Fig[7,15] = PropHornKB() -for s in "P>>Q (L&M)>>P (B&L)>>M (A&P)>>L (A&B)>>L A B".split(): - Fig[7,15].tell(expr(s)) - -#______________________________________________________________________________ - -# DPLL-Satisfiable [Fig. 7.16] - -def dpll_satisfiable(s): - """Check satisfiability of a propositional sentence. - This differs from the book code in two ways: (1) it returns a model - rather than True when it succeeds; this is more useful. (2) The - function find_pure_symbol is passed a list of unknown clauses, rather - than a list of all clauses and the model; this is more efficient. - >>> dpll_satisfiable(A&~B) - {A: True, B: False} - >>> dpll_satisfiable(P&~P) - False - """ - clauses = conjuncts(to_cnf(s)) - symbols = prop_symbols(s) - return dpll(clauses, symbols, {}) - -def dpll(clauses, symbols, model): - "See if the clauses are true in a partial model." - unknown_clauses = [] ## clauses with an unknown truth value - for c in clauses: - val = pl_true(c, model) - if val == False: - return False - if val != True: - unknown_clauses.append(c) - if not unknown_clauses: - return model - P, value = find_pure_symbol(symbols, unknown_clauses) - if P: - return dpll(clauses, removeall(P, symbols), extend(model, P, value)) - P, value = find_unit_clause(clauses, model) - if P: - return dpll(clauses, removeall(P, symbols), extend(model, P, value)) - P = symbols.pop() - return (dpll(clauses, symbols, extend(model, P, True)) or - dpll(clauses, symbols, extend(model, P, False))) - -def find_pure_symbol(symbols, unknown_clauses): - """Find a symbol and its value if it appears only as a positive literal - (or only as a negative) in clauses. - >>> find_pure_symbol([A, B, C], [A|~B,~B|~C,C|A]) - (A, True) - """ - for s in symbols: - found_pos, found_neg = False, False - for c in unknown_clauses: - if not found_pos and s in disjuncts(c): found_pos = True - if not found_neg and ~s in disjuncts(c): found_neg = True - if found_pos != found_neg: return s, found_pos - return None, None - -def find_unit_clause(clauses, model): - """A unit clause has only 1 variable that is not bound in the model. - >>> find_unit_clause([A|B|C, B|~C, A|~B], {A:True}) - (B, False) - """ - for clause in clauses: - num_not_in_model = 0 - for literal in disjuncts(clause): - sym = literal_symbol(literal) - if sym not in model: - num_not_in_model += 1 - P, value = sym, (literal.op != '~') - if num_not_in_model == 1: - return P, value - return None, None - - -def literal_symbol(literal): - """The symbol in this literal (without the negation). - >>> literal_symbol(P) - P - >>> literal_symbol(~P) - P - """ - if literal.op == '~': - return literal.args[0] - else: - return literal - - -#______________________________________________________________________________ -# Walk-SAT [Fig. 7.17] - -def WalkSAT(clauses, p=0.5, max_flips=10000): - ## model is a random assignment of true/false to the symbols in clauses - ## See ~/aima1e/print1/manual/knowledge+logic-answers.tex ??? - model = dict([(s, random.choice([True, False])) - for s in prop_symbols(clauses)]) - for i in range(max_flips): - satisfied, unsatisfied = [], [] - for clause in clauses: - if_(pl_true(clause, model), satisfied, unsatisfied).append(clause) - if not unsatisfied: ## if model satisfies all the clauses - return model - clause = random.choice(unsatisfied) - if probability(p): - sym = random.choice(prop_symbols(clause)) - else: - ## Flip the symbol in clause that miximizes number of sat. clauses - raise NotImplementedError - model[sym] = not model[sym] - - -# PL-Wumpus-Agent [Fig. 7.19] -class PLWumpusAgent(agents.Agent): - "An agent for the wumpus world that does logical inference. [Fig. 7.19]""" - def __init__(self): - KB = FOLKB() - x, y, orientation = 1, 1, (1, 0) - visited = set() ## squares already visited - action = None - plan = [] - - def program(percept): - stench, breeze, glitter = percept - x, y, orientation = update_position(x, y, orientation, action) - KB.tell('%sS_%d,%d' % (if_(stench, '', '~'), x, y)) - KB.tell('%sB_%d,%d' % (if_(breeze, '', '~'), x, y)) - if glitter: action = 'Grab' - elif plan: action = plan.pop() - else: - for [i, j] in fringe(visited): - if KB.ask('~P_%d,%d & ~W_%d,%d' % (i, j, i, j)) != False: - raise NotImplementedError - KB.ask('~P_%d,%d | ~W_%d,%d' % (i, j, i, j)) != False - if action == None: - action = random.choice(['Forward', 'Right', 'Left']) - return action - - self.program = program - -def update_position(x, y, orientation, action): - if action == 'TurnRight': - orientation = turn_right(orientation) - elif action == 'TurnLeft': - orientation = turn_left(orientation) - elif action == 'Forward': - x, y = x + vector_add((x, y), orientation) - return x, y, orientation - -#______________________________________________________________________________ - -def unify(x, y, s): - """Unify expressions x,y with substitution s; return a substitution that - would make x,y equal, or None if x,y can not unify. x and y can be - variables (e.g. Expr('x')), constants, lists, or Exprs. [Fig. 9.1] - >>> unify(x + y, y + C, {}) - {y: C, x: y} - """ - if s == None: - return None - elif x == y: - return s - elif is_variable(x): - return unify_var(x, y, s) - elif is_variable(y): - return unify_var(y, x, s) - elif isinstance(x, Expr) and isinstance(y, Expr): - return unify(x.args, y.args, unify(x.op, y.op, s)) - elif isinstance(x, str) or isinstance(y, str) or not x or not y: - return if_(x == y, s, None) - elif issequence(x) and issequence(y) and len(x) == len(y): - return unify(x[1:], y[1:], unify(x[0], y[0], s)) - else: - return None - -def is_variable(x): - "A variable is an Expr with no args and a lowercase symbol as the op." - return isinstance(x, Expr) and not x.args and is_var_symbol(x.op) - -def unify_var(var, x, s): - if var in s: - return unify(s[var], x, s) - elif occur_check(var, x): - return None - else: - return extend(s, var, x) - -def occur_check(var, x): - "Return true if var occurs anywhere in x." - if var == x: - return True - elif isinstance(x, Expr): - return var.op == x.op or occur_check(var, x.args) - elif not isinstance(x, str) and issequence(x): - for xi in x: - if occur_check(var, xi): return True - return False - -def extend(s, var, val): - """Copy the substitution s and extend it by setting var to val; return copy. - >>> extend({x: 1}, y, 2) - {y: 2, x: 1} - """ - s2 = s.copy() - s2[var] = val - return s2 - -def subst(s, x): - """Substitute the substitution s into the expression x. - >>> subst({x: 42, y:0}, F(x) + y) - (F(42) + 0) - """ - if isinstance(x, list): - return [subst(s, xi) for xi in x] - elif isinstance(x, tuple): - return tuple([subst(s, xi) for xi in x]) - elif not isinstance(x, Expr): - return x - elif is_var_symbol(x.op): - return s.get(x, x) - else: - return Expr(x.op, *[subst(s, arg) for arg in x.args]) - -def fol_fc_ask(KB, alpha): - """Inefficient forward chaining for first-order logic. [Fig. 9.3] - KB is an FOLHornKB and alpha must be an atomic sentence.""" - while True: - new = {} - for r in KB.clauses: - r1 = standardize_apart(r) - ps, q = conjuncts(r.args[0]), r.args[1] - raise NotImplementedError - -def standardize_apart(sentence, dic): - """Replace all the variables in sentence with new variables.""" - if not isinstance(sentence, Expr): - return sentence - elif is_var_symbol(sentence.op): - if sentence in dic: - return dic[sentence] - else: - standardize_apart.counter += 1 - dic[sentence] = Expr('V_%d' % standardize-apart.counter) - return dic[sentence] - else: - return Expr(sentence.op, *[standardize-apart(a, dic) for a in sentence.args]) - -standardize_apart.counter = 0 - -def fol_bc_ask(KB, goals, theta): - "A simple backward-chaining algorithm for first-order logic. [Fig. 9.6]" - if not goals: - yield theta - q1 = subst(theta, goals[0]) - raise NotImplementedError - -#______________________________________________________________________________ - -# Example application (not in the book). -# You can use the Expr class to do symbolic differentiation. This used to be -# a part of AI; now it is considered a separate field, Symbolic Algebra. - -def diff(y, x): - """Return the symbolic derivative, dy/dx, as an Expr. - However, you probably want to simplify the results with simp. - >>> diff(x * x, x) - ((x * 1) + (x * 1)) - >>> simp(diff(x * x, x)) - (2 * x) - """ - if y == x: return ONE - elif not y.args: return ZERO - else: - u, op, v = y.args[0], y.op, y.args[-1] - if op == '+': return diff(u, x) + diff(v, x) - elif op == '-' and len(args) == 1: return -diff(u, x) - elif op == '-': return diff(u, x) - diff(v, x) - elif op == '*': return u * diff(v, x) + v * diff(u, x) - elif op == '/': return (v*diff(u, x) - u*diff(v, x)) / (v * v) - elif op == '**' and isnumber(x.op): - return (v * u ** (v - 1) * diff(u, x)) - elif op == '**': return (v * u ** (v - 1) * diff(u, x) - + u ** v * Expr('log')(u) * diff(v, x)) - elif op == 'log': return diff(u, x) / u - else: raise ValueError("Unknown op: %s in diff(%s, %s)" % (op, y, x)) - -def simp(x): - if not x.args: return x - args = map(simp, x.args) - u, op, v = args[0], x.op, args[-1] - if op == '+': - if v == ZERO: return u - if u == ZERO: return v - if u == v: return TWO * u - if u == -v or v == -u: return ZERO - elif op == '-' and len(args) == 1: - if u.op == '-' and len(u.args) == 1: return u.args[0] ## --y ==> y - elif op == '-': - if v == ZERO: return u - if u == ZERO: return -v - if u == v: return ZERO - if u == -v or v == -u: return ZERO - elif op == '*': - if u == ZERO or v == ZERO: return ZERO - if u == ONE: return v - if v == ONE: return u - if u == v: return u ** 2 - elif op == '/': - if u == ZERO: return ZERO - if v == ZERO: return Expr('Undefined') - if u == v: return ONE - if u == -v or v == -u: return ZERO - elif op == '**': - if u == ZERO: return ZERO - if v == ZERO: return ONE - if u == ONE: return ONE - if v == ONE: return u - elif op == 'log': - if u == ONE: return ZERO - else: raise ValueError("Unknown op: " + op) - ## If we fall through to here, we can not simplify further - return Expr(op, *args) - -def d(y, x): - "Differentiate and then simplify." - return simp(diff(y, x)) - diff --git a/csp/aima/logic.txt b/csp/aima/logic.txt deleted file mode 100644 index 18b2d856..00000000 --- a/csp/aima/logic.txt +++ /dev/null @@ -1,78 +0,0 @@ -### PropKB ->>> kb = PropKB() ->>> kb.tell(A & B) ->>> kb.tell(B >> C) ->>> kb.ask(C) ## The result {} means true, with no substitutions -{} ->>> kb.ask(P) -False ->>> kb.retract(B) ->>> kb.ask(C) -False - ->>> pl_true(P, {}) ->>> pl_true(P | Q, {P: True}) -True - -# Notice that the function pl_true cannot reason by cases: ->>> pl_true(P | ~P) - -# However, tt_true can: ->>> tt_true(P | ~P) -True - -# The following are tautologies from [Fig. 7.11]: ->>> tt_true("(A & B) <=> (B & A)") -True ->>> tt_true("(A | B) <=> (B | A)") -True ->>> tt_true("((A & B) & C) <=> (A & (B & C))") -True ->>> tt_true("((A | B) | C) <=> (A | (B | C))") -True ->>> tt_true("~~A <=> A") -True ->>> tt_true("(A >> B) <=> (~B >> ~A)") -True ->>> tt_true("(A >> B) <=> (~A | B)") -True ->>> tt_true("(A <=> B) <=> ((A >> B) & (B >> A))") -True ->>> tt_true("~(A & B) <=> (~A | ~B)") -True ->>> tt_true("~(A | B) <=> (~A & ~B)") -True ->>> tt_true("(A & (B | C)) <=> ((A & B) | (A & C))") -True ->>> tt_true("(A | (B & C)) <=> ((A | B) & (A | C))") -True - -# The following are not tautologies: ->>> tt_true(A & ~A) -False ->>> tt_true(A & B) -False - -### [Fig. 7.13] ->>> alpha = expr("~P12") ->>> to_cnf(Fig[7,13] & ~alpha) -((~P12 | B11) & (~P21 | B11) & (P12 | P21 | ~B11) & ~B11 & P12) ->>> tt_entails(Fig[7,13], alpha) -True ->>> pl_resolution(PropKB(Fig[7,13]), alpha) -True - -### [Fig. 7.15] ->>> pl_fc_entails(Fig[7,15], expr('SomethingSilly')) -False - -### Unification: ->>> unify(x, x, {}) -{} ->>> unify(x, 3, {}) -{x: 3} - - ->>> to_cnf((P&Q) | (~P & ~Q)) -((~P | P) & (~Q | P) & (~P | Q) & (~Q | Q)) - diff --git a/csp/aima/mdp.py b/csp/aima/mdp.py deleted file mode 100644 index 8bd410b1..00000000 --- a/csp/aima/mdp.py +++ /dev/null @@ -1,142 +0,0 @@ -"""Markov Decision Processes (Chapter 17) - -First we define an MDP, and the special case of a GridMDP, in which -states are laid out in a 2-dimensional grid. We also represent a policy -as a dictionary of {state:action} pairs, and a Utility function as a -dictionary of {state:number} pairs. We then define the value_iteration -and policy_iteration algorithms.""" - -from utils import * - -class MDP: - """A Markov Decision Process, defined by an initial state, transition model, - and reward function. We also keep track of a gamma value, for use by - algorithms. The transition model is represented somewhat differently from - the text. Instead of T(s, a, s') being probability number for each - state/action/state triplet, we instead have T(s, a) return a list of (p, s') - pairs. We also keep track of the possible states, terminal states, and - actions for each state. [page 615]""" - - def __init__(self, init, actlist, terminals, gamma=.9): - update(self, init=init, actlist=actlist, terminals=terminals, - gamma=gamma, states=set(), reward={}) - - def R(self, state): - "Return a numeric reward for this state." - return self.reward[state] - - def T(state, action): - """Transition model. From a state and an action, return a list - of (result-state, probability) pairs.""" - abstract - - def actions(self, state): - """Set of actions that can be performed in this state. By default, a - fixed list of actions, except for terminal states. Override this - method if you need to specialize by state.""" - if state in self.terminals: - return [None] - else: - return self.actlist - -class GridMDP(MDP): - """A two-dimensional grid MDP, as in [Figure 17.1]. All you have to do is - specify the grid as a list of lists of rewards; use None for an obstacle - (unreachable state). Also, you should specify the terminal states. - An action is an (x, y) unit vector; e.g. (1, 0) means move east.""" - def __init__(self, grid, terminals, init=(0, 0), gamma=.9): - grid.reverse() ## because we want row 0 on bottom, not on top - MDP.__init__(self, init, actlist=orientations, - terminals=terminals, gamma=gamma) - update(self, grid=grid, rows=len(grid), cols=len(grid[0])) - for x in range(self.cols): - for y in range(self.rows): - self.reward[x, y] = grid[y][x] - if grid[y][x] is not None: - self.states.add((x, y)) - - def T(self, state, action): - if action == None: - return [(0.0, state)] - else: - return [(0.8, self.go(state, action)), - (0.1, self.go(state, turn_right(action))), - (0.1, self.go(state, turn_left(action)))] - - def go(self, state, direction): - "Return the state that results from going in this direction." - state1 = vector_add(state, direction) - return if_(state1 in self.states, state1, state) - - def to_grid(self, mapping): - """Convert a mapping from (x, y) to v into a [[..., v, ...]] grid.""" - return list(reversed([[mapping.get((x,y), None) - for x in range(self.cols)] - for y in range(self.rows)])) - - def to_arrows(self, policy): - chars = {(1, 0):'>', (0, 1):'^', (-1, 0):'<', (0, -1):'v', None: '.'} - return self.to_grid(dict([(s, chars[a]) for (s, a) in policy.items()])) - -#______________________________________________________________________________ - -Fig[17,1] = GridMDP([[-0.04, -0.04, -0.04, +1], - [-0.04, None, -0.04, -1], - [-0.04, -0.04, -0.04, -0.04]], - terminals=[(3, 2), (3, 1)]) - -#______________________________________________________________________________ - -def value_iteration(mdp, epsilon=0.001): - "Solving an MDP by value iteration. [Fig. 17.4]" - U1 = dict([(s, 0) for s in mdp.states]) - R, T, gamma = mdp.R, mdp.T, mdp.gamma - while True: - U = U1.copy() - delta = 0 - for s in mdp.states: - U1[s] = R(s) + gamma * max([sum([p * U[s1] for (p, s1) in T(s, a)]) - for a in mdp.actions(s)]) - delta = max(delta, abs(U1[s] - U[s])) - if delta < epsilon * (1 - gamma) / gamma: - return U - -def best_policy(mdp, U): - """Given an MDP and a utility function U, determine the best policy, - as a mapping from state to action. (Equation 17.4)""" - pi = {} - for s in mdp.states: - pi[s] = argmax(mdp.actions(s), lambda a:expected_utility(a, s, U, mdp)) - return pi - -def expected_utility(a, s, U, mdp): - "The expected utility of doing a in state s, according to the MDP and U." - return sum([p * U[s1] for (p, s1) in mdp.T(s, a)]) - -#______________________________________________________________________________ - -def policy_iteration(mdp): - "Solve an MDP by policy iteration [Fig. 17.7]" - U = dict([(s, 0) for s in mdp.states]) - pi = dict([(s, random.choice(mdp.actions(s))) for s in mdp.states]) - while True: - U = policy_evaluation(pi, U, mdp) - unchanged = True - for s in mdp.states: - a = argmax(mdp.actions(s), lambda a: expected_utility(a,s,U,mdp)) - if a != pi[s]: - pi[s] = a - unchanged = False - if unchanged: - return pi - -def policy_evaluation(pi, U, mdp, k=20): - """Return an updated utility mapping U from each state in the MDP to its - utility, using an approximation (modified policy iteration).""" - R, T, gamma = mdp.R, mdp.T, mdp.gamma - for i in range(k): - for s in mdp.states: - U[s] = R(s) + gamma * sum([p * U[s] for (p, s1) in T(s, pi[s])]) - return U - - diff --git a/csp/aima/mdp.txt b/csp/aima/mdp.txt deleted file mode 100644 index a12c11f7..00000000 --- a/csp/aima/mdp.txt +++ /dev/null @@ -1,27 +0,0 @@ -### demo - ->>> m = Fig[17,1] - ->>> pi = best_policy(m, value_iteration(m, .01)) - ->>> pi -{(3, 2): None, (3, 1): None, (3, 0): (-1, 0), (2, 1): (0, 1), (0, 2): (1, 0), (1, 0): (1, 0), (0, 0): (0, 1), (1, 2): (1, 0), (2, 0): (0, 1), (0, 1): (0, 1), (2, 2): (1, 0)} - ->>> m.to_arrows(pi) -[['>', '>', '>', '.'], ['^', None, '^', '.'], ['^', '>', '^', '<']] - ->>> print_table(m.to_arrows(pi)) -> > > . -^ None ^ . -^ > ^ < - ->>> value_iteration(m, .01) -{(3, 2): 1.0, (3, 1): -1.0, (3, 0): 0.12958868267972745, (0, 1): 0.39810203830605462, (0, 2): 0.50928545646220924, (1, 0): 0.25348746162470537, (0, 0): 0.29543540628363629, (1, 2): 0.64958064617168676, (2, 0): 0.34461306281476806, (2, 1): 0.48643676237737926, (2, 2): 0.79536093684710951} - ->>> policy_iteration(m) -{(3, 2): None, (3, 1): None, (3, 0): (0, -1), (2, 1): (-1, 0), (0, 2): (1, 0), (1, 0): (1, 0), (0, 0): (1, 0), (1, 2): (1, 0), (2, 0): (1, 0), (0, 1): (1, 0), (2, 2): (1, 0)} - ->>> print_table(m.to_arrows(policy_iteration(m))) -> > > . -> None < . -> > > v diff --git a/csp/aima/nlp.py b/csp/aima/nlp.py deleted file mode 100644 index c7880c46..00000000 --- a/csp/aima/nlp.py +++ /dev/null @@ -1,170 +0,0 @@ -"""A chart parser and some grammars. (Chapter 22)""" - -from utils import * - -#______________________________________________________________________________ -# Grammars and Lexicons - -def Rules(**rules): - """Create a dictionary mapping symbols to alternative sequences. - >>> Rules(A = "B C | D E") - {'A': [['B', 'C'], ['D', 'E']]} - """ - for (lhs, rhs) in rules.items(): - rules[lhs] = [alt.strip().split() for alt in rhs.split('|')] - return rules - -def Lexicon(**rules): - """Create a dictionary mapping symbols to alternative words. - >>> Lexicon(Art = "the | a | an") - {'Art': ['the', 'a', 'an']} - """ - for (lhs, rhs) in rules.items(): - rules[lhs] = [word.strip() for word in rhs.split('|')] - return rules - -class Grammar: - def __init__(self, name, rules, lexicon): - "A grammar has a set of rules and a lexicon." - update(self, name=name, rules=rules, lexicon=lexicon) - self.categories = DefaultDict([]) - for lhs in lexicon: - for word in lexicon[lhs]: - self.categories[word].append(lhs) - - def rewrites_for(self, cat): - "Return a sequence of possible rhs's that cat can be rewritten as." - return self.rules.get(cat, ()) - - def isa(self, word, cat): - "Return True iff word is of category cat" - return cat in self.categories[word] - - def __repr__(self): - return '' % self.name - -E0 = Grammar('E0', - Rules( # Grammar for E_0 [Fig. 22.4] - S = 'NP VP | S Conjunction S', - NP = 'Pronoun | Noun | Article Noun | Digit Digit | NP PP | NP RelClause', - VP = 'Verb | VP NP | VP Adjective | VP PP | VP Adverb', - PP = 'Preposition NP', - RelClause = 'That VP'), - - Lexicon( # Lexicon for E_0 [Fig. 22.3] - Noun = "stench | breeze | glitter | nothing | wumpus | pit | pits | gold | east", - Verb = "is | see | smell | shoot | fell | stinks | go | grab | carry | kill | turn | feel", - Adjective = "right | left | east | south | back | smelly", - Adverb = "here | there | nearby | ahead | right | left | east | south | back", - Pronoun = "me | you | I | it", - Name = "John | Mary | Boston | Aristotle", - Article = "the | a | an", - Preposition = "to | in | on | near", - Conjunction = "and | or | but", - Digit = "0 | 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9", - That = "that" - )) - -E_ = Grammar('E_', # Trivial Grammar and lexicon for testing - Rules( - S = 'NP VP', - NP = 'Art N | Pronoun', - VP = 'V NP'), - - Lexicon( - Art = 'the | a', - N = 'man | woman | table | shoelace | saw', - Pronoun = 'I | you | it', - V = 'saw | liked | feel' - )) - -def generate_random(grammar=E_, s='S'): - """Replace each token in s by a random entry in grammar (recursively). - This is useful for testing a grammar, e.g. generate_random(E_)""" - import random - - def rewrite(tokens, into): - for token in tokens: - if token in grammar.rules: - rewrite(random.choice(grammar.rules[token]), into) - elif token in grammar.lexicon: - into.append(random.choice(grammar.lexicon[token])) - else: - into.append(token) - return into - - return ' '.join(rewrite(s.split(), [])) - -#______________________________________________________________________________ -# Chart Parsing - - -class Chart: - """Class for parsing sentences using a chart data structure. [Fig 22.7] - >>> chart = Chart(E0); - >>> len(chart.parses('the stench is in 2 2')) - 1 - """ - - def __init__(self, grammar, trace=False): - """A datastructure for parsing a string; and methods to do the parse. - self.chart[i] holds the edges that end just before the i'th word. - Edges are 5-element lists of [start, end, lhs, [found], [expects]].""" - update(self, grammar=grammar, trace=trace) - - def parses(self, words, S='S'): - """Return a list of parses; words can be a list or string.""" - if isinstance(words, str): - words = words.split() - self.parse(words, S) - # Return all the parses that span the whole input - return [[i, j, S, found, []] - for (i, j, lhs, found, expects) in self.chart[len(words)] - if lhs == S and expects == []] - - def parse(self, words, S='S'): - """Parse a list of words; according to the grammar. - Leave results in the chart.""" - self.chart = [[] for i in range(len(words)+1)] - self.add_edge([0, 0, 'S_', [], [S]]) - for i in range(len(words)): - self.scanner(i, words[i]) - return self.chart - - def add_edge(self, edge): - "Add edge to chart, and see if it extends or predicts another edge." - start, end, lhs, found, expects = edge - if edge not in self.chart[end]: - self.chart[end].append(edge) - if self.trace: - print '%10s: added %s' % (caller(2), edge) - if not expects: - self.extender(edge) - else: - self.predictor(edge) - - def scanner(self, j, word): - "For each edge expecting a word of this category here, extend the edge." - for (i, j, A, alpha, Bb) in self.chart[j]: - if Bb and self.grammar.isa(word, Bb[0]): - self.add_edge([i, j+1, A, alpha + [(Bb[0], word)], Bb[1:]]) - - def predictor(self, (i, j, A, alpha, Bb)): - "Add to chart any rules for B that could help extend this edge." - B = Bb[0] - if B in self.grammar.rules: - for rhs in self.grammar.rewrites_for(B): - self.add_edge([j, j, B, [], rhs]) - - def extender(self, edge): - "See what edges can be extended by this edge." - (j, k, B, _, _) = edge - for (i, j, A, alpha, B1b) in self.chart[j]: - if B1b and B == B1b[0]: - self.add_edge([i, k, A, alpha + [edge], B1b[1:]]) - - - -#### TODO: -#### 1. Parsing with augmentations -- requires unification, etc. -#### 2. Sequitor diff --git a/csp/aima/nlp.txt b/csp/aima/nlp.txt deleted file mode 100644 index 9c08a359..00000000 --- a/csp/aima/nlp.txt +++ /dev/null @@ -1,23 +0,0 @@ ->>> chart = Chart(E0) - ->>> chart.parses('the wumpus that is smelly is near 2 2') -[[0, 9, 'S', [[0, 5, 'NP', [[0, 2, 'NP', [('Article', 'the'), ('Noun', 'wumpus')], []], [2, 5, 'RelClause', [('That', 'that'), [3, 5, 'VP', [[3, 4, 'VP', [('Verb', 'is')], []], ('Adjective', 'smelly')], []]], []]], []], [5, 9, 'VP', [[5, 6, 'VP', [('Verb', 'is')], []], [6, 9, 'PP', [('Preposition', 'near'), [7, 9, 'NP', [('Digit', '2'), ('Digit', '2')], []]], []]], []]], []]] - -### There is a built-in trace facility (compare [Fig. 22.9]) ->>> Chart(E_, trace=True).parses('I feel it') - parse: added [0, 0, 'S_', [], ['S']] - predictor: added [0, 0, 'S', [], ['NP', 'VP']] - predictor: added [0, 0, 'NP', [], ['Art', 'N']] - predictor: added [0, 0, 'NP', [], ['Pronoun']] - scanner: added [0, 1, 'NP', [('Pronoun', 'I')], []] - extender: added [0, 1, 'S', [[0, 1, 'NP', [('Pronoun', 'I')], []]], ['VP']] - predictor: added [1, 1, 'VP', [], ['V', 'NP']] - scanner: added [1, 2, 'VP', [('V', 'feel')], ['NP']] - predictor: added [2, 2, 'NP', [], ['Art', 'N']] - predictor: added [2, 2, 'NP', [], ['Pronoun']] - scanner: added [2, 3, 'NP', [('Pronoun', 'it')], []] - extender: added [1, 3, 'VP', [('V', 'feel'), [2, 3, 'NP', [('Pronoun', 'it')], []]], []] - extender: added [0, 3, 'S', [[0, 1, 'NP', [('Pronoun', 'I')], []], [1, 3, 'VP', [('V', 'feel'), [2, 3, 'NP', [('Pronoun', 'it')], []]], []]], []] - extender: added [0, 3, 'S_', [[0, 3, 'S', [[0, 1, 'NP', [('Pronoun', 'I')], []], [1, 3, 'VP', [('V', 'feel'), [2, 3, 'NP', [('Pronoun', 'it')], []]], []]], []]], []] -[[0, 3, 'S', [[0, 1, 'NP', [('Pronoun', 'I')], []], [1, 3, 'VP', [('V', 'feel'), [2, 3, 'NP', [('Pronoun', 'it')], []]], []]], []]] - diff --git a/csp/aima/planning.py b/csp/aima/planning.py deleted file mode 100644 index 13dff603..00000000 --- a/csp/aima/planning.py +++ /dev/null @@ -1,7 +0,0 @@ -"""Planning (Chapters 11-12) -""" - -from __future__ import generators -from utils import * -import agents -import math, random, sys, time, bisect, string diff --git a/csp/aima/probability.py b/csp/aima/probability.py deleted file mode 100644 index d94955c6..00000000 --- a/csp/aima/probability.py +++ /dev/null @@ -1,171 +0,0 @@ -"""Probability models. (Chapter 13-15) -""" - -from utils import * -from logic import extend -import agents -import bisect, random - -#______________________________________________________________________________ - -class DTAgent(agents.Agent): - "A decision-theoretic agent. [Fig. 13.1]" - - def __init__(self, belief_state): - agents.Agent.__init__(self) - - def program(percept): - belief_state.observe(action, percept) - program.action = argmax(belief_state.actions(), - belief_state.expected_outcome_utility) - return program.action - - program.action = None - self.program = program - -#______________________________________________________________________________ - -class ProbDist: - """A discrete probability distribution. You name the random variable - in the constructor, then assign and query probability of values. - >>> P = ProbDist('Flip'); P['H'], P['T'] = 0.5, 0.5; P['H'] - 0.5 - """ - def __init__(self, varname='?'): - update(self, prob={}, varname=varname, values=[]) - - def __getitem__(self, val): - "Given a value, return P(value)." - return self.prob[val] - - def __setitem__(self, val, p): - "Set P(val) = p" - if val not in self.values: - self.values.append(val) - self.prob[val] = p - - def normalize(self): - "Make sure the probabilities of all values sum to 1." - total = sum(self.prob.values()) - if not (1.0-epsilon < total < 1.0+epsilon): - for val in self.prob: - self.prob[val] /= total - return self - -epsilon = 0.001 - -class JointProbDist(ProbDist): - """A discrete probability distribute over a set of variables. - >>> P = JointProbDist(['X', 'Y']); P[1, 1] = 0.25 - >>> P[1, 1] - 0.25 - """ - def __init__(self, variables): - update(self, prob={}, variables=variables, vals=DefaultDict([])) - - def __getitem__(self, values): - "Given a tuple or dict of values, return P(values)." - if isinstance(values, dict): - values = tuple([values[var] for var in self.variables]) - return self.prob[values] - - def __setitem__(self, values, p): - """Set P(values) = p. Values can be a tuple or a dict; it must - have a value for each of the variables in the joint. Also keep track - of the values we have seen so far for each variable.""" - if isinstance(values, dict): - values = [values[var] for var in self.variables] - self.prob[values] = p - for var,val in zip(self.variables, values): - if val not in self.vals[var]: - self.vals[var].append(val) - - def values(self, var): - "Return the set of possible values for a variable." - return self.vals[var] - - def __repr__(self): - return "P(%s)" % self.variables - -#______________________________________________________________________________ - -def enumerate_joint_ask(X, e, P): - """Return a probability distribution over the values of the variable X, - given the {var:val} observations e, in the JointProbDist P. - Works for Boolean variables only. [Fig. 13.4]""" - Q = ProbDist(X) ## A probability distribution for X, initially empty - Y = [v for v in P.variables if v != X and v not in e] - for xi in P.values(X): - Q[xi] = enumerate_joint(Y, extend(e, X, xi), P) - return Q.normalize() - -def enumerate_joint(vars, values, P): - "As in Fig 13.4, except x and e are already incorporated in values." - if not vars: - return P[values] - Y = vars[0]; rest = vars[1:] - return sum([enumerate_joint(rest, extend(values, Y, y), P) - for y in P.values(Y)]) - -#______________________________________________________________________________ - -class BayesNet: - def __init__(self, nodes=[]): - update(self, nodes=[], vars=[]) - for node in nodes: - self.add(node) - - def add(self, node): - self.nodes.append(node) - self.vars.append(node.variable) - - def observe(self, var, val): - self.evidence[var] = val - -class BayesNode: - def __init__(self, variable, parents, cpt): - if isinstance(parents, str): parents = parents.split() - update(self, variable=variable, parents=parents, cpt=cpt) - -node = BayesNode - - -T, F = True, False - -burglary = BayesNet([ - node('Burglary', '', .001), - node('Earthquake', '', .002), - node('Alarm', 'Burglary Earthquake', { - (T, T):.95, - (T, F):.94, - (F, T):.29, - (F, F):.001}), - node('JohnCalls', 'Alarm', {T:.90, F:.05}), - node('MaryCalls', 'Alarm', {T:.70, F:.01}) - ]) -#______________________________________________________________________________ - -def elimination_ask(X, e, bn): - "[Fig. 14.10]" - factors = [] - for var in reverse(bn.vars): - factors.append(Factor(var, e)) - if is_hidden(var, X, e): - factors = sum_out(var, factors) - return pointwise_product(factors).normalize() - -def pointwise_product(factors): - pass - -def sum_out(var, factors): - pass - -#______________________________________________________________________________ - -def prior_sample(bn): - x = {} - for xi in bn.vars: - x[xi.var] = xi.sample([x]) - -#______________________________________________________________________________ - diff --git a/csp/aima/probability.txt b/csp/aima/probability.txt deleted file mode 100644 index 5dfa8558..00000000 --- a/csp/aima/probability.txt +++ /dev/null @@ -1,32 +0,0 @@ -## We can build up a probability distribution like this (p. 469): ->>> P = ProbDist() ->>> P['sunny'] = 0.7 ->>> P['rain'] = 0.2 ->>> P['cloudy'] = 0.08 ->>> P['snow'] = 0.02 - -## and query it like this: ->>> P['rain'] -0.20000000000000001 - -## A Joint Probability Distribution is dealt with like this (p. 475): ->>> P = JointProbDist(['Toothache', 'Cavity', 'Catch']) ->>> T, F = True, False ->>> P[T, T, T] = 0.108; P[T, T, F] = 0.012; P[F, T, T] = 0.072; P[F, T, F] = 0.008 ->>> P[T, F, T] = 0.016; P[T, F, F] = 0.064; P[F, F, T] = 0.144; P[F, F, F] = 0.576 - ->>> P[T, T, T] -0.108 - -## Ask for P(Cavity|Toothache=T) ->>> PC = enumerate_joint_ask('Cavity', {'Toothache': T}, P) ->>> PC.prob -{False: 0.39999999999999997, True: 0.59999999999999998} - ->>> 0.6-epsilon < PC[T] < 0.6+epsilon -True - ->>> 0.4-epsilon < PC[F] < 0.4+epsilon -True - - diff --git a/csp/aima/rl.py b/csp/aima/rl.py deleted file mode 100644 index 51e3a5a9..00000000 --- a/csp/aima/rl.py +++ /dev/null @@ -1,15 +0,0 @@ -"""Reinforcement Learning (Chapter 21) -""" - -from utils import * -import agents - -class PassiveADPAgent(agents.Agent): - """Passive (non-learning) agent that uses adaptive dynamic programming - on a given MDP and policy. [Fig. 21.2]""" - NotImplementedError - -class PassiveTDAgent(agents.Agent): - """Passive (non-learning) agent that uses temporal differences to learn - utility estimates. [Fig. 21.4]""" - NotImplementedError diff --git a/csp/aima/search.py b/csp/aima/search.py deleted file mode 100644 index cb0c07dd..00000000 --- a/csp/aima/search.py +++ /dev/null @@ -1,736 +0,0 @@ -"""Search (Chapters 3-4) - -The way to use this code is to subclass Problem to create a class of problems, -then create problem instances and solve them with calls to the various search -functions.""" - -from __future__ import generators -from utils import * -import agents -import math, random, sys, time, bisect, string - -#______________________________________________________________________________ - -class Problem: - """The abstract class for a formal problem. You should subclass this and - implement the method successor, and possibly __init__, goal_test, and - path_cost. Then you will create instances of your subclass and solve them - with the various search functions.""" - - def __init__(self, initial, goal=None): - """The constructor specifies the initial state, and possibly a goal - state, if there is a unique goal. Your subclass's constructor can add - other arguments.""" - self.initial = initial; self.goal = goal - - def successor(self, state): - """Given a state, return a sequence of (action, state) pairs reachable - from this state. If there are many successors, consider an iterator - that yields the successors one at a time, rather than building them - all at once. Iterators will work fine within the framework.""" - abstract - - def goal_test(self, state): - """Return True if the state is a goal. The default method compares the - state to self.goal, as specified in the constructor. Implement this - method if checking against a single self.goal is not enough.""" - return state == self.goal - - def path_cost(self, c, state1, action, state2): - """Return the cost of a solution path that arrives at state2 from - state1 via action, assuming cost c to get up to state1. If the problem - is such that the path doesn't matter, this function will only look at - state2. If the path does matter, it will consider c and maybe state1 - and action. The default method costs 1 for every step in the path.""" - return c + 1 - - def value(self): - """For optimization problems, each state has a value. Hill-climbing - and related algorithms try to maximize this value.""" - abstract -#______________________________________________________________________________ - -class Node: - """A node in a search tree. Contains a pointer to the parent (the node - that this is a successor of) and to the actual state for this node. Note - that if a state is arrived at by two paths, then there are two nodes with - the same state. Also includes the action that got us to this state, and - the total path_cost (also known as g) to reach the node. Other functions - may add an f and h value; see best_first_graph_search and astar_search for - an explanation of how the f and h values are handled. You will not need to - subclass this class.""" - - def __init__(self, state, parent=None, action=None, path_cost=0): - "Create a search tree Node, derived from a parent by an action." - update(self, state=state, parent=parent, action=action, - path_cost=path_cost, depth=0) - if parent: - self.depth = parent.depth + 1 - - def __repr__(self): - return "" % (self.state,) - - def path(self): - "Create a list of nodes from the root to this node." - x, result = self, [self] - while x.parent: - result.append(x.parent) - x = x.parent - return result - - def expand(self, problem): - "Return a list of nodes reachable from this node. [Fig. 3.8]" - return [Node(next, self, act, - problem.path_cost(self.path_cost, self.state, act, next)) - for (act, next) in problem.successor(self.state)] - -#______________________________________________________________________________ - -class SimpleProblemSolvingAgent(agents.Agent): - """Abstract framework for problem-solving agent. [Fig. 3.1]""" - def __init__(self): - Agent.__init__(self) - state = [] - seq = [] - - def program(percept): - state = self.update_state(state, percept) - if not seq: - goal = self.formulate_goal(state) - problem = self.formulate_problem(state, goal) - seq = self.search(problem) - action = seq[0] - seq[0:1] = [] - return action - - self.program = program - -#______________________________________________________________________________ -## Uninformed Search algorithms - -def tree_search(problem, fringe): - """Search through the successors of a problem to find a goal. - The argument fringe should be an empty queue. - Don't worry about repeated paths to a state. [Fig. 3.8]""" - fringe.append(Node(problem.initial)) - while fringe: - node = fringe.pop() - if problem.goal_test(node.state): - return node - fringe.extend(node.expand(problem)) - return None - -def breadth_first_tree_search(problem): - "Search the shallowest nodes in the search tree first. [p 74]" - return tree_search(problem, FIFOQueue()) - -def depth_first_tree_search(problem): - "Search the deepest nodes in the search tree first. [p 74]" - return tree_search(problem, Stack()) - -def graph_search(problem, fringe): - """Search through the successors of a problem to find a goal. - The argument fringe should be an empty queue. - If two paths reach a state, only use the best one. [Fig. 3.18]""" - closed = {} - fringe.append(Node(problem.initial)) - while fringe: - node = fringe.pop() - if problem.goal_test(node.state): - return node - if node.state not in closed: - closed[node.state] = True - fringe.extend(node.expand(problem)) - return None - -def breadth_first_graph_search(problem): - "Search the shallowest nodes in the search tree first. [p 74]" - return graph_search(problem, FIFOQueue()) - -def depth_first_graph_search(problem): - "Search the deepest nodes in the search tree first. [p 74]" - return graph_search(problem, Stack()) - -def depth_limited_search(problem, limit=50): - "[Fig. 3.12]" - def recursive_dls(node, problem, limit): - cutoff_occurred = False - if problem.goal_test(node.state): - return node - elif node.depth == limit: - return 'cutoff' - else: - for successor in node.expand(problem): - result = recursive_dls(successor, problem, limit) - if result == 'cutoff': - cutoff_occurred = True - elif result != None: - return result - if cutoff_occurred: - return 'cutoff' - else: - return None - # Body of depth_limited_search: - return recursive_dls(Node(problem.initial), problem, limit) - -def iterative_deepening_search(problem): - "[Fig. 3.13]" - for depth in xrange(sys.maxint): - result = depth_limited_search(problem, depth) - if result is not 'cutoff': - return result - -#______________________________________________________________________________ -# Informed (Heuristic) Search - -def best_first_graph_search(problem, f): - """Search the nodes with the lowest f scores first. - You specify the function f(node) that you want to minimize; for example, - if f is a heuristic estimate to the goal, then we have greedy best - first search; if f is node.depth then we have depth-first search. - There is a subtlety: the line "f = memoize(f, 'f')" means that the f - values will be cached on the nodes as they are computed. So after doing - a best first search you can examine the f values of the path returned.""" - f = memoize(f, 'f') - return graph_search(problem, PriorityQueue(min, f)) - -greedy_best_first_graph_search = best_first_graph_search - # Greedy best-first search is accomplished by specifying f(n) = h(n). - -def astar_search(problem, h=None): - """A* search is best-first graph search with f(n) = g(n)+h(n). - You need to specify the h function when you call astar_search. - Uses the pathmax trick: f(n) = max(f(n), g(n)+h(n)).""" - h = h or problem.h - def f(n): - return max(getattr(n, 'f', -infinity), n.path_cost + h(n)) - return best_first_graph_search(problem, f) - -#______________________________________________________________________________ -## Other search algorithms - -def recursive_best_first_search(problem): - "[Fig. 4.5]" - def RBFS(problem, node, flimit): - if problem.goal_test(node.state): - return node - successors = expand(node, problem) - if len(successors) == 0: - return None, infinity - for s in successors: - s.f = max(s.path_cost + s.h, node.f) - while True: - successors.sort(lambda x,y: x.f - y.f) # Order by lowest f value - best = successors[0] - if best.f > flimit: - return None, best.f - alternative = successors[1] - result, best.f = RBFS(problem, best, min(flimit, alternative)) - if result is not None: - return result - return RBFS(Node(problem.initial), infinity) - - -def hill_climbing(problem): - """From the initial node, keep choosing the neighbor with highest value, - stopping when no neighbor is better. [Fig. 4.11]""" - current = Node(problem.initial) - while True: - neighbor = argmax(expand(node, problem), Node.value) - if neighbor.value() <= current.value(): - return current.state - current = neighbor - -def exp_schedule(k=20, lam=0.005, limit=100): - "One possible schedule function for simulated annealing" - return lambda t: if_(t < limit, k * math.exp(-lam * t), 0) - -def simulated_annealing(problem, schedule=exp_schedule()): - "[Fig. 4.5]" - current = Node(problem.initial) - for t in xrange(sys.maxint): - T = schedule(t) - if T == 0: - return current - next = random.choice(expand(node. problem)) - delta_e = next.path_cost - current.path_cost - if delta_e > 0 or probability(math.exp(delta_e/T)): - current = next - -def online_dfs_agent(a): - "[Fig. 4.12]" - pass #### more - -def lrta_star_agent(a): - "[Fig. 4.12]" - pass #### more - -#______________________________________________________________________________ -# Genetic Algorithm - -def genetic_search(problem, fitness_fn, ngen=1000, pmut=0.0, n=20): - """Call genetic_algorithm on the appropriate parts of a problem. - This requires that the problem has a successor function that generates - reasonable states, and that it has a path_cost function that scores states. - We use the negative of the path_cost function, because costs are to be - minimized, while genetic-algorithm expects a fitness_fn to be maximized.""" - states = [s for (a, s) in problem.successor(problem.initial_state)[:n]] - random.shuffle(states) - fitness_fn = lambda s: - problem.path_cost(0, s, None, s) - return genetic_algorithm(states, fitness_fn, ngen, pmut) - -def genetic_algorithm(population, fitness_fn, ngen=1000, pmut=0.0): - """[Fig. 4.7]""" - def reproduce(p1, p2): - c = random.randrange(len(p1)) - return p1[:c] + p2[c:] - - for i in range(ngen): - new_population = [] - for i in len(population): - p1, p2 = random_weighted_selections(population, 2, fitness_fn) - child = reproduce(p1, p2) - if random.uniform(0,1) > pmut: - child.mutate() - new_population.append(child) - population = new_population - return argmax(population, fitness_fn) - -def random_weighted_selection(seq, n, weight_fn): - """Pick n elements of seq, weighted according to weight_fn. - That is, apply weight_fn to each element of seq, add up the total. - Then choose an element e with probability weight[e]/total. - Repeat n times, with replacement. """ - totals = []; runningtotal = 0 - for item in seq: - runningtotal += weight_fn(item) - totals.append(runningtotal) - selections = [] - for s in range(n): - r = random.uniform(0, totals[-1]) - for i in range(len(seq)): - if totals[i] > r: - selections.append(seq[i]) - break - return selections - - -#_____________________________________________________________________________ -# The remainder of this file implements examples for the search algorithms. - -#______________________________________________________________________________ -# Graphs and Graph Problems - -class Graph: - """A graph connects nodes (verticies) by edges (links). Each edge can also - have a length associated with it. The constructor call is something like: - g = Graph({'A': {'B': 1, 'C': 2}) - this makes a graph with 3 nodes, A, B, and C, with an edge of length 1 from - A to B, and an edge of length 2 from A to C. You can also do: - g = Graph({'A': {'B': 1, 'C': 2}, directed=False) - This makes an undirected graph, so inverse links are also added. The graph - stays undirected; if you add more links with g.connect('B', 'C', 3), then - inverse link is also added. You can use g.nodes() to get a list of nodes, - g.get('A') to get a dict of links out of A, and g.get('A', 'B') to get the - length of the link from A to B. 'Lengths' can actually be any object at - all, and nodes can be any hashable object.""" - - def __init__(self, dict=None, directed=True): - self.dict = dict or {} - self.directed = directed - if not directed: self.make_undirected() - - def make_undirected(self): - "Make a digraph into an undirected graph by adding symmetric edges." - for a in self.dict.keys(): - for (b, distance) in self.dict[a].items(): - self.connect1(b, a, distance) - - def connect(self, A, B, distance=1): - """Add a link from A and B of given distance, and also add the inverse - link if the graph is undirected.""" - self.connect1(A, B, distance) - if not self.directed: self.connect1(B, A, distance) - - def connect1(self, A, B, distance): - "Add a link from A to B of given distance, in one direction only." - self.dict.setdefault(A,{})[B] = distance - - def get(self, a, b=None): - """Return a link distance or a dict of {node: distance} entries. - .get(a,b) returns the distance or None; - .get(a) returns a dict of {node: distance} entries, possibly {}.""" - links = self.dict.setdefault(a, {}) - if b is None: return links - else: return links.get(b) - - def nodes(self): - "Return a list of nodes in the graph." - return self.dict.keys() - -def UndirectedGraph(dict=None): - "Build a Graph where every edge (including future ones) goes both ways." - return Graph(dict=dict, directed=False) - -def RandomGraph(nodes=range(10), min_links=2, width=400, height=300, - curvature=lambda: random.uniform(1.1, 1.5)): - """Construct a random graph, with the specified nodes, and random links. - The nodes are laid out randomly on a (width x height) rectangle. - Then each node is connected to the min_links nearest neighbors. - Because inverse links are added, some nodes will have more connections. - The distance between nodes is the hypotenuse times curvature(), - where curvature() defaults to a random number between 1.1 and 1.5.""" - g = UndirectedGraph() - g.locations = {} - ## Build the cities - for node in nodes: - g.locations[node] = (random.randrange(width), random.randrange(height)) - ## Build roads from each city to at least min_links nearest neighbors. - for i in range(min_links): - for node in nodes: - if len(g.get(node)) < min_links: - here = g.locations[node] - def distance_to_node(n): - if n is node or g.get(node,n): return infinity - return distance(g.locations[n], here) - neighbor = argmin(nodes, distance_to_node) - d = distance(g.locations[neighbor], here) * curvature() - g.connect(node, neighbor, int(d)) - return g - -romania = UndirectedGraph(Dict( - A=Dict(Z=75, S=140, T=118), - B=Dict(U=85, P=101, G=90, F=211), - C=Dict(D=120, R=146, P=138), - D=Dict(M=75), - E=Dict(H=86), - F=Dict(S=99), - H=Dict(U=98), - I=Dict(V=92, N=87), - L=Dict(T=111, M=70), - O=Dict(Z=71, S=151), - P=Dict(R=97), - R=Dict(S=80), - U=Dict(V=142))) -romania.locations = Dict( - A=( 91, 492), B=(400, 327), C=(253, 288), D=(165, 299), - E=(562, 293), F=(305, 449), G=(375, 270), H=(534, 350), - I=(473, 506), L=(165, 379), M=(168, 339), N=(406, 537), - O=(131, 571), P=(320, 368), R=(233, 410), S=(207, 457), - T=( 94, 410), U=(456, 350), V=(509, 444), Z=(108, 531)) - -australia = UndirectedGraph(Dict( - T=Dict(), - SA=Dict(WA=1, NT=1, Q=1, NSW=1, V=1), - NT=Dict(WA=1, Q=1), - NSW=Dict(Q=1, V=1))) -australia.locations = Dict(WA=(120, 24), NT=(135, 20), SA=(135, 30), - Q=(145, 20), NSW=(145, 32), T=(145, 42), V=(145, 37)) - -class GraphProblem(Problem): - "The problem of searching a graph from one node to another." - def __init__(self, initial, goal, graph): - Problem.__init__(self, initial, goal) - self.graph = graph - - def successor(self, A): - "Return a list of (action, result) pairs." - return [(B, B) for B in self.graph.get(A).keys()] - - def path_cost(self, cost_so_far, A, action, B): - return cost_so_far + (self.graph.get(A,B) or infinity) - - def h(self, node): - "h function is straight-line distance from a node's state to goal." - locs = getattr(self.graph, 'locations', None) - if locs: - return int(distance(locs[node.state], locs[self.goal])) - else: - return infinity - -#______________________________________________________________________________ - -#### NOTE: NQueensProblem not working properly yet. - -class NQueensProblem(Problem): - """The problem of placing N queens on an NxN board with none attacking - each other. A state is represented as an N-element array, where the - a value of r in the c-th entry means there is a queen at column c, - row r, and a value of None means that the c-th column has not been - filled in left. We fill in columns left to right.""" - def __init__(self, N): - self.N = N - self.initial = [None] * N - - def successor(self, state): - "In the leftmost empty column, try all non-conflicting rows." - if state[-1] is not None: - return [] ## All columns filled; no successors - else: - def place(col, row): - new = state[:] - new[col] = row - return new - col = state.index(None) - return [(row, place(col, row)) for row in range(self.N) - if not self.conflicted(state, row, col)] - - def conflicted(self, state, row, col): - "Would placing a queen at (row, col) conflict with anything?" - for c in range(col-1): - if self.conflict(row, col, state[c], c): - return True - return False - - def conflict(self, row1, col1, row2, col2): - "Would putting two queens in (row1, col1) and (row2, col2) conflict?" - return (row1 == row2 ## same row - or col1 == col2 ## same column - or row1-col1 == row2-col2 ## same \ diagonal - or row1+col1 == row2+col2) ## same / diagonal - - def goal_test(self, state): - "Check if all columns filled, no conflicts." - if state[-1] is None: - return False - for c in range(len(state)): - if self.conflicted(state, state[c], c): - return False - return True - -#______________________________________________________________________________ -## Inverse Boggle: Search for a high-scoring Boggle board. A good domain for -## iterative-repair and related search tehniques, as suggested by Justin Boyan. - -ALPHABET = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ' - -cubes16 = ['FORIXB', 'MOQABJ', 'GURILW', 'SETUPL', - 'CMPDAE', 'ACITAO', 'SLCRAE', 'ROMASH', - 'NODESW', 'HEFIYE', 'ONUDTK', 'TEVIGN', - 'ANEDVZ', 'PINESH', 'ABILYT', 'GKYLEU'] - -def random_boggle(n=4): - """Return a random Boggle board of size n x n. - We represent a board as a linear list of letters.""" - cubes = [cubes16[i % 16] for i in range(n*n)] - random.shuffle(cubes) - return map(random.choice, cubes) - -## The best 5x5 board found by Boyan, with our word list this board scores -## 2274 words, for a score of 9837 - -boyan_best = list('RSTCSDEIAEGNLRPEATESMSSID') - -def print_boggle(board): - "Print the board in a 2-d array." - n2 = len(board); n = exact_sqrt(n2) - for i in range(n2): - if i % n == 0: print - if board[i] == 'Q': print 'Qu', - else: print str(board[i]) + ' ', - print - -def boggle_neighbors(n2, cache={}): - """"Return a list of lists, where the i-th element is the list of indexes - for the neighbors of square i.""" - if cache.get(n2): - return cache.get(n2) - n = exact_sqrt(n2) - neighbors = [None] * n2 - for i in range(n2): - neighbors[i] = [] - on_top = i < n - on_bottom = i >= n2 - n - on_left = i % n == 0 - on_right = (i+1) % n == 0 - if not on_top: - neighbors[i].append(i - n) - if not on_left: neighbors[i].append(i - n - 1) - if not on_right: neighbors[i].append(i - n + 1) - if not on_bottom: - neighbors[i].append(i + n) - if not on_left: neighbors[i].append(i + n - 1) - if not on_right: neighbors[i].append(i + n + 1) - if not on_left: neighbors[i].append(i - 1) - if not on_right: neighbors[i].append(i + 1) - cache[n2] = neighbors - return neighbors - -def exact_sqrt(n2): - "If n2 is a perfect square, return its square root, else raise error." - n = int(math.sqrt(n2)) - assert n * n == n2 - return n - -##_____________________________________________________________________________ - -class Wordlist: - """This class holds a list of words. You can use (word in wordlist) - to check if a word is in the list, or wordlist.lookup(prefix) - to see if prefix starts any of the words in the list.""" - def __init__(self, filename, min_len=3): - lines = open(filename).read().upper().split() - self.words = [word for word in lines if len(word) >= min_len] - self.words.sort() - self.bounds = {} - for c in ALPHABET: - c2 = chr(ord(c) + 1) - self.bounds[c] = (bisect.bisect(self.words, c), - bisect.bisect(self.words, c2)) - - def lookup(self, prefix, lo=0, hi=None): - """See if prefix is in dictionary, as a full word or as a prefix. - Return two values: the first is the lowest i such that - words[i].startswith(prefix), or is None; the second is - True iff prefix itself is in the Wordlist.""" - words = self.words - i = bisect.bisect_left(words, prefix, lo, hi) - if i < len(words) and words[i].startswith(prefix): - return i, (words[i] == prefix) - else: - return None, False - - def __contains__(self, word): - return self.words[bisect.bisect_left(self.words, word)] == word - - def __len__(self): - return len(self.words) - -##_____________________________________________________________________________ - -class BoggleFinder: - """A class that allows you to find all the words in a Boggle board. """ - - wordlist = None ## A class variable, holding a wordlist - - def __init__(self, board=None): - if BoggleFinder.wordlist is None: - BoggleFinder.wordlist = Wordlist("../data/wordlist") - self.found = {} - if board: - self.set_board(board) - - def set_board(self, board=None): - "Set the board, and find all the words in it." - if board is None: - board = random_boggle() - self.board = board - self.neighbors = boggle_neighbors(len(board)) - self.found = {} - for i in range(len(board)): - lo, hi = self.wordlist.bounds[board[i]] - self.find(lo, hi, i, [], '') - return self - - def find(self, lo, hi, i, visited, prefix): - """Looking in square i, find the words that continue the prefix, - considering the entries in self.wordlist.words[lo:hi], and not - revisiting the squares in visited.""" - if i in visited: - return - wordpos, is_word = self.wordlist.lookup(prefix, lo, hi) - if wordpos is not None: - if is_word: - self.found[prefix] = True - visited.append(i) - c = self.board[i] - if c == 'Q': c = 'QU' - prefix += c - for j in self.neighbors[i]: - self.find(wordpos, hi, j, visited, prefix) - visited.pop() - - def words(self): - "The words found." - return self.found.keys() - - scores = [0, 0, 0, 0, 1, 2, 3, 5] + [11] * 100 - - def score(self): - "The total score for the words found, according to the rules." - return sum([self.scores[len(w)] for w in self.words()]) - - def __len__(self): - "The number of words found." - return len(self.found) - -##_____________________________________________________________________________ - -def boggle_hill_climbing(board=None, ntimes=100, print_it=True): - """Solve inverse Boggle by hill-climbing: find a high-scoring board by - starting with a random one and changing it.""" - finder = BoggleFinder() - if board is None: - board = random_boggle() - best = len(finder.set_board(board)) - for _ in range(ntimes): - i, oldc = mutate_boggle(board) - new = len(finder.set_board(board)) - if new > best: - best = new - print best, _, board - else: - board[i] = oldc ## Change back - if print_it: - print_boggle(board) - return board, best - -def mutate_boggle(board): - i = random.randrange(len(board)) - oldc = board[i] - board[i] = random.choice(random.choice(cubes16)) ##random.choice(boyan_best) - return i, oldc - -#______________________________________________________________________________ - -## Code to compare searchers on various problems. - -class InstrumentedProblem(Problem): - """Delegates to a problem, and keeps statistics.""" - - def __init__(self, problem): - self.problem = problem - self.succs = self.goal_tests = self.states = 0 - self.found = None - - def successor(self, state): - "Return a list of (action, state) pairs reachable from this state." - result = self.problem.successor(state) - self.succs += 1; self.states += len(result) - return result - - def goal_test(self, state): - "Return true if the state is a goal." - self.goal_tests += 1 - result = self.problem.goal_test(state) - if result: - self.found = state - return result - - def __getattr__(self, attr): - if attr in ('succs', 'goal_tests', 'states'): - return self.__dict__[attr] - else: - return getattr(self.problem, attr) - - def __repr__(self): - return '<%4d/%4d/%4d/%s>' % (self.succs, self.goal_tests, - self.states, str(self.found)[0:4]) - -def compare_searchers(problems, header, searchers=[breadth_first_tree_search, - breadth_first_graph_search, depth_first_graph_search, - iterative_deepening_search, depth_limited_search, - astar_search]): - def do(searcher, problem): - p = InstrumentedProblem(problem) - searcher(p) - return p - table = [[name(s)] + [do(s, p) for p in problems] for s in searchers] - print_table(table, header) - -def compare_graph_searchers(): - compare_searchers(problems=[GraphProblem('A', 'B', romania), - GraphProblem('O', 'N', romania), - GraphProblem('Q', 'WA', australia)], - header=['Searcher', 'Romania(A,B)', 'Romania(O, N)', 'Australia']) - diff --git a/csp/aima/search.txt b/csp/aima/search.txt deleted file mode 100644 index a58fdf22..00000000 --- a/csp/aima/search.txt +++ /dev/null @@ -1,68 +0,0 @@ - ->>> ab = GraphProblem('A', 'B', romania) ->>> breadth_first_tree_search(ab).state -'B' ->>> breadth_first_graph_search(ab).state -'B' ->>> depth_first_graph_search(ab).state -'B' ->>> iterative_deepening_search(ab).state -'B' ->>> depth_limited_search(ab).state -'B' ->>> astar_search(ab).state -'B' ->>> [node.state for node in astar_search(ab).path()] -['B', 'P', 'R', 'S', 'A'] - - -### demo - ->>> compare_graph_searchers() -Searcher Romania(A,B) Romania(O, N) Australia -breadth_first_tree_search < 21/ 22/ 59/B> <1158/1159/3288/N> < 7/ 8/ 22/WA> -breadth_first_graph_search < 10/ 19/ 26/B> < 19/ 45/ 45/N> < 5/ 8/ 16/WA> -depth_first_graph_search < 9/ 15/ 23/B> < 16/ 27/ 39/N> < 4/ 7/ 13/WA> -iterative_deepening_search < 11/ 33/ 31/B> < 656/1815/1812/N> < 3/ 11/ 11/WA> -depth_limited_search < 54/ 65/ 185/B> < 387/1012/1125/N> < 50/ 54/ 200/WA> -astar_search < 3/ 4/ 9/B> < 8/ 10/ 22/N> < 2/ 3/ 6/WA> - ->>> board = list('SARTELNID') ->>> print_boggle(board) -S A R -T E L -N I D - ->>> f = BoggleFinder(board) - ->>> len(f) -206 - ->>> ' '.join(f.words()) -'LID LARES DEAL LIE DIETS LIN LINT TIL TIN RATED ERAS LATEN DEAR TIE LINE INTER STEAL LATED LAST TAR SAL DITES RALES SAE RETS TAE RAT RAS SAT IDLE TILDES LEAST IDEAS LITE SATED TINED LEST LIT RASE RENTS TINEA EDIT EDITS NITES ALES LATE LETS RELIT TINES LEI LAT ELINT LATI SENT TARED DINE STAR SEAR NEST LITAS TIED SEAT SERAL RATE DINT DEL DEN SEAL TIER TIES NET SALINE DILATE EAST TIDES LINTER NEAR LITS ELINTS DENI RASED SERA TILE NEAT DERAT IDLEST NIDE LIEN STARED LIER LIES SETA NITS TINE DITAS ALINE SATIN TAS ASTER LEAS TSAR LAR NITE RALE LAS REAL NITER ATE RES RATEL IDEA RET IDEAL REI RATS STALE DENT RED IDES ALIEN SET TEL SER TEN TEA TED SALE TALE STILE ARES SEA TILDE SEN SEL ALINES SEI LASE DINES ILEA LINES ELD TIDE RENT DIEL STELA TAEL STALED EARL LEA TILES TILER LED ETA TALI ALE LASED TELA LET IDLER REIN ALIT ITS NIDES DIN DIE DENTS STIED LINER LASTED RATINE ERA IDLES DIT RENTAL DINER SENTI TINEAL DEIL TEAR LITER LINTS TEAL DIES EAR EAT ARLES SATE STARE DITS DELI DENTAL REST DITE DENTIL DINTS DITA DIET LENT NETS NIL NIT SETAL LATS TARE ARE SATI' - ->>> boggle_hill_climbing(list('ABCDEFGHI')) -30 1 ['A', 'B', 'C', 'D', 'E', 'F', 'G', 'S', 'I'] -35 2 ['A', 'B', 'S', 'D', 'E', 'F', 'G', 'S', 'I'] -36 10 ['A', 'B', 'O', 'D', 'E', 'F', 'G', 'S', 'I'] -41 11 ['A', 'B', 'O', 'D', 'O', 'F', 'G', 'S', 'I'] -46 13 ['A', 'B', 'O', 'D', 'O', 'C', 'G', 'S', 'I'] -48 14 ['A', 'M', 'O', 'D', 'O', 'C', 'G', 'S', 'I'] -55 16 ['A', 'M', 'L', 'D', 'O', 'C', 'G', 'S', 'I'] -60 17 ['A', 'M', 'L', 'D', 'O', 'C', 'G', 'S', 'E'] -67 23 ['A', 'M', 'L', 'D', 'O', 'A', 'G', 'S', 'E'] -70 29 ['A', 'B', 'L', 'D', 'O', 'A', 'G', 'S', 'E'] -73 33 ['A', 'N', 'L', 'D', 'O', 'A', 'G', 'S', 'E'] -80 55 ['A', 'N', 'L', 'D', 'O', 'A', 'G', 'S', 'W'] -84 115 ['A', 'N', 'R', 'D', 'O', 'A', 'G', 'S', 'W'] -100 116 ['A', 'N', 'R', 'D', 'O', 'A', 'G', 'S', 'T'] -111 140 ['E', 'N', 'R', 'D', 'O', 'A', 'G', 'S', 'T'] -123 169 ['E', 'P', 'R', 'D', 'O', 'A', 'G', 'S', 'T'] - -E P R -D O A -G S T -(['E', 'P', 'R', 'D', 'O', 'A', 'G', 'S', 'T'], 123) - ->>> random_weighted_selection(range(10), 3, lambda x: x * x) -[8, 9, 6] \ No newline at end of file diff --git a/csp/aima/text.py b/csp/aima/text.py deleted file mode 100644 index 5ccc1023..00000000 --- a/csp/aima/text.py +++ /dev/null @@ -1,365 +0,0 @@ -"""Statistical Language Processing tools. (Chapter 23) -We define Unigram and Ngram text models, use them to generate random text, -and show the Viterbi algorithm for segmentatioon of letters into words. -Then we show a very simple Information Retrieval system, and an example -working on a tiny sample of Unix manual pages.""" - -from utils import * -from math import log, exp -import re, probability, string, search - -class CountingProbDist(probability.ProbDist): - """A probability distribution formed by observing and counting examples. - If P is an instance of this class and o - is an observed value, then there are 3 main operations: - p.add(o) increments the count for observation o by 1. - p.sample() returns a random element from the distribution. - p[o] returns the probability for o (as in a regular ProbDist).""" - - def __init__(self, observations=[], default=0): - """Create a distribution, and optionally add in some observations. - By default this is an unsmoothed distribution, but saying default=1, - for example, gives you add-one smoothing.""" - update(self, dictionary=DefaultDict(default), needs_recompute=False, - table=[], n_obs=0) - for o in observations: - self.add(o) - - def add(self, o): - """Add an observation o to the distribution.""" - self.dictionary[o] += 1 - self.n_obs += 1 - self.needs_recompute = True - - def sample(self): - """Return a random sample from the distribution.""" - if self.needs_recompute: self._recompute() - if self.n_obs == 0: - return None - i = bisect.bisect_left(self.table, (1 + random.randrange(self.n_obs),)) - (count, o) = self.table[i] - return o - - def __getitem__(self, item): - """Return an estimate of the probability of item.""" - if self.needs_recompute: self._recompute() - return self.dictionary[item] / self.n_obs - - def __len__(self): - if self.needs_recompute: self._recompute() - return self.n_obs - - def top(self, n): - "Return (count, obs) tuples for the n most frequent observations." - items = [(v, k) for (k, v) in self.dictionary.items()] - items.sort(); items.reverse() - return items[0:n] - - def _recompute(self): - """Recompute the total count n_obs and the table of entries.""" - n_obs = 0 - table = [] - for (o, count) in self.dictionary.items(): - n_obs += count - table.append((n_obs, o)) - update(self, n_obs=float(n_obs), table=table, needs_recompute=False) - -#______________________________________________________________________________ - -class UnigramTextModel(CountingProbDist): - """This is a discrete probability distribution over words, so you - can add, sample, or get P[word], just like with CountingProbDist. You can - also generate a random text n words long with P.samples(n)""" - - def samples(self, n): - "Return a string of n words, random according to the model." - return ' '.join([self.sample() for i in range(n)]) - -class NgramTextModel(CountingProbDist): - """This is a discrete probability distribution over n-tuples of words. - You can add, sample or get P[(word1, ..., wordn)]. The method P.samples(n) - builds up an n-word sequence; P.add_text and P.add_sequence add data.""" - - def __init__(self, n, observation_sequence=[]): - ## In addition to the dictionary of n-tuples, cond_prob is a - ## mapping from (w1, ..., wn-1) to P(wn | w1, ... wn-1) - CountingProbDist.__init__(self) - self.n = n - self.cond_prob = DefaultDict(CountingProbDist()) - self.add_sequence(observation_sequence) - - ## sample, __len__, __getitem__ inherited from CountingProbDist - ## Note they deal with tuples, not strings, as inputs - - def add(self, ngram): - """Count 1 for P[(w1, ..., wn)] and for P(wn | (w1, ..., wn-1)""" - CountingProbDist.add(self, ngram) - self.cond_prob[ngram[:-1]].add(ngram[-1]) - - def add_sequence(self, words): - """Add each of the tuple words[i:i+n], using a sliding window. - Prefix some copies of the empty word, '', to make the start work.""" - n = self.n - words = ['',] * (n-1) + words - for i in range(len(words)-n): - self.add(tuple(words[i:i+n])) - - def samples(self, nwords): - """Build up a random sample of text n words long, using the""" - n = self.n - nminus1gram = ('',) * (n-1) - output = [] - while len(output) < nwords: - wn = self.cond_prob[nminus1gram].sample() - if wn: - output.append(wn) - nminus1gram = nminus1gram[1:] + (wn,) - else: ## Cannot continue, so restart. - nminus1gram = ('',) * (n-1) - return ' '.join(output) - -#______________________________________________________________________________ - - -def viterbi_segment(text, P): - """Find the best segmentation of the string of characters, given the - UnigramTextModel P.""" - # best[i] = best probability for text[0:i] - # words[i] = best word ending at position i - n = len(text) - words = [''] + list(text) - best = [1.0] + [0.0] * n - ## Fill in the vectors best, words via dynamic programming - for i in range(n+1): - for j in range(0, i): - w = text[j:i] - if P[w] * best[i - len(w)] >= best[i]: - best[i] = P[w] * best[i - len(w)] - words[i] = w - ## Now recover the sequence of best words - sequence = []; i = len(words)-1 - while i > 0: - sequence[0:0] = [words[i]] - i = i - len(words[i]) - ## Return sequence of best words and overall probability - return sequence, best[-1] - - -#______________________________________________________________________________ - - -class IRSystem: - """A very simple Information Retrieval System, as discussed in Sect. 23.2. - The constructor s = IRSystem('the a') builds an empty system with two - stopwords. Next, index several documents with s.index_document(text, url). - Then ask queries with s.query('query words', n) to retrieve the top n - matching documents. Queries are literal words from the document, - except that stopwords are ignored, and there is one special syntax: - The query "learn: man cat", for example, runs "man cat" and indexes it.""" - - def __init__(self, stopwords='the a of'): - """Create an IR System. Optionally specify stopwords.""" - ## index is a map of {word: {docid: count}}, where docid is an int, - ## indicating the index into the documents list. - update(self, index=DefaultDict(DefaultDict(0)), - stopwords=set(words(stopwords)), documents=[]) - - def index_collection(self, filenames): - "Index a whole collection of files." - for filename in filenames: - self.index_document(open(filename).read(), filename) - - def index_document(self, text, url): - "Index the text of a document." - ## For now, use first line for title - title = text[:text.index('\n')].strip() - docwords = words(text) - docid = len(self.documents) - self.documents.append(Document(title, url, len(docwords))) - for word in docwords: - if word not in self.stopwords: - self.index[word][docid] += 1 - - def query(self, query_text, n=10): - """Return a list of n (score, docid) pairs for the best matches. - Also handle the special syntax for 'learn: command'.""" - if query_text.startswith("learn:"): - doctext = os.popen(query_text[len("learn:"):], 'r').read() - self.index_document(doctext, query_text) - return [] - qwords = [w for w in words(query_text) if w not in self.stopwords] - shortest = argmin(qwords, lambda w: len(self.index[w])) - docs = self.index[shortest] - results = [(sum([self.score(w, d) for w in qwords]), d) for d in docs] - results.sort(); results.reverse() - return results[:n] - - def score(self, word, docid): - "Compute a score for this word on this docid." - ## There are many options; here we take a very simple approach - return (math.log(1 + self.index[word][docid]) - / math.log(1 + self.documents[docid].nwords)) - - def present(self, results): - "Present the results as a list." - for (score, d) in results: - doc = self.documents[d] - print "%5.2f|%25s | %s" % (100 * score, doc.url, doc.title[:45]) - - def present_results(self, query_text, n=10): - "Get results for the query and present them." - self.present(self.query(query_text, n)) - -class UnixConsultant(IRSystem): - """A trivial IR system over a small collection of Unix man pages.""" - def __init__(self): - IRSystem.__init__(self, stopwords="how do i the a of") - import os - mandir = '../data/man/' - man_files = [mandir + f for f in os.listdir(mandir)] - self.index_collection(man_files) - -class Document: - """Metadata for a document: title and url; maybe add others later.""" - def __init__(self, title, url, nwords): - update(self, title=title, url=url, nwords=nwords) - -def words(text, reg=re.compile('[a-z0-9]+')): - """Return a list of the words in text, ignoring punctuation and - converting everything to lowercase (to canonicalize). - >>> words("``EGAD!'' Edgar cried.") - ['egad', 'edgar', 'cried'] - """ - return reg.findall(text.lower()) - -def canonicalize(text): - """Return a canonical text: only lowercase letters and blanks. - >>> canonicalize("``EGAD!'' Edgar cried.") - 'egad edgar cried' - """ - return ' '.join(words(text)) - - -#______________________________________________________________________________ - -## Example application (not in book): decode a cipher. -## A cipher is a code that substitutes one character for another. -## A shift cipher is a rotation of the letters in the alphabet, -## such as the famous rot13, which maps A to N, B to M, etc. - -#### Encoding - -def shift_encode(plaintext, n): - """Encode text with a shift cipher that moves each letter up by n letters. - >>> shift_encode('abc z', 1) - 'bcd a' - """ - return encode(plaintext, alphabet[n:] + alphabet[:n]) - -def rot13(plaintext): - """Encode text by rotating letters by 13 spaces in the alphabet. - >>> rot13('hello') - 'uryyb' - >>> rot13(rot13('hello')) - 'hello' - """ - return shift_encode(plaintext, 13) - -def encode(plaintext, code): - "Encodes text, using a code which is a permutation of the alphabet." - from string import maketrans - trans = maketrans(alphabet + alphabet.upper(), code + code.upper()) - return plaintext.translate(trans) - -alphabet = 'abcdefghijklmnopqrstuvwxyz' - -def bigrams(text): - """Return a list of pairs in text (a sequence of letters or words). - >>> bigrams('this') - ['th', 'hi', 'is'] - >>> bigrams(['this', 'is', 'a', 'test']) - [['this', 'is'], ['is', 'a'], ['a', 'test']] - """ - return [text[i:i+2] for i in range(len(text) - 1)] - -#### Decoding a Shift (or Caesar) Cipher - -class ShiftDecoder: - """There are only 26 possible encodings, so we can try all of them, - and return the one with the highest probability, according to a - bigram probability distribution.""" - def __init__(self, training_text): - training_text = canonicalize(training_text) - self.P2 = CountingProbDist(bigrams(training_text), default=1) - - def score(self, plaintext): - "Return a score for text based on how common letters pairs are." - s = 1.0 - for bi in bigrams(plaintext): - s = s * self.P2[bi] - return s - - def decode(self, ciphertext): - "Return the shift decoding of text with the best score." - return argmax(all_shifts(ciphertext), self.score) - -def all_shifts(text): - "Return a list of all 26 possible encodings of text by a shift cipher." - return [shift_encode(text, n) for n in range(len(alphabet))] - -#### Decoding a General Permutation Cipher - -class PermutationDecoder: - """This is a much harder problem than the shift decoder. There are 26! - permutations, so we can't try them all. Instead we have to search. - We want to search well, but there are many things to consider: - Unigram probabilities (E is the most common letter); Bigram probabilities - (TH is the most common bigram); word probabilities (I and A are the most - common one-letter words, etc.); etc. - We could represent a search state as a permutation of the 26 letters, - and alter the solution through hill climbing. With an initial guess - based on unigram probabilities, this would probably fair well. However, - I chose instead to have an incremental representation. A state is - represented as a letter-to-letter map; for example {'z': 'e'} to - represent that 'z' will be translated to 'e' - """ - def __init__(self, training_text, ciphertext=None): - self.Pwords = UnigramTextModel(words(training_text)) - self.P1 = UnigramTextModel(training_text) # By letter - self.P2 = NgramTextModel(2, training_text) # By letter pair - if ciphertext: - return self.decode(ciphertext) - - def decode(self, ciphertext): - "Search for a decoding of the ciphertext." - self.ciphertext = ciphertext - problem = PermutationDecoderProblem(decoder=self) - return search.best_first_tree_search(problem, self.score) - - def score(self, ciphertext, code): - """Score is product of word scores, unigram scores, and bigram scores. - This can get very small, so we use logs and exp.""" - text = decode(ciphertext, code) - logP = (sum([log(self.Pwords[word]) for word in words(text)]) + - sum([log(self.P1[c]) for c in text]) + - sum([log(self.P2[b]) for b in bigrams(text)])) - return exp(logP) - -class PermutationDecoderProblem(search.Problem): - def __init__(self, initial=None, goal=None, decoder=None): - self.initial = initial or {} - self.decoder = decoder - - def successors(self, state): - ## Find the best - p, plainchar = max([(self.decoder.P1[c], c) - for c in alphabet if c not in state]) - succs = [extend(state, plainchar, cipherchar)] #???? - - def goal_test(self, state): - "We're done when we get all 26 letters assigned." - return len(state) >= 26 - - -#______________________________________________________________________________ - diff --git a/csp/aima/text.txt b/csp/aima/text.txt deleted file mode 100644 index b792764f..00000000 --- a/csp/aima/text.txt +++ /dev/null @@ -1,122 +0,0 @@ -## Create a Unigram text model from the words in the book "Flatland". ->>> flatland = DataFile("flat11.txt").read() ->>> wordseq = words(flatland) ->>> P = UnigramTextModel(wordseq) - -## Now do segmentation, using the text model as a prior. ->>> s, p = viterbi_segment('itiseasytoreadwordswithoutspaces', P) ->>> s -['it', 'is', 'easy', 'to', 'read', 'words', 'without', 'spaces'] ->>> 1e-30 < p < 1e-20 -True ->>> s, p = viterbi_segment('wheninthecourseofhumaneventsitbecomesnecessary', P) ->>> s -['when', 'in', 'the', 'course', 'of', 'human', 'events', 'it', 'becomes', 'necessary'] - -## Test the decoding system ->>> shift_encode("This is a secret message.", 17) -'Kyzj zj r jvtivk dvjjrxv.' - ->>> ring = ShiftDecoder(flatland) ->>> ring.decode('Kyzj zj r jvtivk dvjjrxv.') -'This is a secret message.' ->>> ring.decode(rot13('Hello, world!')) -'Hello, world!' - -## CountingProbDist -## Add a thousand samples of a roll of a die to D. ->>> D = CountingProbDist() ->>> for i in range(10000): -... D.add(random.choice('123456')) ->>> ps = [D[n] for n in '123456'] ->>> 1./7. <= min(ps) <= max(ps) <= 1./5. -True - -## demo - -## Compare 1-, 2-, and 3-gram word models of the same text. ->>> flatland = DataFile("flat11.txt").read() ->>> wordseq = words(flatland) ->>> P1 = UnigramTextModel(wordseq) ->>> P2 = NgramTextModel(2, wordseq) ->>> P3 = NgramTextModel(3, wordseq) - -## Generate random text from the N-gram models ->>> P1.samples(20) -'you thought known but were insides of see in depend by us dodecahedrons just but i words are instead degrees' - ->>> P2.samples(20) -'flatland well then can anything else more into the total destruction and circles teach others confine women must be added' - ->>> P3.samples(20) -'flatland by edwin a abbott 1884 to the wake of a certificate from nature herself proving the equal sided triangle' - -## The most frequent entries in each model ->>> P1.top(10) -[(2081, 'the'), (1479, 'of'), (1021, 'and'), (1008, 'to'), (850, 'a'), (722, 'i'), (640, 'in'), (478, 'that'), (399, 'is'), (348, 'you')] - ->>> P2.top(10) -[(368, ('of', 'the')), (152, ('to', 'the')), (152, ('in', 'the')), (86, ('of', 'a')), (80, ('it', 'is')), (71, ('by', 'the')), (68, ('for', 'the')), (68, ('and', 'the')), (62, ('on', 'the')), (60, ('to', 'be'))] - ->>> P3.top(10) -[(30, ('a', 'straight', 'line')), (19, ('of', 'three', 'dimensions')), (16, ('the', 'sense', 'of')), (13, ('by', 'the', 'sense')), (13, ('as', 'well', 'as')), (12, ('of', 'the', 'circles')), (12, ('of', 'sight', 'recognition')), (11, ('the', 'number', 'of')), (11, ('that', 'i', 'had')), (11, ('so', 'as', 'to'))] - -## Probabilities of some common n-grams ->>> P1['the'] -0.061139348356200607 - ->>> P2[('of', 'the')] -0.010812081325655188 - ->>> P3[('', '', 'but')] -0.0 - ->>> P3[('so', 'as', 'to')] -0.00032318721353860618 - -## Distributions given the previous n-1 words ->>> P2.cond_prob['went',].dictionary ->>> P3.cond_prob['in', 'order'].dictionary -{'to': 6} - -## Build and test an IR System ->>> uc = UnixConsultant() ->>> uc.present_results("how do I remove a file") -76.83| ../data/man/rm.txt | RM(1) FSF RM(1) -67.83| ../data/man/tar.txt | TAR(1) TAR(1) -67.79| ../data/man/cp.txt | CP(1) FSF CP(1) -66.58| ../data/man/zip.txt | ZIP(1L) ZIP(1L) -64.58| ../data/man/gzip.txt | GZIP(1) GZIP(1) -63.74| ../data/man/pine.txt | pine(1) pine(1) -62.95| ../data/man/shred.txt | SHRED(1) FSF SHRED(1) -57.46| ../data/man/pico.txt | pico(1) pico(1) -43.38| ../data/man/login.txt | LOGIN(1) Linux Programmer's Manual -41.93| ../data/man/ln.txt | LN(1) FSF LN(1) - ->>> uc.present_results("how do I delete a file") -75.47| ../data/man/diff.txt | DIFF(1) GNU Tools DIFF(1) -69.12| ../data/man/pine.txt | pine(1) pine(1) -63.56| ../data/man/tar.txt | TAR(1) TAR(1) -60.63| ../data/man/zip.txt | ZIP(1L) ZIP(1L) -57.46| ../data/man/pico.txt | pico(1) pico(1) -51.28| ../data/man/shred.txt | SHRED(1) FSF SHRED(1) -26.72| ../data/man/tr.txt | TR(1) User Commands TR(1) - ->>> uc.present_results("email") -18.39| ../data/man/pine.txt | pine(1) pine(1) -12.01| ../data/man/info.txt | INFO(1) FSF INFO(1) - 9.89| ../data/man/pico.txt | pico(1) pico(1) - 8.73| ../data/man/grep.txt | GREP(1) GREP(1) - 8.07| ../data/man/zip.txt | ZIP(1L) ZIP(1L) - ->>> uc.present_results("word counts for files") -112.38| ../data/man/grep.txt | GREP(1) GREP(1) -101.84| ../data/man/wc.txt | WC(1) User Commands WC(1) -82.46| ../data/man/find.txt | FIND(1L) FIND(1L) -74.64| ../data/man/du.txt | DU(1) FSF DU(1) - ->>> uc.present_results("learn: date") ->>> uc.present_results("2003") -14.58| ../data/man/pine.txt | pine(1) pine(1) -11.62| ../data/man/jar.txt | FASTJAR(1) GNU FASTJAR(1) - diff --git a/csp/aima/utils.py b/csp/aima/utils.py deleted file mode 100644 index 87728c1d..00000000 --- a/csp/aima/utils.py +++ /dev/null @@ -1,714 +0,0 @@ -"""Provide some widely useful utilities. Safe for "from utils import *". - -""" - -from __future__ import generators -import operator, math, random, copy, sys, os.path, bisect - -#______________________________________________________________________________ -# Compatibility with Python 2.2 and 2.3 - -# The AIMA code is designed to run in Python 2.2 and up (at some point, -# support for 2.2 may go away; 2.2 was released in 2001, and so is over -# 3 years old). The first part of this file brings you up to 2.4 -# compatibility if you are running in Python 2.2 or 2.3: - -try: bool, True, False ## Introduced in 2.3 -except NameError: - class bool(int): - "Simple implementation of Booleans, as in PEP 285" - def __init__(self, val): self.val = val - def __int__(self): return self.val - def __repr__(self): return ('False', 'True')[self.val] - - True, False = bool(1), bool(0) - -try: sum ## Introduced in 2.3 -except NameError: - def sum(seq, start=0): - """Sum the elements of seq. - >>> sum([1, 2, 3]) - 6 - """ - return reduce(operator.add, seq, start) - -try: enumerate ## Introduced in 2.3 -except NameError: - def enumerate(collection): - """Return an iterator that enumerates pairs of (i, c[i]). PEP 279. - >>> list(enumerate('abc')) - [(0, 'a'), (1, 'b'), (2, 'c')] - """ - ## Copied from PEP 279 - i = 0 - it = iter(collection) - while 1: - yield (i, it.next()) - i += 1 - - -try: reversed ## Introduced in 2.4 -except NameError: - def reversed(seq): - """Iterate over x in reverse order. - >>> list(reversed([1,2,3])) - [3, 2, 1] - """ - if hasattr(seq, 'keys'): - raise ValueError("mappings do not support reverse iteration") - i = len(seq) - while i > 0: - i -= 1 - yield seq[i] - - -try: sorted ## Introduced in 2.4 -except NameError: - def sorted(seq, cmp=None, key=None, reverse=False): - """Copy seq and sort and return it. - >>> sorted([3, 1, 2]) - [1, 2, 3] - """ - seq2 = copy.copy(seq) - if key: - if cmp == None: - cmp = __builtins__.cmp - seq2.sort(lambda x,y: cmp(key(x), key(y))) - else: - if cmp == None: - seq2.sort() - else: - seq2.sort(cmp) - if reverse: - seq2.reverse() - return seq2 - -try: - set, frozenset ## set builtin introduced in 2.4 -except NameError: - try: - import sets ## sets module introduced in 2.3 - set, frozenset = sets.Set, sets.ImmutableSet - except (NameError, ImportError): - class BaseSet: - "set type (see http://docs.python.org/lib/types-set.html)" - - - def __init__(self, elements=[]): - self.dict = {} - for e in elements: - self.dict[e] = 1 - - def __len__(self): - return len(self.dict) - - def __iter__(self): - for e in self.dict: - yield e - - def __contains__(self, element): - return element in self.dict - - def issubset(self, other): - for e in self.dict.keys(): - if e not in other: - return False - return True - - def issuperset(self, other): - for e in other: - if e not in self: - return False - return True - - - def union(self, other): - return type(self)(list(self) + list(other)) - - def intersection(self, other): - return type(self)([e for e in self.dict if e in other]) - - def difference(self, other): - return type(self)([e for e in self.dict if e not in other]) - - def symmetric_difference(self, other): - return type(self)([e for e in self.dict if e not in other] + - [e for e in other if e not in self.dict]) - - def copy(self): - return type(self)(self.dict) - - def __repr__(self): - elements = ", ".join(map(str, self.dict)) - return "%s([%s])" % (type(self).__name__, elements) - - __le__ = issubset - __ge__ = issuperset - __or__ = union - __and__ = intersection - __sub__ = difference - __xor__ = symmetric_difference - - class frozenset(BaseSet): - "A frozenset is a BaseSet that has a hash value and is immutable." - - def __init__(self, elements=[]): - BaseSet.__init__(elements) - self.hash = 0 - for e in self: - self.hash |= hash(e) - - def __hash__(self): - return self.hash - - class set(BaseSet): - "A set is a BaseSet that does not have a hash, but is mutable." - - def update(self, other): - for e in other: - self.add(e) - return self - - def intersection_update(self, other): - for e in self.dict.keys(): - if e not in other: - self.remove(e) - return self - - def difference_update(self, other): - for e in self.dict.keys(): - if e in other: - self.remove(e) - return self - - def symmetric_difference_update(self, other): - to_remove1 = [e for e in self.dict if e in other] - to_remove2 = [e for e in other if e in self.dict] - self.difference_update(to_remove1) - self.difference_update(to_remove2) - return self - - def add(self, element): - self.dict[element] = 1 - - def remove(self, element): - del self.dict[element] - - def discard(self, element): - if element in self.dict: - del self.dict[element] - - def pop(self): - key, val = self.dict.popitem() - return key - - def clear(self): - self.dict.clear() - - __ior__ = update - __iand__ = intersection_update - __isub__ = difference_update - __ixor__ = symmetric_difference_update - - - - -#______________________________________________________________________________ -# Simple Data Structures: infinity, Dict, Struct - -infinity = 1.0e400 - -def Dict(**entries): - """Create a dict out of the argument=value arguments. - >>> Dict(a=1, b=2, c=3) - {'a': 1, 'c': 3, 'b': 2} - """ - return entries - -class DefaultDict(dict): - """Dictionary with a default value for unknown keys.""" - def __init__(self, default): - self.default = default - - def __getitem__(self, key): - if key in self: return self.get(key) - return self.setdefault(key, copy.deepcopy(self.default)) - - def __copy__(self): - copy = DefaultDict(self.default) - copy.update(self) - return copy - -class Struct: - """Create an instance with argument=value slots. - This is for making a lightweight object whose class doesn't matter.""" - def __init__(self, **entries): - self.__dict__.update(entries) - - def __cmp__(self, other): - if isinstance(other, Struct): - return cmp(self.__dict__, other.__dict__) - else: - return cmp(self.__dict__, other) - - def __repr__(self): - args = ['%s=%s' % (k, repr(v)) for (k, v) in vars(self).items()] - return 'Struct(%s)' % ', '.join(args) - -def update(x, **entries): - """Update a dict; or an object with slots; according to entries. - >>> update({'a': 1}, a=10, b=20) - {'a': 10, 'b': 20} - >>> update(Struct(a=1), a=10, b=20) - Struct(a=10, b=20) - """ - if isinstance(x, dict): - x.update(entries) - else: - x.__dict__.update(entries) - return x - -#______________________________________________________________________________ -# Functions on Sequences (mostly inspired by Common Lisp) -# NOTE: Sequence functions (count_if, find_if, every, some) take function -# argument first (like reduce, filter, and map). - -def removeall(item, seq): - """Return a copy of seq (or string) with all occurences of item removed. - >>> removeall(3, [1, 2, 3, 3, 2, 1, 3]) - [1, 2, 2, 1] - >>> removeall(4, [1, 2, 3]) - [1, 2, 3] - """ - if isinstance(seq, str): - return seq.replace(item, '') - else: - return [x for x in seq if x != item] - -def unique(seq): - """Remove duplicate elements from seq. Assumes hashable elements. - >>> unique([1, 2, 3, 2, 1]) - [1, 2, 3] - """ - return list(set(seq)) - -def product(numbers): - """Return the product of the numbers. - >>> product([1,2,3,4]) - 24 - """ - return reduce(operator.mul, numbers, 1) - -def count_if(predicate, seq): - """Count the number of elements of seq for which the predicate is true. - >>> count_if(callable, [42, None, max, min]) - 2 - """ - f = lambda count, x: count + (not not predicate(x)) - return reduce(f, seq, 0) - -def find_if(predicate, seq): - """If there is an element of seq that satisfies predicate; return it. - >>> find_if(callable, [3, min, max]) - - >>> find_if(callable, [1, 2, 3]) - """ - for x in seq: - if predicate(x): return x - return None - -def every(predicate, seq): - """True if every element of seq satisfies predicate. - >>> every(callable, [min, max]) - 1 - >>> every(callable, [min, 3]) - 0 - """ - for x in seq: - if not predicate(x): return False - return True - -def some(predicate, seq): - """If some element x of seq satisfies predicate(x), return predicate(x). - >>> some(callable, [min, 3]) - 1 - >>> some(callable, [2, 3]) - 0 - """ - for x in seq: - px = predicate(x) - if px: return px - return False - -def isin(elt, seq): - """Like (elt in seq), but compares with is, not ==. - >>> e = []; isin(e, [1, e, 3]) - True - >>> isin(e, [1, [], 3]) - False - """ - for x in seq: - if elt is x: return True - return False - -#______________________________________________________________________________ -# Functions on sequences of numbers -# NOTE: these take the sequence argument first, like min and max, -# and like standard math notation: \sigma (i = 1..n) fn(i) -# A lot of programing is finding the best value that satisfies some condition; -# so there are three versions of argmin/argmax, depending on what you want to -# do with ties: return the first one, return them all, or pick at random. - - -def argmin(seq, fn): - """Return an element with lowest fn(seq[i]) score; tie goes to first one. - >>> argmin(['one', 'to', 'three'], len) - 'to' - """ - best = seq[0]; best_score = fn(best) - for x in seq: - x_score = fn(x) - if x_score < best_score: - best, best_score = x, x_score - return best - -def argmin_list(seq, fn): - """Return a list of elements of seq[i] with the lowest fn(seq[i]) scores. - >>> argmin_list(['one', 'to', 'three', 'or'], len) - ['to', 'or'] - """ - best_score, best = fn(seq[0]), [] - for x in seq: - x_score = fn(x) - if x_score < best_score: - best, best_score = [x], x_score - elif x_score == best_score: - best.append(x) - return best - -def argmin_random_tie(seq, fn): - """Return an element with lowest fn(seq[i]) score; break ties at random. - Thus, for all s,f: argmin_random_tie(s, f) in argmin_list(s, f)""" - best_score = fn(seq[0]); n = 0 - for x in seq: - x_score = fn(x) - if x_score < best_score: - best, best_score = x, x_score; n = 1 - elif x_score == best_score: - n += 1 - if random.randrange(n) == 0: - best = x - return best - -def argmax(seq, fn): - """Return an element with highest fn(seq[i]) score; tie goes to first one. - >>> argmax(['one', 'to', 'three'], len) - 'three' - """ - return argmin(seq, lambda x: -fn(x)) - -def argmax_list(seq, fn): - """Return a list of elements of seq[i] with the highest fn(seq[i]) scores. - >>> argmax_list(['one', 'three', 'seven'], len) - ['three', 'seven'] - """ - return argmin_list(seq, lambda x: -fn(x)) - -def argmax_random_tie(seq, fn): - "Return an element with highest fn(seq[i]) score; break ties at random." - return argmin_random_tie(seq, lambda x: -fn(x)) -#______________________________________________________________________________ -# Statistical and mathematical functions - -def histogram(values, mode=0, bin_function=None): - """Return a list of (value, count) pairs, summarizing the input values. - Sorted by increasing value, or if mode=1, by decreasing count. - If bin_function is given, map it over values first.""" - if bin_function: values = map(bin_function, values) - bins = {} - for val in values: - bins[val] = bins.get(val, 0) + 1 - if mode: - return sorted(bins.items(), key=lambda v: v[1], reverse=True) - else: - return sorted(bins.items()) - -def log2(x): - """Base 2 logarithm. - >>> log2(1024) - 10.0 - """ - return math.log10(x) / math.log10(2) - -def mode(values): - """Return the most common value in the list of values. - >>> mode([1, 2, 3, 2]) - 2 - """ - return histogram(values, mode=1)[0][0] - -def median(values): - """Return the middle value, when the values are sorted. - If there are an odd number of elements, try to average the middle two. - If they can't be averaged (e.g. they are strings), choose one at random. - >>> median([10, 100, 11]) - 11 - >>> median([1, 2, 3, 4]) - 2.5 - """ - n = len(values) - values = sorted(values) - if n % 2 == 1: - return values[n/2] - else: - middle2 = values[(n/2)-1:(n/2)+1] - try: - return mean(middle2) - except TypeError: - return random.choice(middle2) - -def mean(values): - """Return the arithmetic average of the values.""" - return sum(values) / float(len(values)) - -def stddev(values, meanval=None): - """The standard deviation of a set of values. - Pass in the mean if you already know it.""" - if meanval == None: meanval = mean(values) - return math.sqrt(sum([(x - meanval)**2 for x in values]) / (len(values)-1)) - -def dotproduct(X, Y): - """Return the sum of the element-wise product of vectors x and y. - >>> dotproduct([1, 2, 3], [1000, 100, 10]) - 1230 - """ - return sum([x * y for x, y in zip(X, Y)]) - -def vector_add(a, b): - """Component-wise addition of two vectors. - >>> vector_add((0, 1), (8, 9)) - (8, 10) - """ - return tuple(map(operator.add, a, b)) - -def probability(p): - "Return true with probability p." - return p > random.uniform(0.0, 1.0) - -def num_or_str(x): - """The argument is a string; convert to a number if possible, or strip it. - >>> num_or_str('42') - 42 - >>> num_or_str(' 42x ') - '42x' - """ - if isnumber(x): return x - try: - return int(x) - except ValueError: - try: - return float(x) - except ValueError: - return str(x).strip() - -def normalize(numbers, total=1.0): - """Multiply each number by a constant such that the sum is 1.0 (or total). - >>> normalize([1,2,1]) - [0.25, 0.5, 0.25] - """ - k = total / sum(numbers) - return [k * n for n in numbers] - -## OK, the following are not as widely useful utilities as some of the other -## functions here, but they do show up wherever we have 2D grids: Wumpus and -## Vacuum worlds, TicTacToe and Checkers, and markov decision Processes. - -orientations = [(1,0), (0, 1), (-1, 0), (0, -1)] - -def turn_right(orientation): - return orientations[orientations.index(orientation)-1] - -def turn_left(orientation): - return orientations[(orientations.index(orientation)+1) % len(orientations)] - -def distance((ax, ay), (bx, by)): - "The distance between two (x, y) points." - return math.hypot((ax - bx), (ay - by)) - -def distance2((ax, ay), (bx, by)): - "The square of the distance between two (x, y) points." - return (ax - bx)**2 + (ay - by)**2 - -def clip(vector, lowest, highest): - """Return vector, except if any element is less than the corresponding - value of lowest or more than the corresponding value of highest, clip to - those values. - >>> clip((-1, 10), (0, 0), (9, 9)) - (0, 9) - """ - return type(vector)(map(min, map(max, vector, lowest), highest)) -#______________________________________________________________________________ -# Misc Functions - -def printf(format, *args): - """Format args with the first argument as format string, and write. - Return the last arg, or format itself if there are no args.""" - sys.stdout.write(str(format) % args) - return if_(args, args[-1], format) - -def caller(n=1): - """Return the name of the calling function n levels up in the frame stack. - >>> caller(0) - 'caller' - >>> def f(): - ... return caller() - >>> f() - 'f' - """ - import inspect - return inspect.getouterframes(inspect.currentframe())[n][3] - -def memoize(fn, slot=None): - """Memoize fn: make it remember the computed value for any argument list. - If slot is specified, store result in that slot of first argument. - If slot is false, store results in a dictionary.""" - if slot: - def memoized_fn(obj, *args): - if hasattr(obj, slot): - return getattr(obj, slot) - else: - val = fn(obj, *args) - setattr(obj, slot, val) - return val - else: - def memoized_fn(*args): - if not memoized_fn.cache.has_key(args): - memoized_fn.cache[args] = fn(*args) - return memoized_fn.cache[args] - memoized_fn.cache = {} - return memoized_fn - -def if_(test, result, alternative): - """Like C++ and Java's (test ? result : alternative), except - both result and alternative are always evaluated. However, if - either evaluates to a function, it is applied to the empty arglist, - so you can delay execution by putting it in a lambda. - >>> if_(2 + 2 == 4, 'ok', lambda: expensive_computation()) - 'ok' - """ - if test: - if callable(result): return result() - return result - else: - if callable(alternative): return alternative() - return alternative - -def name(object): - "Try to find some reasonable name for the object." - return (getattr(object, 'name', 0) or getattr(object, '__name__', 0) - or getattr(getattr(object, '__class__', 0), '__name__', 0) - or str(object)) - -def isnumber(x): - "Is x a number? We say it is if it has a __int__ method." - return hasattr(x, '__int__') - -def issequence(x): - "Is x a sequence? We say it is if it has a __getitem__ method." - return hasattr(x, '__getitem__') - -def print_table(table, header=None, sep=' ', numfmt='%g'): - """Print a list of lists as a table, so that columns line up nicely. - header, if specified, will be printed as the first row. - numfmt is the format for all numbers; you might want e.g. '%6.2f'. - (If you want different formats in differnt columns, don't use print_table.) - sep is the separator between columns.""" - justs = [if_(isnumber(x), 'rjust', 'ljust') for x in table[0]] - if header: - table = [header] + table - table = [[if_(isnumber(x), lambda: numfmt % x, x) for x in row] - for row in table] - maxlen = lambda seq: max(map(len, seq)) - sizes = map(maxlen, zip(*[map(str, row) for row in table])) - for row in table: - for (j, size, x) in zip(justs, sizes, row): - print getattr(str(x), j)(size), sep, - print - -def AIMAFile(components, mode='r'): - "Open a file based at the AIMA root directory." - import utils - dir = os.path.dirname(utils.__file__) - return open(apply(os.path.join, [dir] + components), mode) - -def DataFile(name, mode='r'): - "Return a file in the AIMA /data directory." - return AIMAFile(['..', 'data', name], mode) - - -#______________________________________________________________________________ -# Queues: Stack, FIFOQueue, PriorityQueue - -class Queue: - """Queue is an abstract class/interface. There are three types: - Stack(): A Last In First Out Queue. - FIFOQueue(): A First In First Out Queue. - PriorityQueue(lt): Queue where items are sorted by lt, (default <). - Each type supports the following methods and functions: - q.append(item) -- add an item to the queue - q.extend(items) -- equivalent to: for item in items: q.append(item) - q.pop() -- return the top item from the queue - len(q) -- number of items in q (also q.__len()) - Note that isinstance(Stack(), Queue) is false, because we implement stacks - as lists. If Python ever gets interfaces, Queue will be an interface.""" - - def __init__(self): - abstract - - def extend(self, items): - for item in items: self.append(item) - -def Stack(): - """Return an empty list, suitable as a Last-In-First-Out Queue.""" - return [] - -class FIFOQueue(Queue): - """A First-In-First-Out Queue.""" - def __init__(self): - self.A = []; self.start = 0 - def append(self, item): - self.A.append(item) - def __len__(self): - return len(self.A) - self.start - def extend(self, items): - self.A.extend(items) - def pop(self): - e = self.A[self.start] - self.start += 1 - if self.start > 5 and self.start > len(self.A)/2: - self.A = self.A[self.start:] - self.start = 0 - return e - -class PriorityQueue(Queue): - """A queue in which the minimum (or maximum) element (as determined by f and - order) is returned first. If order is min, the item with minimum f(x) is - returned first; if order is max, then it is the item with maximum f(x).""" - def __init__(self, order=min, f=lambda x: x): - update(self, A=[], order=order, f=f) - def append(self, item): - bisect.insort(self.A, (self.f(item), item)) - def __len__(self): - return len(self.A) - def pop(self): - if self.order == min: - return self.A.pop(0)[1] - else: - return self.A.pop()[1] - -## Fig: The idea is we can define things like Fig[3,10] later. -## Alas, it is Fig[3,10] not Fig[3.10], because that would be the same as Fig[3.1] -Fig = {} - - - diff --git a/csp/aima/utils.txt b/csp/aima/utils.txt deleted file mode 100644 index 8caeb66f..00000000 --- a/csp/aima/utils.txt +++ /dev/null @@ -1,169 +0,0 @@ ->>> d = DefaultDict(0) ->>> d['x'] += 1 ->>> d['x'] -1 - ->>> d = DefaultDict([]) ->>> d['x'] += [1] ->>> d['y'] += [2] ->>> d['x'] -[1] - ->>> s = Struct(a=1, b=2) ->>> s.a -1 ->>> s.a = 3 ->>> s -Struct(a=3, b=2) - ->>> def is_even(x): -... return x % 2 == 0 ->>> sorted([1, 2, -3]) -[-3, 1, 2] ->>> sorted(range(10), key=is_even) -[1, 3, 5, 7, 9, 0, 2, 4, 6, 8] ->>> sorted(range(10), lambda x,y: y-x) -[9, 8, 7, 6, 5, 4, 3, 2, 1, 0] - ->>> removeall(4, []) -[] ->>> removeall('s', 'This is a test. Was a test.') -'Thi i a tet. Wa a tet.' ->>> removeall('s', 'Something') -'Something' ->>> removeall('s', '') -'' - ->>> list(reversed([])) -[] - ->>> count_if(is_even, [1, 2, 3, 4]) -2 ->>> count_if(is_even, []) -0 - ->>> argmax([1], lambda x: x*x) -1 ->>> argmin([1], lambda x: x*x) -1 - - -# Test of memoize with slots in structures ->>> countries = [Struct(name='united states'), Struct(name='canada')] - -# Pretend that 'gnp' was some big hairy operation: ->>> def gnp(country): -... print 'calculating gnp ...' -... return len(country.name) * 1e10 - ->>> gnp = memoize(gnp, '_gnp') ->>> map(gnp, countries) -calculating gnp ... -calculating gnp ... -[130000000000.0, 60000000000.0] ->>> countries -[Struct(_gnp=130000000000.0, name='united states'), Struct(_gnp=60000000000.0, name='canada')] - -# This time we avoid re-doing the calculation ->>> map(gnp, countries) -[130000000000.0, 60000000000.0] - -# Test Queues: ->>> nums = [1, 8, 2, 7, 5, 6, -99, 99, 4, 3, 0] ->>> def qtest(q): -... return [q.extend(nums), [q.pop() for i in range(len(q))]][1] - ->>> qtest(Stack()) -[0, 3, 4, 99, -99, 6, 5, 7, 2, 8, 1] - ->>> qtest(FIFOQueue()) -[1, 8, 2, 7, 5, 6, -99, 99, 4, 3, 0] - ->>> qtest(PriorityQueue(min)) -[-99, 0, 1, 2, 3, 4, 5, 6, 7, 8, 99] - ->>> qtest(PriorityQueue(max)) -[99, 8, 7, 6, 5, 4, 3, 2, 1, 0, -99] - ->>> qtest(PriorityQueue(min, abs)) -[0, 1, 2, 3, 4, 5, 6, 7, 8, -99, 99] - ->>> qtest(PriorityQueue(max, abs)) -[99, -99, 8, 7, 6, 5, 4, 3, 2, 1, 0] - ->>> vals = [100, 110, 160, 200, 160, 110, 200, 200, 220] ->>> histogram(vals) -[(100, 1), (110, 2), (160, 2), (200, 3), (220, 1)] ->>> histogram(vals, 1) -[(200, 3), (110, 2), (160, 2), (220, 1), (100, 1)] ->>> histogram(vals, 1, lambda v: round(v, -2)) -[(200.0, 6), (100.0, 3)] - ->>> log2(1.0) -0.0 - ->>> def fib(n): -... return (n<=1 and 1) or (fib(n-1) + fib(n-2)) - ->>> fib(9) -55 - -# Now we make it faster: ->>> fib = memoize(fib) ->>> fib(9) -55 - ->>> q = Stack() ->>> q.append(1) ->>> q.append(2) ->>> q.pop(), q.pop() -(2, 1) - ->>> q = FIFOQueue() ->>> q.append(1) ->>> q.append(2) ->>> q.pop(), q.pop() -(1, 2) - - ->>> abc = set('abc') ->>> bcd = set('bcd') ->>> 'a' in abc -True ->>> 'a' in bcd -False ->>> list(abc.intersection(bcd)) -['c', 'b'] ->>> list(abc.union(bcd)) -['a', 'c', 'b', 'd'] - -## From "What's new in Python 2.4", but I added calls to sl - ->>> def sl(x): -... return sorted(list(x)) - - ->>> a = set('abracadabra') # form a set from a string ->>> 'z' in a # fast membership testing -False ->>> sl(a) # unique letters in a -['a', 'b', 'c', 'd', 'r'] - ->>> b = set('alacazam') # form a second set ->>> sl(a - b) # letters in a but not in b -['b', 'd', 'r'] ->>> sl(a | b) # letters in either a or b -['a', 'b', 'c', 'd', 'l', 'm', 'r', 'z'] ->>> sl(a & b) # letters in both a and b -['a', 'c'] ->>> sl(a ^ b) # letters in a or b but not both -['b', 'd', 'l', 'm', 'r', 'z'] - - ->>> a.add('z') # add a new element ->>> a.update('wxy') # add multiple new elements ->>> sl(a) -['a', 'b', 'c', 'd', 'r', 'w', 'x', 'y', 'z'] ->>> a.remove('x') # take one element out ->>> sl(a) -['a', 'b', 'c', 'd', 'r', 'w', 'y', 'z'] From c68b28debda173667b17e461ac863441504b50ea Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Thu, 2 Oct 2014 17:50:41 -0700 Subject: [PATCH 036/246] change to racket naming conventions --- csp/constraint.rkt | 22 +++++------ csp/domain.rkt | 6 +-- csp/main.rkt | 2 + csp/problem.rkt | 82 ++++++++++++++++++++++------------------ csp/solver.rkt | 32 ++++++++-------- csp/test-classes.rkt | 70 +++++++++++++++++++++++----------- csp/test-problems.rkt | 88 +++++++++++++++++++++---------------------- 7 files changed, 169 insertions(+), 133 deletions(-) diff --git a/csp/constraint.rkt b/csp/constraint.rkt index 1f072654..786928eb 100644 --- a/csp/constraint.rkt +++ b/csp/constraint.rkt @@ -3,7 +3,7 @@ (provide (all-defined-out)) -(define Constraint +(define constraint% (class object% (super-new) @@ -67,10 +67,10 @@ return-result) )) -(define Constraint? (is-a?/c Constraint)) +(define constraint%? (is-a?/c constraint%)) -(define FunctionConstraint - (class Constraint +(define function-constraint% + (class constraint% (super-new) (init-field func [assigned #t]) (field [_func func][_assigned assigned]) @@ -96,12 +96,12 @@ (apply _func parms))) )) -(define FunctionConstraint? (is-a?/c FunctionConstraint)) +(define function-constraint%? (is-a?/c function-constraint%)) -(define AllDifferentConstraint +(define all-different-constraint% ;; Constraint enforcing that values of all given variables are different - (class Constraint + (class constraint% (super-new) (define/override (call variables domains assignments [forwardcheck #f] [_unassigned Unassigned]) @@ -133,13 +133,13 @@ (return-k)) return-value))) -(define AllDifferentConstraint? (is-a?/c AllDifferentConstraint)) +(define all-different-constraint%? (is-a?/c all-different-constraint%)) -(define AllEqualConstraint +(define all-equal-constraint% ;; Constraint enforcing that values of all given variables are different - (class Constraint + (class constraint% (super-new) (define/override (call variables domains assignments [forwardcheck #f] [_unassigned Unassigned]) @@ -171,4 +171,4 @@ (return-k)) return-value))) -(define AllEqualConstraint? (is-a?/c AllEqualConstraint)) +(define all-equal-constraint%? (is-a?/c all-equal-constraint%)) diff --git a/csp/domain.rkt b/csp/domain.rkt index 6ba0b1f0..f86b9f7d 100644 --- a/csp/domain.rkt +++ b/csp/domain.rkt @@ -2,7 +2,7 @@ (require racket/class racket/list "helper.rkt") (provide (all-defined-out)) -(define Domain +(define domain% ;; Class used to control possible values for variables ;; When list or tuples are used as domains, they are automatically ;; converted to an instance of that class. @@ -53,12 +53,12 @@ (py-pop! _list)) (define/public (copy) - (define copied-domain (new Domain [set _list])) + (define copied-domain (new domain% [set _list])) (set-field! _hidden copied-domain _hidden) (set-field! _states copied-domain _states) copied-domain) )) -(define Domain? (is-a?/c Domain)) +(define domain%? (is-a?/c domain%)) diff --git a/csp/main.rkt b/csp/main.rkt index 0e1f6385..73d16dac 100644 --- a/csp/main.rkt +++ b/csp/main.rkt @@ -2,10 +2,12 @@ (require "problem.rkt" "constraint.rkt" + "solver.rkt" "helper.rkt") (provide (all-from-out "problem.rkt" "constraint.rkt" + "solver.rkt" "helper.rkt")) diff --git a/csp/problem.rkt b/csp/problem.rkt index 8b8de27a..e6b352a1 100644 --- a/csp/problem.rkt +++ b/csp/problem.rkt @@ -1,26 +1,33 @@ #lang racket/base -(require racket/class sugar/container racket/contract racket/match "domain.rkt" "helper.rkt" "constraint.rkt" "solver.rkt") +(require racket/class sugar/container sugar/debug racket/contract racket/match) +(require "domain.rkt" "helper.rkt" "constraint.rkt" "solver.rkt") (provide (all-defined-out)) -(define/contract Problem +(define/contract problem% ;; Class used to define a problem and retrieve solutions (class/c [reset (->m void?)] - [setSolver (Solver? . ->m . void?)] - [getSolver (->m Solver?)] + [set-solver (solver%? . ->m . void?)] + [get-solver (->m solver%?)] ;; todo: tighten `object?` contract - [addVariable (any/c (or/c list? Domain?) . ->m . void?)] - [getSolutions (->m list?)]) + [add-variable (any/c (or/c list? domain%?) . ->m . void?)] + [add-variables ((listof any/c) (or/c list? domain%?) . ->m . void?)] + [add-constraint (((or/c constraint%? procedure?)) ((listof any/c)) . ->*m . void?)] + [get-solution (->m any/c)] + [get-solutions (->m list?)] + [_get-args (->m (values (listof domain%?) (listof constraint%?) (listof hash?)))]) + (class* object% (printable<%>) (super-new) (init-field [solver #f]) - (field [_solver (or solver (new BacktrackingSolver))] - [_constraints null] - [_variables (make-hash)]) + (field [_solver (or solver (new backtracking-solver%))] + [_constraints #f] + [_variables #f]) + (reset) - (define (repr) (format "" (hash-keys _variables))) + (define (repr) (format "" (hash-keys _variables))) (define/public (custom-print out quoting-depth) (print (repr) out)) (define/public (custom-display out) (displayln (repr) out)) (define/public (custom-write out) (write (repr) out)) @@ -28,61 +35,64 @@ (define/public (reset) ;; Reset the current problem definition (set! _constraints null) - (hash-clear! _variables)) + (set! _variables (make-hash))) - (define/public (setSolver solver) + (define/public (set-solver solver) ;; Change the problem solver currently in use (set! _solver solver)) - (define/public (getSolver) + (define/public (get-solver) ;; Obtain the problem solver currently in use _solver) - (define/public (addVariable variable domain) + (define/public (add-variable variable domain-or-values) ;; Add a variable to the problem - (when (variable . in? . _variables) - (error 'addVariable (format "Tried to insert duplicated variable ~a" variable))) - (cond - [(list? domain) (set! domain (new Domain [set domain]))] - [(Domain? domain) (set! domain (send domain copy))] - [else (error 'addVariable "Domains must be instances of subclasses of Domain")]) - (when (not (object? domain)) (error 'fudge)) - (when (not domain) ; todo: check this test - (error 'addVariable "Domain is empty")) + ;; Contract insures input is Domain object or list of values. + (when (hash-has-key? _variables variable) + (error 'add-variable (format "Tried to insert duplicated variable ~a" variable))) + (define domain (if (domain%? domain-or-values) + (send domain-or-values copy) + (new domain% [set domain-or-values]))) + (when (not (object? domain)) (error 'add-variable "not a Domain object")) + (when (null? (get-field _list domain)) (error 'add-variable "domain value is null")) (hash-set! _variables variable domain)) - (define/public (addVariables variables domain) + (define/public (add-variables variables domain) ;; Add one or more variables to the problem (define listified-variables (cond [(string? variables) (map (λ(c) (format "~a" c)) (string->list variables))] [else variables])) - (for-each (λ(var) (addVariable var domain)) listified-variables)) + (for-each (λ(var) (add-variable var domain)) listified-variables)) - (define/public (addConstraint constraint [variables null]) + (define/public (add-constraint constraint [variables null]) ;; Add a constraint to the problem - (when (not (Constraint? constraint)) + (when (not (constraint%? constraint)) (if (procedure? constraint) - (set! constraint (new FunctionConstraint [func constraint])) - (error 'addConstraint "Constraints must be instances of class Constraint"))) + (set! constraint (new function-constraint% [func constraint])) + (error 'add-constraint "Constraints must be instances of class Constraint"))) (py-append! _constraints (list constraint variables))) - (define/public (getSolution) + (define/public (get-solution) ;; Find and return a solution to the problem - (define-values (domains constraints vconstraints) (_getArgs)) + (define-values (domains constraints vconstraints) (_get-args)) (if (not domains) null - (send _solver getSolution domains constraints vconstraints))) + (send _solver get-solution domains constraints vconstraints))) - (define/public (getSolutions) + (define/public (get-solutions) ;; Find and return all solutions to the problem - (define-values (domains constraints vconstraints) (_getArgs)) + (define-values (domains constraints vconstraints) (_get-args)) (if (not domains) null - (send _solver getSolutions domains constraints vconstraints))) + (send _solver get-solutions domains constraints vconstraints))) + + (define/public (get-solution-iter) + ; Return an iterator to the solutions of the problem + (void)) - (define/public (_getArgs) + (define/public (_get-args) (define domains (hash-copy _variables)) (define allvariables (hash-keys domains)) (define constraints null) diff --git a/csp/solver.rkt b/csp/solver.rkt index 2223859b..357e2fb8 100644 --- a/csp/solver.rkt +++ b/csp/solver.rkt @@ -2,26 +2,24 @@ (require racket/class sugar/container racket/list racket/generator racket/match "helper.rkt") (provide (all-defined-out)) -(define Solver +(define solver% ;; Abstract base class for solvers (class object% (super-new) - (abstract getSolution) - (abstract getSolutions) - (abstract getSolutionIter))) + (abstract get-solution) + (abstract get-solutions) + (abstract get-solution-iter))) -(define Solver? (is-a?/c Solver)) +(define solver%? (is-a?/c solver%)) -(define BacktrackingSolver +(define backtracking-solver% ;; Problem solver with backtracking capabilities - (class Solver + (class solver% (super-new) (init-field [forwardcheck #t]) (field [_forwardcheck forwardcheck]) - (define/override (getSolutionIter domains constraints vconstraints) - - + (define/override (get-solution-iter domains constraints vconstraints) (define forwardcheck _forwardcheck) (define assignments (make-hash)) @@ -139,17 +137,17 @@ (if want-to-return (void) - (error 'getSolutionIter "Whoops, broken solver"))) + (error 'get-solution-iter "Whoops, broken solver"))) (define (call-solution-generator domains constraints vconstraints #:first-only [first-only #f]) - (for/list ([solution (in-generator (getSolutionIter domains constraints vconstraints))] #:final first-only) + (for/list ([solution (in-generator (get-solution-iter domains constraints vconstraints))] #:final first-only) solution)) - (define/override (getSolution . args) + (define/override (get-solution . args) (car (apply call-solution-generator #:first-only #t args))) - (define/override (getSolutions . args) - (apply call-solution-generator args)) - - )) + (define/override (get-solutions . args) + (apply call-solution-generator args)))) + +(define backtracking-solver%? (is-a?/c backtracking-solver%)) diff --git a/csp/test-classes.rkt b/csp/test-classes.rkt index 086f2bdc..427aa61a 100644 --- a/csp/test-classes.rkt +++ b/csp/test-classes.rkt @@ -1,45 +1,71 @@ #lang racket (require rackunit "main.rkt") -(check-equal? (get-field _solver (new Problem [solver 'solver-in])) 'solver-in) -(check-equal? (get-field _constraints (new Problem)) null) -(check-equal? (get-field _variables (new Problem)) (make-hash)) -(define problem (new Problem)) ;; test from line 125 -(send problem addVariable "a" '(1)) -(check-equal? (get-field _list (hash-ref (get-field _variables problem) "a")) '(1)) +;; Problem: fields +(check-equal? (get-field _solver (new problem% [solver 'solver-in])) 'solver-in) +(check-equal? (get-field _constraints (new problem%)) null) +(check-equal? (get-field _variables (new problem%)) (make-hash)) +(define problem null) + +;; Problem: reset +(set! problem (new problem%)) +(define early-solutions (send problem get-solutions)) +(send problem add-variable "a" (range 3)) +(check-not-equal? (send problem get-solutions) early-solutions) (send problem reset) -(check-equal? (get-field _variables problem) (make-hash)) -(send problem addVariables '("a" "b") '(1 2 3)) -(check-equal? (get-field _list (hash-ref (get-field _variables problem) "a")) '(1 2 3)) -(check-equal? (get-field _list (hash-ref (get-field _variables problem) "b")) '(1 2 3)) +(check-equal? (send problem get-solutions) early-solutions) + +;; Problem: setSolver & get-solver +(define solver (new backtracking-solver%)) +(set! problem (new problem% [solver solver])) +(check-true (solver%? (send problem get-solver))) + +;; Problem: add-variable +(set! problem (new problem%)) +(send problem add-variable "a" '(1 2)) +(check-true (or (= (hash-ref (send problem get-solution) "a") 1) + (= (hash-ref (send problem get-solution) "a") 2))) +(check-exn exn:fail? (λ () (send problem add-variable "b" null))) ;; empty domain + + +;; Problem: add-variables +(set! problem (new problem%)) +(send problem add-variables '("a" "b") '(1 2 3)) +(check-equal? (length (send problem get-solutions)) 9) + +;; Problem: add-constraint +(set! problem (new problem%)) +(send problem add-variables '("a" "b") '(1 2 3)) +(send problem add-constraint (λ(a b) (= a (add1 b)))) +(check-equal? (length (send problem get-solutions)) 2) ;; FunctionConstraint, two ways: implicit and explicit (send problem reset) -(send problem addVariables '(a b) '(1 2)) -(send problem addConstraint >) ; implicit -(check-hash-items (send problem getSolution) #hash((a . 1) (b . 2))) +(send problem add-variables '(a b) '(1 2)) +(send problem add-constraint >) ; implicit +(check-hash-items (send problem get-solution) #hash((a . 1) (b . 2))) (send problem reset) -(send problem addVariables '(a b) '(1 2)) -(send problem addConstraint (new FunctionConstraint [func >])) ; explicit -(check-hash-items (send problem getSolution) #hash((a . 1) (b . 2))) +(send problem add-variables '(a b) '(1 2)) +(send problem add-constraint (new function-constraint% [func >])) ; explicit +(check-hash-items (send problem get-solution) #hash((a . 1) (b . 2))) ;; AllDifferentConstraint (send problem reset) -(send problem addVariables '(a b) '(1 2)) -(send problem addConstraint (new AllDifferentConstraint)) -(let ([solutions (send problem getSolutions)]) +(send problem add-variables '(a b) '(1 2)) +(send problem add-constraint (new all-different-constraint%)) +(let ([solutions (send problem get-solutions)]) (check-equal? (hash-ref (first solutions) 'a) (hash-ref (second solutions) 'b)) (check-equal? (hash-ref (second solutions) 'a) (hash-ref (first solutions) 'b))) ;; AllEqualConstraint (send problem reset) -(send problem addVariables '(a b) '(1 2)) -(send problem addConstraint (new AllEqualConstraint)) -(let ([solutions (send problem getSolutions)]) +(send problem add-variables '(a b) '(1 2)) +(send problem add-constraint (new all-equal-constraint%)) +(let ([solutions (send problem get-solutions)]) (check-equal? (hash-ref (first solutions) 'a) (hash-ref (first solutions) 'b)) (check-equal? (hash-ref (second solutions) 'a) (hash-ref (second solutions) 'b))) diff --git a/csp/test-problems.rkt b/csp/test-problems.rkt index 976b9d93..bc901493 100644 --- a/csp/test-problems.rkt +++ b/csp/test-problems.rkt @@ -11,14 +11,14 @@ ;; A+B+C -(define abc-problem (new Problem)) -(send abc-problem addVariables '("a" "b" "c") (range 1 10)) +(define abc-problem (new problem%)) +(send abc-problem add-variables '("a" "b" "c") (range 1 10)) (define (test-solution s) (let ([a (hash-ref s "a")] [b (hash-ref s "b")] [c (hash-ref s "c")]) (/ (+ (* 100 a) (* 10 b) c) (+ a b c)))) -(check-hash-items (argmin test-solution (send abc-problem getSolutions)) +(check-hash-items (argmin test-solution (send abc-problem get-solutions)) #hash(("c" . 9) ("b" . 9) ("a" . 1))) @@ -26,24 +26,24 @@ ;; 26 coins, dollars and quarters ;; that add up to $17. -(define quarter-problem (new Problem)) -(send quarter-problem addVariables '("dollars" "quarters") (range 1 27)) -(send quarter-problem addConstraint (λ(d q) (= 17 (+ d (* 0.25 q)))) '("dollars" "quarters")) -(send quarter-problem addConstraint (λ(d q) (= 26 (+ d q))) '("dollars" "quarters")) -(check-hash-items (send quarter-problem getSolution) '#hash(("dollars" . 14) ("quarters" . 12))) +(define quarter-problem (new problem%)) +(send quarter-problem add-variables '("dollars" "quarters") (range 1 27)) +(send quarter-problem add-constraint (λ(d q) (= 17 (+ d (* 0.25 q)))) '("dollars" "quarters")) +(send quarter-problem add-constraint (λ(d q) (= 26 (+ d q))) '("dollars" "quarters")) +(check-hash-items (send quarter-problem get-solution) '#hash(("dollars" . 14) ("quarters" . 12))) ;; coin problem 2 #| A collection of 33 coins, consisting of nickels, dimes, and quarters, has a value of $3.30. If there are three times as many nickels as quarters, and one-half as many dimes as nickels, how many coins of each kind are there? |# -(define nickel-problem (new Problem)) -(send nickel-problem addVariables '(nickels dimes quarters) (range 1 34)) -(send nickel-problem addConstraint (λ(n d q) (= 33 (+ n d q))) '(nickels dimes quarters)) -(send nickel-problem addConstraint (λ(n d q) (= 3.30 (+ (* 0.05 n) (* 0.1 d) (* 0.25 q)))) '(nickels dimes quarters)) -(send nickel-problem addConstraint (λ(n q) (= n (* 3 q))) '(nickels quarters)) -(send nickel-problem addConstraint (λ(d n) (= n (* 2 d))) '(dimes nickels)) -(check-hash-items (send nickel-problem getSolution) #hash((nickels . 18) (quarters . 6) (dimes . 9))) +(define nickel-problem (new problem%)) +(send nickel-problem add-variables '(nickels dimes quarters) (range 1 34)) +(send nickel-problem add-constraint (λ(n d q) (= 33 (+ n d q))) '(nickels dimes quarters)) +(send nickel-problem add-constraint (λ(n d q) (= 3.30 (+ (* 0.05 n) (* 0.1 d) (* 0.25 q)))) '(nickels dimes quarters)) +(send nickel-problem add-constraint (λ(n q) (= n (* 3 q))) '(nickels quarters)) +(send nickel-problem add-constraint (λ(d n) (= n (* 2 d))) '(dimes nickels)) +(check-hash-items (send nickel-problem get-solution) #hash((nickels . 18) (quarters . 6) (dimes . 9))) ;; word math #| @@ -57,19 +57,19 @@ A collection of 33 coins, consisting of nickels, dimes, and quarters, has a valu |# -(define two-four-problem (new Problem)) -(send two-four-problem addVariables '(t w o f u r) (range 10)) -(send two-four-problem addConstraint (new AllDifferentConstraint)) -(send two-four-problem addConstraint (λ(t w o) (> (word-value t w o) 99)) '(t w o)) -(send two-four-problem addConstraint (λ(f o u r) (> (word-value f o u r) 999)) '(f o u r)) -(send two-four-problem addConstraint +(define two-four-problem (new problem%)) +(send two-four-problem add-variables '(t w o f u r) (range 10)) +(send two-four-problem add-constraint (new all-different-constraint%)) +(send two-four-problem add-constraint (λ(t w o) (> (word-value t w o) 99)) '(t w o)) +(send two-four-problem add-constraint (λ(f o u r) (> (word-value f o u r) 999)) '(f o u r)) +(send two-four-problem add-constraint (λ (t w o f u r) (let ([two (word-value t w o)] [four (word-value f o u r)]) ((two . + . two) . = . four))) '(t w o f u r)) -(check-equal? (length (send two-four-problem getSolutions)) 7) -(send two-four-problem addConstraint (λ(r) (= r 0)) '(r)) -(check-hash-items (send two-four-problem getSolution) #hash((o . 5) (w . 6) (u . 3) (f . 1) (r . 0) (t . 7))) +(check-equal? (length (send two-four-problem get-solutions)) 7) +(send two-four-problem add-constraint (λ(r) (= r 0)) '(r)) +(check-hash-items (send two-four-problem get-solution) #hash((o . 5) (w . 6) (u . 3) (f . 1) (r . 0) (t . 7))) ;; xsum @@ -85,16 +85,16 @@ A collection of 33 coins, consisting of nickels, dimes, and quarters, has a valu # |# -(define xsum-problem (new Problem)) -(send xsum-problem addVariables '(l1 l2 l3 l4 r1 r2 r3 r4 x) (range 10)) -(send xsum-problem addConstraint (λ (l1 l2 l3 l4 x) +(define xsum-problem (new problem%)) +(send xsum-problem add-variables '(l1 l2 l3 l4 r1 r2 r3 r4 x) (range 10)) +(send xsum-problem add-constraint (λ (l1 l2 l3 l4 x) (and (< l1 l2 l3 l4) (= 27 (+ l1 l2 l3 l4 x)))) '(l1 l2 l3 l4 x)) -(send xsum-problem addConstraint (λ (r1 r2 r3 r4 x) +(send xsum-problem add-constraint (λ (r1 r2 r3 r4 x) (and (< r1 r2 r3 r4) (= 27 (+ r1 r2 r3 r4 x)))) '(r1 r2 r3 r4 x)) -(send xsum-problem addConstraint (new AllDifferentConstraint)) -(check-equal? (length (send xsum-problem getSolutions)) 8) +(send xsum-problem add-constraint (new all-different-constraint%)) +(check-equal? (length (send xsum-problem get-solutions)) 8) @@ -109,37 +109,37 @@ A collection of 33 coins, consisting of nickels, dimes, and quarters, has a valu # MONEY |# -(define sm-problem (new Problem)) -(send sm-problem addVariables '(s e n d m o r y) (range 10)) -(send sm-problem addConstraint (λ(x) (> x 0)) '(s)) -(send sm-problem addConstraint (λ(x) (> x 0)) '(m)) -(send sm-problem addConstraint (λ(d e y) (= (modulo (+ d e) 10) y)) '(d e y)) -(send sm-problem addConstraint (λ(n d r e y) +(define sm-problem (new problem%)) +(send sm-problem add-variables '(s e n d m o r y) (range 10)) +(send sm-problem add-constraint (λ(x) (> x 0)) '(s)) +(send sm-problem add-constraint (λ(x) (> x 0)) '(m)) +(send sm-problem add-constraint (λ(d e y) (= (modulo (+ d e) 10) y)) '(d e y)) +(send sm-problem add-constraint (λ(n d r e y) (= (modulo (+ (word-value n d) (word-value r e)) 100) (word-value e y))) '(n d r e y)) -(send sm-problem addConstraint (λ(e n d o r y) +(send sm-problem add-constraint (λ(e n d o r y) (= (modulo (+ (word-value e n d) (word-value o r e)) 1000) (word-value n e y))) '(e n d o r y)) -(send sm-problem addConstraint (λ(s e n d m o r y) (= +(send sm-problem add-constraint (λ(s e n d m o r y) (= (+ (word-value s e n d) (word-value m o r e)) (word-value m o n e y))) '(s e n d m o r y)) -(send sm-problem addConstraint (new AllDifferentConstraint)) +(send sm-problem add-constraint (new all-different-constraint%)) -(check-hash-items (send sm-problem getSolution) '#hash((m . 1) (e . 5) (r . 8) (n . 6) (y . 2) (o . 0) (d . 7) (s . 9))) +(check-hash-items (send sm-problem get-solution) '#hash((m . 1) (e . 5) (r . 8) (n . 6) (y . 2) (o . 0) (d . 7) (s . 9))) ;; queens problem ;; place queens on chessboard so they do not intersect -(define qp (new Problem)) +(define qp (new problem%)) (define cols (range 8)) (define rows (range 8)) -(send qp addVariables cols rows) +(send qp add-variables cols rows) (for* ([col1 (in-list cols)] [col2 (in-list cols)] #:when (< col1 col2)) - (send qp addConstraint (λ(row1 row2 [col1 col1][col2 col2]) + (send qp add-constraint (λ(row1 row2 [col1 col1][col2 col2]) (and ;; test if two cells are on a diagonal (not (= (abs (- row1 row2)) (abs (- col1 col2)))) ;; test if two cells are in same row (not (= row1 row2)))) (list col1 col2))) -(check-equal? (length (send qp getSolutions)) 92) \ No newline at end of file +(check-equal? (length (send qp get-solutions)) 92) \ No newline at end of file From 65efb7c595613bf26653d8fcbe057c27269d144d Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Thu, 2 Oct 2014 18:26:56 -0700 Subject: [PATCH 037/246] refactoring, tests work --- csp/problem.rkt | 85 +++++++++++++++++++++++-------------------- csp/test-classes.rkt | 2 +- csp/test-problems.rkt | 8 ++-- 3 files changed, 50 insertions(+), 45 deletions(-) diff --git a/csp/problem.rkt b/csp/problem.rkt index e6b352a1..3f6ab6d9 100644 --- a/csp/problem.rkt +++ b/csp/problem.rkt @@ -1,5 +1,5 @@ #lang racket/base -(require racket/class sugar/container sugar/debug racket/contract racket/match) +(require racket/class sugar/container sugar/debug racket/contract racket/match racket/generator) (require "domain.rkt" "helper.rkt" "constraint.rkt" "solver.rkt") (provide (all-defined-out)) @@ -23,11 +23,12 @@ (init-field [solver #f]) (field [_solver (or solver (new backtracking-solver%))] [_constraints #f] - [_variables #f]) + [_variable-domains #f]) - (reset) + (reset) ; use method rather than manually set up fields - (define (repr) (format "" (hash-keys _variables))) + ;; implement object printing + (define (repr) (format "" (hash-keys _variable-domains))) (define/public (custom-print out quoting-depth) (print (repr) out)) (define/public (custom-display out) (displayln (repr) out)) (define/public (custom-write out) (write (repr) out)) @@ -35,27 +36,27 @@ (define/public (reset) ;; Reset the current problem definition (set! _constraints null) - (set! _variables (make-hash))) + (set! _variable-domains (make-hash))) (define/public (set-solver solver) - ;; Change the problem solver currently in use + ;; Set the problem solver currently in use (set! _solver solver)) (define/public (get-solver) - ;; Obtain the problem solver currently in use + ;; Get the problem solver currently in use _solver) (define/public (add-variable variable domain-or-values) ;; Add a variable to the problem ;; Contract insures input is Domain object or list of values. - (when (hash-has-key? _variables variable) + (when (hash-has-key? _variable-domains variable) (error 'add-variable (format "Tried to insert duplicated variable ~a" variable))) (define domain (if (domain%? domain-or-values) (send domain-or-values copy) (new domain% [set domain-or-values]))) - (when (not (object? domain)) (error 'add-variable "not a Domain object")) - (when (null? (get-field _list domain)) (error 'add-variable "domain value is null")) - (hash-set! _variables variable domain)) + (when (null? (get-field _list domain)) + (error 'add-variable "domain value is null")) + (hash-set! _variable-domains variable domain)) (define/public (add-variables variables domain) ;; Add one or more variables to the problem @@ -65,60 +66,64 @@ [else variables])) (for-each (λ(var) (add-variable var domain)) listified-variables)) - (define/public (add-constraint constraint [variables null]) + (define/public (add-constraint constraint-or-proc [variables null]) ;; Add a constraint to the problem - - (when (not (constraint%? constraint)) - (if (procedure? constraint) - (set! constraint (new function-constraint% [func constraint])) - (error 'add-constraint "Constraints must be instances of class Constraint"))) + ;; contract guarantees input is procedure or constraint% object + (define constraint (if (procedure? constraint-or-proc) + (new function-constraint% [func constraint-or-proc]) + constraint-or-proc)) (py-append! _constraints (list constraint variables))) + (define-syntax-rule (solution-macro solution-proc null-proc) + (begin + (define-values (domains constraints vconstraints) (_get-args)) + (if (null? domains) + (if null-proc (null-proc null) null) + (send _solver solution-proc domains constraints vconstraints)))) + (define/public (get-solution) ;; Find and return a solution to the problem - (define-values (domains constraints vconstraints) (_get-args)) - (if (not domains) - null - (send _solver get-solution domains constraints vconstraints))) + (solution-macro get-solution #f)) (define/public (get-solutions) ;; Find and return all solutions to the problem - (define-values (domains constraints vconstraints) (_get-args)) - (if (not domains) - null - (send _solver get-solutions domains constraints vconstraints))) + (solution-macro get-solutions #f)) (define/public (get-solution-iter) ; Return an iterator to the solutions of the problem - (void)) + (solution-macro get-solution-iter yield)) (define/public (_get-args) - (define domains (hash-copy _variables)) - (define allvariables (hash-keys domains)) - (define constraints null) - (for ([constraint-variables-pair (in-list _constraints)]) - (match-define (list constraint variables) constraint-variables-pair) - (when (null? variables) - (set! variables allvariables)) - (set! constraints (append constraints (list (list constraint variables))))) - (define vconstraints (make-hash)) - (for ([variable (in-hash-keys domains)]) - (hash-set! vconstraints variable null)) + (define variable-domains (hash-copy _variable-domains)) + (define all-variables (hash-keys variable-domains)) + + ;; set up constraints + (define constraints + (for/list ([constraint-variables-pair (in-list _constraints)]) + (match-define (list constraint variables) constraint-variables-pair) + (list constraint (if (null? variables) all-variables variables)))) + + ;; set up vconstraints + (define vconstraints + (hash-copy ; converts for/hash to mutable hash + (for/hash ([variable (in-hash-keys variable-domains)]) + (values variable null)))) + (for ([constraint-variables-pair (in-list constraints)]) (match-define (list constraint variables) constraint-variables-pair) (for ([variable (in-list variables)]) (hash-update! vconstraints variable (λ(val) (append val (list (list constraint variables))))))) (for ([constraint-variables-pair (in-list constraints)]) (match-define (list constraint variables) constraint-variables-pair) - (send constraint preProcess variables domains constraints vconstraints)) + (send constraint preProcess variables variable-domains constraints vconstraints)) (define result #f) (let/ec done - (for ([domain (in-list (hash-values domains))]) + (for ([domain (in-list (hash-values variable-domains))]) (send domain resetState) (when (not domain) (set! result (list null null null)) (done))) - (set! result (list domains constraints vconstraints))) + (set! result (list variable-domains constraints vconstraints))) (apply values result)) diff --git a/csp/test-classes.rkt b/csp/test-classes.rkt index 427aa61a..39680cc9 100644 --- a/csp/test-classes.rkt +++ b/csp/test-classes.rkt @@ -5,7 +5,7 @@ ;; Problem: fields (check-equal? (get-field _solver (new problem% [solver 'solver-in])) 'solver-in) (check-equal? (get-field _constraints (new problem%)) null) -(check-equal? (get-field _variables (new problem%)) (make-hash)) +(check-equal? (get-field _variable-domains (new problem%)) (make-hash)) (define problem null) diff --git a/csp/test-problems.rkt b/csp/test-problems.rkt index bc901493..59f99b46 100644 --- a/csp/test-problems.rkt +++ b/csp/test-problems.rkt @@ -131,15 +131,15 @@ A collection of 33 coins, consisting of nickels, dimes, and quarters, has a valu ;; queens problem ;; place queens on chessboard so they do not intersect -(define qp (new problem%)) +(define queens-problem (new problem%)) (define cols (range 8)) (define rows (range 8)) -(send qp add-variables cols rows) +(send queens-problem add-variables cols rows) (for* ([col1 (in-list cols)] [col2 (in-list cols)] #:when (< col1 col2)) - (send qp add-constraint (λ(row1 row2 [col1 col1][col2 col2]) + (send queens-problem add-constraint (λ(row1 row2 [col1 col1][col2 col2]) (and ;; test if two cells are on a diagonal (not (= (abs (- row1 row2)) (abs (- col1 col2)))) ;; test if two cells are in same row (not (= row1 row2)))) (list col1 col2))) -(check-equal? (length (send qp get-solutions)) 92) \ No newline at end of file +(check-equal? (length (send queens-problem get-solutions)) 92) \ No newline at end of file From 90effa5431e341cc6ae56de08a43b945f8052ff9 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Thu, 2 Oct 2014 18:56:08 -0700 Subject: [PATCH 038/246] use in-parallel --- csp/constraint.rkt | 2 +- csp/problem.rkt | 15 +++++++-------- 2 files changed, 8 insertions(+), 9 deletions(-) diff --git a/csp/constraint.rkt b/csp/constraint.rkt index 786928eb..ed64eb4b 100644 --- a/csp/constraint.rkt +++ b/csp/constraint.rkt @@ -17,7 +17,7 @@ ;; prune the search space. #t) - (define/public (preProcess variables domains constraints vconstraints) + (define/public (preprocess variables domains constraints vconstraints) ;; Preprocess variable domains ;; This method is called before starting to look for solutions, ;; and is used to prune domains with specific constraint logic diff --git a/csp/problem.rkt b/csp/problem.rkt index 3f6ab6d9..37dc5f64 100644 --- a/csp/problem.rkt +++ b/csp/problem.rkt @@ -1,5 +1,5 @@ #lang racket/base -(require racket/class sugar/container sugar/debug racket/contract racket/match racket/generator) +(require racket/class sugar/container sugar/debug racket/contract racket/match racket/generator racket/list) (require "domain.rkt" "helper.rkt" "constraint.rkt" "solver.rkt") (provide (all-defined-out)) @@ -99,8 +99,7 @@ ;; set up constraints (define constraints - (for/list ([constraint-variables-pair (in-list _constraints)]) - (match-define (list constraint variables) constraint-variables-pair) + (for/list ([(constraint variables) (in-parallel (map first _constraints) (map second _constraints))]) (list constraint (if (null? variables) all-variables variables)))) ;; set up vconstraints @@ -109,13 +108,13 @@ (for/hash ([variable (in-hash-keys variable-domains)]) (values variable null)))) - (for ([constraint-variables-pair (in-list constraints)]) - (match-define (list constraint variables) constraint-variables-pair) + (for ([(constraint variables) (in-parallel (map first constraints) (map second constraints))]) (for ([variable (in-list variables)]) (hash-update! vconstraints variable (λ(val) (append val (list (list constraint variables))))))) - (for ([constraint-variables-pair (in-list constraints)]) - (match-define (list constraint variables) constraint-variables-pair) - (send constraint preProcess variables variable-domains constraints vconstraints)) + + (for ([(constraint variables) (in-parallel (map first constraints) (map second constraints))]) + (send constraint preprocess variables variable-domains constraints vconstraints)) + (define result #f) (let/ec done (for ([domain (in-list (hash-values variable-domains))]) From b5ceb26f8bff066520dc8a61279652c70aacb875 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Thu, 2 Oct 2014 19:10:26 -0700 Subject: [PATCH 039/246] check --- csp/constraint.rkt | 6 +++--- csp/domain.rkt | 8 ++++---- csp/problem.rkt | 19 ++++++++++--------- csp/solver.rkt | 8 ++++---- 4 files changed, 21 insertions(+), 20 deletions(-) diff --git a/csp/constraint.rkt b/csp/constraint.rkt index ed64eb4b..2975965b 100644 --- a/csp/constraint.rkt +++ b/csp/constraint.rkt @@ -59,7 +59,7 @@ (for ([value (in-list (get-field _list domain))]) (hash-set! assignments unassignedvariable value) (when (not (send this call variables domains assignments)) - (send domain hideValue value))) + (send domain hide-value value))) (hash-remove! assignments unassignedvariable)) (when (null? (get-field _list domain)) (set! return-result #f) @@ -125,7 +125,7 @@ (set! domain (hash-ref domains variable)) (for ([value (in-hash-keys seen)]) (when (value . in? . (get-field _list (hash-ref domains variable))) - (send domain hideValue value) + (send domain hide-value value) (when (null? (get-field _list (hash-ref domains variable))) (set! return-value #f) (return-k))))))) @@ -166,7 +166,7 @@ (return-k)) (for ([value (in-list (get-field _list domain))]) (when (not (equal? value singlevalue)) - (send domain hideValue value)))))) + (send domain hide-value value)))))) (set! return-value #t) (return-k)) return-value))) diff --git a/csp/domain.rkt b/csp/domain.rkt index f86b9f7d..54a7c3d5 100644 --- a/csp/domain.rkt +++ b/csp/domain.rkt @@ -17,19 +17,19 @@ (define/public (custom-display out) (displayln (repr) out)) (define/public (custom-write out) (write (repr) out)) - (define/public (resetState) + (define/public (reset-state) ;; Reset to the original domain state, including all possible values (py-extend! _list _hidden) (set! _hidden null) (set! _states null)) - (define/public (pushState) + (define/public (push-state) ;; Save current domain state ;; Variables hidden after that call are restored when that state ;; is popped from the stack. (py-append! _states (length _list))) - (define/public (popState) + (define/public (pop-state) ;; Restore domain state from the top of the stack ;; Variables hidden since the last popped state are then available @@ -39,7 +39,7 @@ (py-extend! _list (take-right _hidden diff)) (set! _hidden (take _hidden (- (length _hidden) diff))))) - (define/public (hideValue value) + (define/public (hide-value value) ;; Hide the given value from the domain ;; After that call the given value won't be seen as a possible value diff --git a/csp/problem.rkt b/csp/problem.rkt index 37dc5f64..1aaac58e 100644 --- a/csp/problem.rkt +++ b/csp/problem.rkt @@ -110,18 +110,19 @@ (for ([(constraint variables) (in-parallel (map first constraints) (map second constraints))]) (for ([variable (in-list variables)]) - (hash-update! vconstraints variable (λ(val) (append val (list (list constraint variables))))))) - + (hash-update! vconstraints variable (λ(val) (cons (list constraint variables) val))))) + ;;(hash-update! vconstraints variable (λ(val) (append val (list (list constraint variables))))))) + (for ([(constraint variables) (in-parallel (map first constraints) (map second constraints))]) (send constraint preprocess variables variable-domains constraints vconstraints)) - - (define result #f) - (let/ec done - (for ([domain (in-list (hash-values variable-domains))]) - (send domain resetState) - (when (not domain) + + (define result (void)) + (let/ec break + (for/last ([domain (in-hash-values variable-domains)]) + (send domain reset-state) + (when (null? (get-field _list domain)) (set! result (list null null null)) - (done))) + (break))) (set! result (list variable-domains constraints vconstraints))) (apply values result)) diff --git a/csp/solver.rkt b/csp/solver.rkt index 357e2fb8..984354ef 100644 --- a/csp/solver.rkt +++ b/csp/solver.rkt @@ -71,7 +71,7 @@ (set-field! _list values (second variable-values-pushdomains)) (set! pushdomains (third variable-values-pushdomains)) (for ([domain (in-list pushdomains)]) - (send domain popState))) + (send domain pop-state))) ;(report variable variable-preloop-2) ;(report assignments assignments-preloop-2) @@ -96,7 +96,7 @@ (set! pushdomains (third variable-values-pushdomains)) (when (not (null? pushdomains)) (for ([domain (in-list pushdomains)]) - (send domain popState))) + (send domain pop-state))) (when (not (null? (get-field _list values))) (break-loop3)) (hash-remove! assignments variable) (loop3)) @@ -108,7 +108,7 @@ (hash-set! assignments variable (send values domain-pop!)) (for ([domain (in-list pushdomains)]) - (send domain pushState)) + (send domain push-state)) ;(report pushdomains pushdomains1) ;(report domains domains1) @@ -126,7 +126,7 @@ (break-loop2))) (for ([domain (in-list pushdomains)]) - (send domain popState)) + (send domain pop-state)) (loop2))) From 1a4904fa539d9f25b5db5df8cdf8be16a4ff5bbe Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Thu, 2 Oct 2014 19:32:52 -0700 Subject: [PATCH 040/246] fix queens --- csp/python-constraint/trials/queens.py | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/csp/python-constraint/trials/queens.py b/csp/python-constraint/trials/queens.py index 73ec4569..deac7131 100755 --- a/csp/python-constraint/trials/queens.py +++ b/csp/python-constraint/trials/queens.py @@ -7,7 +7,7 @@ import sys def main(show=False): problem = Problem() - size = 12 + size = 8 cols = range(size) rows = range(size) problem.addVariables(cols, rows) From 51a2dce4ce986eefacfcdbfd7de6f81ea8eada8e Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Thu, 2 Oct 2014 19:33:01 -0700 Subject: [PATCH 041/246] simplify --- csp/problem.rkt | 50 ++++++++++++++++++++----------------------------- 1 file changed, 20 insertions(+), 30 deletions(-) diff --git a/csp/problem.rkt b/csp/problem.rkt index 1aaac58e..69ec1aa8 100644 --- a/csp/problem.rkt +++ b/csp/problem.rkt @@ -14,8 +14,7 @@ [add-variables ((listof any/c) (or/c list? domain%?) . ->m . void?)] [add-constraint (((or/c constraint%? procedure?)) ((listof any/c)) . ->*m . void?)] [get-solution (->m any/c)] - [get-solutions (->m list?)] - [_get-args (->m (values (listof domain%?) (listof constraint%?) (listof hash?)))]) + [get-solutions (->m list?)]) (class* object% (printable<%>) (super-new) @@ -60,11 +59,12 @@ (define/public (add-variables variables domain) ;; Add one or more variables to the problem - (define listified-variables - (cond - [(string? variables) (map (λ(c) (format "~a" c)) (string->list variables))] - [else variables])) - (for-each (λ(var) (add-variable var domain)) listified-variables)) + (define in-thing (cond + [(string? variables) in-string] + [(list? variables) in-list] + [else (error 'add-variables (format "Don’t know what to do with ~a" variables))])) + (for ([var (in-thing variables)]) + (add-variable var domain))) (define/public (add-constraint constraint-or-proc [variables null]) ;; Add a constraint to the problem @@ -76,7 +76,7 @@ (define-syntax-rule (solution-macro solution-proc null-proc) (begin - (define-values (domains constraints vconstraints) (_get-args)) + (define-values (domains constraints vconstraints) (get-args)) (if (null? domains) (if null-proc (null-proc null) null) (send _solver solution-proc domains constraints vconstraints)))) @@ -93,38 +93,28 @@ ; Return an iterator to the solutions of the problem (solution-macro get-solution-iter yield)) - (define/public (_get-args) + (define (get-args) (define variable-domains (hash-copy _variable-domains)) - (define all-variables (hash-keys variable-domains)) - ;; set up constraints (define constraints - (for/list ([(constraint variables) (in-parallel (map first _constraints) (map second _constraints))]) - (list constraint (if (null? variables) all-variables variables)))) + (let ([all-variables (hash-keys variable-domains)]) + (for/list ([(constraint variables) (in-parallel (map first _constraints) (map second _constraints))]) + (list constraint (if (null? variables) all-variables variables))))) - ;; set up vconstraints (define vconstraints (hash-copy ; converts for/hash to mutable hash (for/hash ([variable (in-hash-keys variable-domains)]) (values variable null)))) - (for ([(constraint variables) (in-parallel (map first constraints) (map second constraints))]) - (for ([variable (in-list variables)]) - (hash-update! vconstraints variable (λ(val) (cons (list constraint variables) val))))) - ;;(hash-update! vconstraints variable (λ(val) (append val (list (list constraint variables))))))) + (for* ([(constraint variables) (in-parallel (map first constraints) (map second constraints))] + [variable (in-list variables)]) + (hash-update! vconstraints variable (λ(val) (cons (list constraint variables) val)))) (for ([(constraint variables) (in-parallel (map first constraints) (map second constraints))]) (send constraint preprocess variables variable-domains constraints vconstraints)) - (define result (void)) - (let/ec break - (for/last ([domain (in-hash-values variable-domains)]) - (send domain reset-state) - (when (null? (get-field _list domain)) - (set! result (list null null null)) - (break))) - (set! result (list variable-domains constraints vconstraints))) - (apply values result)) - - - )) \ No newline at end of file + (if (for/or ([domain (in-hash-values variable-domains)]) + (send domain reset-state) + (null? (get-field _list domain))) + (values null null null) + (values variable-domains constraints vconstraints))))) \ No newline at end of file From 499b35c3d53ce3c53de10ff7455ae209f4cc75ee Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Thu, 2 Oct 2014 19:36:04 -0700 Subject: [PATCH 042/246] nits --- csp/problem.rkt | 25 ++++++++++++------------- 1 file changed, 12 insertions(+), 13 deletions(-) diff --git a/csp/problem.rkt b/csp/problem.rkt index 69ec1aa8..7c3def11 100644 --- a/csp/problem.rkt +++ b/csp/problem.rkt @@ -9,7 +9,6 @@ (class/c [reset (->m void?)] [set-solver (solver%? . ->m . void?)] [get-solver (->m solver%?)] - ;; todo: tighten `object?` contract [add-variable (any/c (or/c list? domain%?) . ->m . void?)] [add-variables ((listof any/c) (or/c list? domain%?) . ->m . void?)] [add-constraint (((or/c constraint%? procedure?)) ((listof any/c)) . ->*m . void?)] @@ -32,22 +31,22 @@ (define/public (custom-display out) (displayln (repr) out)) (define/public (custom-write out) (write (repr) out)) + ;; Reset the current problem definition (define/public (reset) - ;; Reset the current problem definition (set! _constraints null) (set! _variable-domains (make-hash))) + ;; Set the problem solver currently in use (define/public (set-solver solver) - ;; Set the problem solver currently in use (set! _solver solver)) + ;; Get the problem solver currently in use (define/public (get-solver) - ;; Get the problem solver currently in use _solver) + ;; Add a variable to the problem + ;; Contract insures input is Domain object or list of values. (define/public (add-variable variable domain-or-values) - ;; Add a variable to the problem - ;; Contract insures input is Domain object or list of values. (when (hash-has-key? _variable-domains variable) (error 'add-variable (format "Tried to insert duplicated variable ~a" variable))) (define domain (if (domain%? domain-or-values) @@ -57,8 +56,8 @@ (error 'add-variable "domain value is null")) (hash-set! _variable-domains variable domain)) + ;; Add one or more variables to the problem (define/public (add-variables variables domain) - ;; Add one or more variables to the problem (define in-thing (cond [(string? variables) in-string] [(list? variables) in-list] @@ -66,9 +65,9 @@ (for ([var (in-thing variables)]) (add-variable var domain))) + ;; Add a constraint to the problem + ;; contract guarantees input is procedure or constraint% object (define/public (add-constraint constraint-or-proc [variables null]) - ;; Add a constraint to the problem - ;; contract guarantees input is procedure or constraint% object (define constraint (if (procedure? constraint-or-proc) (new function-constraint% [func constraint-or-proc]) constraint-or-proc)) @@ -81,19 +80,19 @@ (if null-proc (null-proc null) null) (send _solver solution-proc domains constraints vconstraints)))) + ;; Find and return a solution to the problem (define/public (get-solution) - ;; Find and return a solution to the problem (solution-macro get-solution #f)) + ;; Find and return all solutions to the problem (define/public (get-solutions) - ;; Find and return all solutions to the problem (solution-macro get-solutions #f)) + ;; Return an iterator to the solutions of the problem (define/public (get-solution-iter) - ; Return an iterator to the solutions of the problem (solution-macro get-solution-iter yield)) - (define (get-args) + (define/private (get-args) (define variable-domains (hash-copy _variable-domains)) (define constraints From 7a070bce85a8621e1c63783c16e2801a29e76c4c Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Thu, 2 Oct 2014 22:46:42 -0700 Subject: [PATCH 043/246] for/fold --- csp/constraint.rkt | 38 +++++++++++++++++++------------------- 1 file changed, 19 insertions(+), 19 deletions(-) diff --git a/csp/constraint.rkt b/csp/constraint.rkt index 2975965b..f8aac606 100644 --- a/csp/constraint.rkt +++ b/csp/constraint.rkt @@ -2,12 +2,11 @@ (require racket/class sugar/container "helper.rkt" "variable.rkt") (provide (all-defined-out)) - (define constraint% (class object% (super-new) - (define/public (call variables domains assignments [forwardcheck #f]) + (define/public (call variables domains assignments [forward-check? #f]) ;; Perform the constraint checking ;; If the forwardcheck parameter is not false, besides telling if @@ -18,7 +17,8 @@ #t) (define/public (preprocess variables domains constraints vconstraints) - ;; Preprocess variable domains + ;; todo: functionalize this + ;; Preprocess variable domains ;; This method is called before starting to look for solutions, ;; and is used to prune domains with specific constraint logic ;; when possible. For instance, any constraints with a single @@ -26,18 +26,18 @@ ;; since they may act on individual values even without further ;; knowledge about other assignments. (when (= (length variables) 1) - (define variable (list-ref variables 0)) + (define variable (car variables)) (define domain (hash-ref domains variable)) - (for ([value (in-list (get-field _list domain))]) - - (when (not (call variables domains (make-hash (list (cons variable value))))) - (set-field! _list domain (remove value (get-field _list domain))))) - + (set-field! _list domain + (for/fold ([domain-values (get-field _list domain)]) + ([value (in-list (get-field _list domain))] + #:when (not (call variables domains (make-hash (list (cons variable value)))))) + (remove value domain-values))) (set! constraints (remove (list this variables) constraints)) (hash-update! vconstraints variable (λ(val) (remove (list this variables) val))))) - (define/public (forwardCheck variables domains assignments [_unassigned Unassigned]) - ;; Helper method for generic forward checking + (define/public (forward-check variables domains assignments [_unassigned Unassigned]) + ;; Helper method for generic forward checking ;; Currently, this method acts only when there's a single ;; unassigned variable. (define return-result #t) @@ -75,8 +75,8 @@ (init-field func [assigned #t]) (field [_func func][_assigned assigned]) - (inherit forwardCheck) - (define/override (call variables domains assignments [forwardcheck #f] [_unassigned Unassigned]) + (inherit forward-check) + (define/override (call variables domains assignments [forward-check? #f] [_unassigned Unassigned]) ;(report assignments assignments-before) (define parms (for/list ([x (in-list variables)]) (if (hash-has-key? assignments x) (hash-ref assignments x) _unassigned))) @@ -91,8 +91,8 @@ ;(report forwardcheck) ;(report assignments assignments-to-fc) (and (or _assigned (apply _func parms)) - (or (not forwardcheck) (not (= missing 1)) - (forwardCheck variables domains assignments)))) + (or (not forward-check?) (not (= missing 1)) + (forward-check variables domains assignments)))) (apply _func parms))) )) @@ -104,7 +104,7 @@ (class constraint% (super-new) - (define/override (call variables domains assignments [forwardcheck #f] [_unassigned Unassigned]) + (define/override (call variables domains assignments [forward-check? #f] [_unassigned Unassigned]) (define seen (make-hash)) (define value #f) (define domain #f) @@ -119,7 +119,7 @@ (set! return-value #f) (return-k)) (hash-set! seen value #t))) - (when forwardcheck + (when forward-check? (for ([variable (in-list variables)]) (when (not (variable . in? . assignments)) (set! domain (hash-ref domains variable)) @@ -142,7 +142,7 @@ (class constraint% (super-new) - (define/override (call variables domains assignments [forwardcheck #f] [_unassigned Unassigned]) + (define/override (call variables domains assignments [forward-check? #f] [_unassigned Unassigned]) (define singlevalue _unassigned) (define value #f) (define domain #f) @@ -157,7 +157,7 @@ [(and (not (equal? value _unassigned)) (not (equal? value singlevalue))) (set! return-value #f) (return-k)])) - (when (and forwardcheck (not (equal? singlevalue _unassigned))) + (when (and forward-check? (not (equal? singlevalue _unassigned))) (for ([variable (in-list variables)]) (when (not (variable . in? . assignments)) (set! domain (hash-ref domains variable)) From 78cda8254fe927caa758a5ee1569830fef5d3f21 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Thu, 2 Oct 2014 23:03:59 -0700 Subject: [PATCH 044/246] small change --- csp/constraint.rkt | 17 ++++++++--------- 1 file changed, 8 insertions(+), 9 deletions(-) diff --git a/csp/constraint.rkt b/csp/constraint.rkt index f8aac606..bc0533a5 100644 --- a/csp/constraint.rkt +++ b/csp/constraint.rkt @@ -40,16 +40,15 @@ ;; Helper method for generic forward checking ;; Currently, this method acts only when there's a single ;; unassigned variable. - (define return-result #t) - - (define unassignedvariable _unassigned) - ;(report assignments) + (define return-result (void)) (let/ec break - (for ([variable (in-list variables)]) - (when (not (variable . in? . assignments)) - (if (equal? unassignedvariable _unassigned) - (set! unassignedvariable variable) - (break)))) + (set! return-result #t) + (define unassignedvariable _unassigned) + (for ([variable (in-list variables)] + #:when (not (hash-has-key? assignments variable))) + (if (equal? unassignedvariable _unassigned) + (set! unassignedvariable variable) + (break))) (when (not (equal? unassignedvariable _unassigned)) ;; Remove from the unassigned variable domain's all ;; values which break our variable's constraints. From 3339d075aa835d7dc4e94028b7301fa26e9f767a Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Thu, 2 Oct 2014 23:28:27 -0700 Subject: [PATCH 045/246] tiny --- csp/constraint.rkt | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/csp/constraint.rkt b/csp/constraint.rkt index bc0533a5..bb6e2a4b 100644 --- a/csp/constraint.rkt +++ b/csp/constraint.rkt @@ -50,10 +50,10 @@ (set! unassignedvariable variable) (break))) (when (not (equal? unassignedvariable _unassigned)) - ;; Remove from the unassigned variable domain's all + + ;; Remove from the unassigned variable's domain all ;; values which break our variable's constraints. (define domain (hash-ref domains unassignedvariable)) - ;(report domain domain-fc) (when (not (null? (get-field _list domain))) (for ([value (in-list (get-field _list domain))]) (hash-set! assignments unassignedvariable value) From 76d990daff744b1ca84290946b5a0e70b1f9b7fd Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Fri, 3 Oct 2014 00:10:52 -0700 Subject: [PATCH 046/246] simplify --- csp/constraint.rkt | 55 +++++++++++++++++++--------------------------- csp/domain.rkt | 5 +++++ csp/problem.rkt | 4 ++-- 3 files changed, 30 insertions(+), 34 deletions(-) diff --git a/csp/constraint.rkt b/csp/constraint.rkt index bb6e2a4b..31fd282c 100644 --- a/csp/constraint.rkt +++ b/csp/constraint.rkt @@ -1,5 +1,5 @@ #lang racket/base -(require racket/class sugar/container "helper.rkt" "variable.rkt") +(require racket/class sugar/container sugar/debug racket/list "helper.rkt" "variable.rkt") (provide (all-defined-out)) (define constraint% @@ -29,41 +29,32 @@ (define variable (car variables)) (define domain (hash-ref domains variable)) (set-field! _list domain - (for/fold ([domain-values (get-field _list domain)]) - ([value (in-list (get-field _list domain))] + (for/fold ([domain-values (send domain get-values)]) + ([value (in-list (send domain get-values))] #:when (not (call variables domains (make-hash (list (cons variable value)))))) (remove value domain-values))) (set! constraints (remove (list this variables) constraints)) (hash-update! vconstraints variable (λ(val) (remove (list this variables) val))))) + ;; Helper method for generic forward checking + ;; Currently, this method acts only when there's a single + ;; unassigned variable. (define/public (forward-check variables domains assignments [_unassigned Unassigned]) - ;; Helper method for generic forward checking - ;; Currently, this method acts only when there's a single - ;; unassigned variable. - (define return-result (void)) - (let/ec break - (set! return-result #t) - (define unassignedvariable _unassigned) - (for ([variable (in-list variables)] - #:when (not (hash-has-key? assignments variable))) - (if (equal? unassignedvariable _unassigned) - (set! unassignedvariable variable) - (break))) - (when (not (equal? unassignedvariable _unassigned)) - - ;; Remove from the unassigned variable's domain all - ;; values which break our variable's constraints. - (define domain (hash-ref domains unassignedvariable)) - (when (not (null? (get-field _list domain))) - (for ([value (in-list (get-field _list domain))]) - (hash-set! assignments unassignedvariable value) - (when (not (send this call variables domains assignments)) - (send domain hide-value value))) - (hash-remove! assignments unassignedvariable)) - (when (null? (get-field _list domain)) - (set! return-result #f) - (break)))) - return-result) + (define unassigned-variables + (filter-not (λ(v) (hash-has-key? assignments v)) variables)) + (cond + ;; Remove from the unassigned variable's domain + ;; all values that break our variable's constraints. + [(= (length unassigned-variables) 1) + (define unassigned-variable (car unassigned-variables)) + (define domain (hash-ref domains unassigned-variable)) + (for ([value (in-list (send domain get-values))]) + (hash-set! assignments unassigned-variable value) + (when (not (call variables domains assignments)) + (send domain hide-value value))) + (hash-remove! assignments unassigned-variable) + (not (send domain values-empty?))] + [else #t])) )) (define constraint%? (is-a?/c constraint%)) @@ -160,10 +151,10 @@ (for ([variable (in-list variables)]) (when (not (variable . in? . assignments)) (set! domain (hash-ref domains variable)) - (when (not (singlevalue . in? . (get-field _list domain))) + (when (not (singlevalue . in? . (send domain get-values))) (set! return-value #f) (return-k)) - (for ([value (in-list (get-field _list domain))]) + (for ([value (in-list (send domain get-values))]) (when (not (equal? value singlevalue)) (send domain hide-value value)))))) (set! return-value #t) diff --git a/csp/domain.rkt b/csp/domain.rkt index 54a7c3d5..de71200d 100644 --- a/csp/domain.rkt +++ b/csp/domain.rkt @@ -48,6 +48,11 @@ (set! _list (remove value _list)) (py-append! _hidden value)) + (define/public (get-values) + _list) + + (define/public (values-empty?) + (null? _list)) (define/public (domain-pop!) (py-pop! _list)) diff --git a/csp/problem.rkt b/csp/problem.rkt index 7c3def11..d94e8459 100644 --- a/csp/problem.rkt +++ b/csp/problem.rkt @@ -52,7 +52,7 @@ (define domain (if (domain%? domain-or-values) (send domain-or-values copy) (new domain% [set domain-or-values]))) - (when (null? (get-field _list domain)) + (when (send domain values-empty?) (error 'add-variable "domain value is null")) (hash-set! _variable-domains variable domain)) @@ -114,6 +114,6 @@ (if (for/or ([domain (in-hash-values variable-domains)]) (send domain reset-state) - (null? (get-field _list domain))) + (send domain values-empty?)) (values null null null) (values variable-domains constraints vconstraints))))) \ No newline at end of file From 381b2ee18d83b84f1684c74db5938c3a350dc1aa Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Fri, 3 Oct 2014 00:46:47 -0700 Subject: [PATCH 047/246] tweaks --- csp/constraint.rkt | 51 ++++++++++++++++++---------------------------- 1 file changed, 20 insertions(+), 31 deletions(-) diff --git a/csp/constraint.rkt b/csp/constraint.rkt index 31fd282c..3423c16c 100644 --- a/csp/constraint.rkt +++ b/csp/constraint.rkt @@ -66,23 +66,14 @@ (field [_func func][_assigned assigned]) (inherit forward-check) + (define/override (call variables domains assignments [forward-check? #f] [_unassigned Unassigned]) - ;(report assignments assignments-before) - (define parms (for/list ([x (in-list variables)]) - (if (hash-has-key? assignments x) (hash-ref assignments x) _unassigned))) - ;(report assignments assignments-after) - (define missing (length (filter (λ(v) (equal? v _unassigned)) parms))) + (define parms (map (λ(v) (hash-ref assignments v _unassigned)) variables)) + (define missing (length (filter (λ(p) (equal? p _unassigned)) parms))) (if (> missing 0) - (begin - ;(report missing) - ;(report _assigned) - ;(report parms) - ;(report (apply _func parms)) - ;(report forwardcheck) - ;(report assignments assignments-to-fc) - (and (or _assigned (apply _func parms)) - (or (not forward-check?) (not (= missing 1)) - (forward-check variables domains assignments)))) + (and (or _assigned (apply _func parms)) + (or (not forward-check?) (not (= missing 1)) + (forward-check variables domains assignments))) (apply _func parms))) )) @@ -96,27 +87,25 @@ (define/override (call variables domains assignments [forward-check? #f] [_unassigned Unassigned]) (define seen (make-hash)) - (define value #f) - (define domain #f) (define return-value (void)) + (let/ec return-k - (for ([variable (in-list variables)]) - (set! value (if (hash-has-key? assignments variable) - (hash-ref assignments variable) - _unassigned)) - (when (not (equal? value _unassigned)) - (when (value . in? . seen) - (set! return-value #f) - (return-k)) - (hash-set! seen value #t))) + (define values (map (λ(v) (hash-ref assignments v _unassigned)) variables)) + (for ([value (in-list values)] + #:when (not (equal? value _unassigned))) + (when (hash-has-key? (report seen) value) + (set! return-value #f) + (return-k)) + (hash-set! seen value #t)) + (when forward-check? (for ([variable (in-list variables)]) - (when (not (variable . in? . assignments)) - (set! domain (hash-ref domains variable)) - (for ([value (in-hash-keys seen)]) - (when (value . in? . (get-field _list (hash-ref domains variable))) + (when (not (hash-has-key? assignments variable)) + (let ([domain (hash-ref domains variable)]) + (for ([value (in-hash-keys seen)] + #:when (member value (send domain get-values))) (send domain hide-value value) - (when (null? (get-field _list (hash-ref domains variable))) + (when (send domain values-empty?) (set! return-value #f) (return-k))))))) (set! return-value #t) From 5ae60479fc241239e9c760f41feef0bfe9d223f2 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Fri, 3 Oct 2014 16:50:26 -0700 Subject: [PATCH 048/246] add `contains-value?` --- csp/domain.rkt | 3 +++ 1 file changed, 3 insertions(+) diff --git a/csp/domain.rkt b/csp/domain.rkt index de71200d..3242939e 100644 --- a/csp/domain.rkt +++ b/csp/domain.rkt @@ -54,6 +54,9 @@ (define/public (values-empty?) (null? _list)) + (define/public (contains-value? value) + (member value _list)) + (define/public (domain-pop!) (py-pop! _list)) From 9550307cb83014c2de2a692d353563b691f5c31a Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Fri, 3 Oct 2014 16:50:46 -0700 Subject: [PATCH 049/246] clean up `all-different-constraint` --- csp/constraint.rkt | 40 ++++++++++++++-------------------------- 1 file changed, 14 insertions(+), 26 deletions(-) diff --git a/csp/constraint.rkt b/csp/constraint.rkt index 3423c16c..952963cd 100644 --- a/csp/constraint.rkt +++ b/csp/constraint.rkt @@ -1,5 +1,5 @@ #lang racket/base -(require racket/class sugar/container sugar/debug racket/list "helper.rkt" "variable.rkt") +(require racket/class sugar/container sugar/list sugar/debug racket/list "helper.rkt" "variable.rkt") (provide (all-defined-out)) (define constraint% @@ -86,31 +86,19 @@ (super-new) (define/override (call variables domains assignments [forward-check? #f] [_unassigned Unassigned]) - (define seen (make-hash)) - (define return-value (void)) - - (let/ec return-k - (define values (map (λ(v) (hash-ref assignments v _unassigned)) variables)) - (for ([value (in-list values)] - #:when (not (equal? value _unassigned))) - (when (hash-has-key? (report seen) value) - (set! return-value #f) - (return-k)) - (hash-set! seen value #t)) - - (when forward-check? - (for ([variable (in-list variables)]) - (when (not (hash-has-key? assignments variable)) - (let ([domain (hash-ref domains variable)]) - (for ([value (in-hash-keys seen)] - #:when (member value (send domain get-values))) - (send domain hide-value value) - (when (send domain values-empty?) - (set! return-value #f) - (return-k))))))) - (set! return-value #t) - (return-k)) - return-value))) + (define-values (assigned-vars unassigned-vars) + (partition (λ(var) (hash-has-key? assignments var)) variables)) + (define assigned-values (map (λ(var) (hash-ref assignments var)) assigned-vars)) + (cond + [(not (members-unique? assigned-values)) #f] ; constraint failed because they're not all different + [(and forward-check? + (for*/or ([unassigned-var-domain (in-list (map (λ(uv) (hash-ref domains uv)) unassigned-vars))] + [assigned-value (in-list assigned-values)] + #:when (send unassigned-var-domain contains-value? assigned-value)) + (send unassigned-var-domain hide-value assigned-value) + (send unassigned-var-domain values-empty?))) #f] ; if domain had no remaining values, the constraint will be impossible to meet, so return #f + [else #t])))) + (define all-different-constraint%? (is-a?/c all-different-constraint%)) From 12ce5718db9199ca16906d013a4f01fc0e54e2fc Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Fri, 3 Oct 2014 19:37:52 -0700 Subject: [PATCH 050/246] tidying --- csp/constraint.rkt | 25 +++++++++++-------------- 1 file changed, 11 insertions(+), 14 deletions(-) diff --git a/csp/constraint.rkt b/csp/constraint.rkt index 952963cd..0bf3381c 100644 --- a/csp/constraint.rkt +++ b/csp/constraint.rkt @@ -47,13 +47,13 @@ ;; all values that break our variable's constraints. [(= (length unassigned-variables) 1) (define unassigned-variable (car unassigned-variables)) - (define domain (hash-ref domains unassigned-variable)) - (for ([value (in-list (send domain get-values))]) + (define unassigned-variable-domain (hash-ref domains unassigned-variable)) + (for ([value (in-list (send unassigned-variable-domain get-values))]) (hash-set! assignments unassigned-variable value) (when (not (call variables domains assignments)) - (send domain hide-value value))) + (send unassigned-variable-domain hide-value value))) (hash-remove! assignments unassigned-variable) - (not (send domain values-empty?))] + (not (send unassigned-variable-domain values-empty?))] ; if domain had no remaining values, the constraint will be impossible to meet, so return #f [else #t])) )) @@ -62,8 +62,10 @@ (define function-constraint% (class constraint% (super-new) + (init-field func [assigned #t]) - (field [_func func][_assigned assigned]) + + (field [_func func][_assigned assigned]) (inherit forward-check) @@ -74,14 +76,12 @@ (and (or _assigned (apply _func parms)) (or (not forward-check?) (not (= missing 1)) (forward-check variables domains assignments))) - (apply _func parms))) - - )) + (apply _func parms))))) + (define function-constraint%? (is-a?/c function-constraint%)) +;; Constraint enforcing that values of all given variables are different (define all-different-constraint% - ;; Constraint enforcing that values of all given variables are different - (class constraint% (super-new) @@ -99,13 +99,10 @@ (send unassigned-var-domain values-empty?))) #f] ; if domain had no remaining values, the constraint will be impossible to meet, so return #f [else #t])))) - (define all-different-constraint%? (is-a?/c all-different-constraint%)) - +;; Constraint enforcing that values of all given variables are different (define all-equal-constraint% - ;; Constraint enforcing that values of all given variables are different - (class constraint% (super-new) From e872ed7f64217008db101ba6297458bae368b261 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Sat, 4 Oct 2014 09:59:40 -0700 Subject: [PATCH 051/246] add proc<%> interface to domain --- csp/constraint.rkt | 16 ++++++++-------- csp/domain.rkt | 30 ++++++++++++++---------------- csp/problem.rkt | 9 ++++----- 3 files changed, 26 insertions(+), 29 deletions(-) diff --git a/csp/constraint.rkt b/csp/constraint.rkt index 0bf3381c..1ed991de 100644 --- a/csp/constraint.rkt +++ b/csp/constraint.rkt @@ -29,8 +29,8 @@ (define variable (car variables)) (define domain (hash-ref domains variable)) (set-field! _list domain - (for/fold ([domain-values (send domain get-values)]) - ([value (in-list (send domain get-values))] + (for/fold ([domain-values (domain)]) + ([value (in-list (domain))] #:when (not (call variables domains (make-hash (list (cons variable value)))))) (remove value domain-values))) (set! constraints (remove (list this variables) constraints)) @@ -48,12 +48,12 @@ [(= (length unassigned-variables) 1) (define unassigned-variable (car unassigned-variables)) (define unassigned-variable-domain (hash-ref domains unassigned-variable)) - (for ([value (in-list (send unassigned-variable-domain get-values))]) + (for ([value (in-list (unassigned-variable-domain))]) (hash-set! assignments unassigned-variable value) (when (not (call variables domains assignments)) (send unassigned-variable-domain hide-value value))) (hash-remove! assignments unassigned-variable) - (not (send unassigned-variable-domain values-empty?))] ; if domain had no remaining values, the constraint will be impossible to meet, so return #f + (not (null? unassigned-variable-domain))] ; if domain had no remaining values, the constraint will be impossible to meet, so return #f [else #t])) )) @@ -94,9 +94,9 @@ [(and forward-check? (for*/or ([unassigned-var-domain (in-list (map (λ(uv) (hash-ref domains uv)) unassigned-vars))] [assigned-value (in-list assigned-values)] - #:when (send unassigned-var-domain contains-value? assigned-value)) + #:when (member assigned-value (unassigned-var-domain))) (send unassigned-var-domain hide-value assigned-value) - (send unassigned-var-domain values-empty?))) #f] ; if domain had no remaining values, the constraint will be impossible to meet, so return #f + (null? unassigned-var-domain))) #f] ; if domain had no remaining values, the constraint will be impossible to meet, so return #f [else #t])))) (define all-different-constraint%? (is-a?/c all-different-constraint%)) @@ -125,10 +125,10 @@ (for ([variable (in-list variables)]) (when (not (variable . in? . assignments)) (set! domain (hash-ref domains variable)) - (when (not (singlevalue . in? . (send domain get-values))) + (when (not (singlevalue . in? . (domain))) (set! return-value #f) (return-k)) - (for ([value (in-list (send domain get-values))]) + (for ([value (in-list (domain))]) (when (not (equal? value singlevalue)) (send domain hide-value value)))))) (set! return-value #t) diff --git a/csp/domain.rkt b/csp/domain.rkt index 3242939e..a9063e6f 100644 --- a/csp/domain.rkt +++ b/csp/domain.rkt @@ -2,12 +2,18 @@ (require racket/class racket/list "helper.rkt") (provide (all-defined-out)) -(define domain% - ;; Class used to control possible values for variables - ;; When list or tuples are used as domains, they are automatically - ;; converted to an instance of that class. - - (class* object% (printable<%>) +(define proc<%> + (interface* () + ([prop:procedure + (λ(this) + (send this get-values))]) + get-values)) + +;; Class used to control possible values for variables +;; When list or tuples are used as domains, they are automatically +;; converted to an instance of that class. +(define domain% + (class* object% (printable<%> proc<%>) (super-new) (init-field set) (field [_list set][_hidden null][_states null]) @@ -51,12 +57,6 @@ (define/public (get-values) _list) - (define/public (values-empty?) - (null? _list)) - - (define/public (contains-value? value) - (member value _list)) - (define/public (domain-pop!) (py-pop! _list)) @@ -64,9 +64,7 @@ (define copied-domain (new domain% [set _list])) (set-field! _hidden copied-domain _hidden) (set-field! _states copied-domain _states) - copied-domain) - - - )) + copied-domain))) + (define domain%? (is-a?/c domain%)) diff --git a/csp/problem.rkt b/csp/problem.rkt index d94e8459..852b795a 100644 --- a/csp/problem.rkt +++ b/csp/problem.rkt @@ -3,9 +3,8 @@ (require "domain.rkt" "helper.rkt" "constraint.rkt" "solver.rkt") (provide (all-defined-out)) -(define/contract problem% - ;; Class used to define a problem and retrieve solutions - +;; Class used to define a problem and retrieve solutions +(define/contract problem% (class/c [reset (->m void?)] [set-solver (solver%? . ->m . void?)] [get-solver (->m solver%?)] @@ -52,7 +51,7 @@ (define domain (if (domain%? domain-or-values) (send domain-or-values copy) (new domain% [set domain-or-values]))) - (when (send domain values-empty?) + (when (null? (domain)) (error 'add-variable "domain value is null")) (hash-set! _variable-domains variable domain)) @@ -114,6 +113,6 @@ (if (for/or ([domain (in-hash-values variable-domains)]) (send domain reset-state) - (send domain values-empty?)) + (null? (domain))) (values null null null) (values variable-domains constraints vconstraints))))) \ No newline at end of file From b9263f0b37fd445aff1ed2aa8f8b69cc545a9db9 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Sat, 4 Oct 2014 18:07:57 -0700 Subject: [PATCH 052/246] add `make-proc<%>` --- csp/domain.rkt | 9 +-------- csp/helper.rkt | 9 ++++++++- 2 files changed, 9 insertions(+), 9 deletions(-) diff --git a/csp/domain.rkt b/csp/domain.rkt index a9063e6f..a04b7db8 100644 --- a/csp/domain.rkt +++ b/csp/domain.rkt @@ -2,18 +2,11 @@ (require racket/class racket/list "helper.rkt") (provide (all-defined-out)) -(define proc<%> - (interface* () - ([prop:procedure - (λ(this) - (send this get-values))]) - get-values)) - ;; Class used to control possible values for variables ;; When list or tuples are used as domains, they are automatically ;; converted to an instance of that class. (define domain% - (class* object% (printable<%> proc<%>) + (class* object% (printable<%> (make-proc<%> get-values)) (super-new) (init-field set) (field [_list set][_hidden null][_states null]) diff --git a/csp/helper.rkt b/csp/helper.rkt index ffb993ce..71bc942f 100644 --- a/csp/helper.rkt +++ b/csp/helper.rkt @@ -1,8 +1,15 @@ #lang racket/base -(require racket/list) +(require racket/class racket/list (for-syntax racket/base racket/syntax)) (provide (all-defined-out)) (require rackunit) +(define-syntax-rule (make-proc<%> proc-name) + (interface* () + ([prop:procedure + (λ(this . args) + (send/apply this proc-name args))]) + proc-name)) + (define-simple-check (check-hash-items h1 h2) (for/and ([(k1 v1) (in-hash h1)]) (equal? (hash-ref h2 k1) v1))) From c63e4c3121a0ac33cfc12700520d9c91318a581f Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Sat, 4 Oct 2014 18:11:25 -0700 Subject: [PATCH 053/246] change values from domain to list --- csp/solver.rkt | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/csp/solver.rkt b/csp/solver.rkt index 984354ef..400a6894 100644 --- a/csp/solver.rkt +++ b/csp/solver.rkt @@ -49,7 +49,7 @@ ; Found unassigned variable (set! variable (last item)) ;(report variable unassigned-variable) - (set! values (send (hash-ref domains variable) copy)) + (set! values ((hash-ref domains variable))) (set! pushdomains (if forwardcheck (for/list ([x (in-hash-keys domains)] @@ -68,7 +68,7 @@ (return-k))) (define variable-values-pushdomains (py-pop! queue)) (set! variable (first variable-values-pushdomains)) - (set-field! _list values (second variable-values-pushdomains)) + (set! values (second variable-values-pushdomains)) (set! pushdomains (third variable-values-pushdomains)) (for ([domain (in-list pushdomains)]) (send domain pop-state))) @@ -82,7 +82,7 @@ ;; We have a variable. Do we have any values left? ;(report values values-tested) - (when (null? (get-field _list values)) + (when (null? values) ;; No. Go back to last variable, if there's one. (hash-remove! assignments variable) @@ -92,12 +92,12 @@ (let () (define variable-values-pushdomains (py-pop! queue)) (set! variable (first variable-values-pushdomains)) - (set-field! _list values (second variable-values-pushdomains)) + (set! values (second variable-values-pushdomains)) (set! pushdomains (third variable-values-pushdomains)) (when (not (null? pushdomains)) (for ([domain (in-list pushdomains)]) (send domain pop-state))) - (when (not (null? (get-field _list values))) (break-loop3)) + (when (not (null? values)) (break-loop3)) (hash-remove! assignments variable) (loop3)) (begin @@ -105,7 +105,7 @@ (return-k)))))) ;; Got a value. Check it. - (hash-set! assignments variable (send values domain-pop!)) + (hash-set! assignments variable (py-pop! values)) (for ([domain (in-list pushdomains)]) (send domain push-state)) @@ -131,7 +131,7 @@ (loop2))) ;; Push state before looking for next variable. - (py-append! queue (list variable (get-field _list (send values copy)) pushdomains)) + (py-append! queue (list variable values pushdomains)) ;(report queue new-queue) (loop1))) From f7c185a5084091e96fbfe5f65467a7dfaf691f8b Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Sat, 4 Oct 2014 18:20:37 -0700 Subject: [PATCH 054/246] tweak --- csp/solver.rkt | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/csp/solver.rkt b/csp/solver.rkt index 400a6894..38744fb6 100644 --- a/csp/solver.rkt +++ b/csp/solver.rkt @@ -39,7 +39,7 @@ ;; Mix the Degree and Minimum Remaing Values (MRV) heuristics (set! lst (sort (for/list ([variable (in-hash-keys domains)]) (list (* -1 (length (hash-ref vconstraints variable))) - (length (get-field _list (hash-ref domains variable))) + (length ((hash-ref domains variable))) variable)) list-comparator)) ;(report lst) (let/ec break-for-loop From a9edaea92612ddb6e260e4dca1c25ae5c2dda4d0 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Sat, 4 Oct 2014 18:40:55 -0700 Subject: [PATCH 055/246] print tweak --- csp/domain.rkt | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/csp/domain.rkt b/csp/domain.rkt index a04b7db8..dccc55d9 100644 --- a/csp/domain.rkt +++ b/csp/domain.rkt @@ -11,7 +11,7 @@ (init-field set) (field [_list set][_hidden null][_states null]) - (define (repr) (format "" _list)) + (define (repr) (format "" _list)) (define/public (custom-print out quoting-depth) (print (repr) out)) (define/public (custom-display out) (displayln (repr) out)) (define/public (custom-write out) (write (repr) out)) From 1d91bd3b1b7aad2fab57a6dd0df1c0d968bbb725 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Sat, 4 Oct 2014 18:41:04 -0700 Subject: [PATCH 056/246] tweaks --- csp/test-problems.rkt | 7 +++++-- csp/variable.rkt | 8 ++++---- 2 files changed, 9 insertions(+), 6 deletions(-) diff --git a/csp/test-problems.rkt b/csp/test-problems.rkt index 59f99b46..203e0cdb 100644 --- a/csp/test-problems.rkt +++ b/csp/test-problems.rkt @@ -1,5 +1,5 @@ #lang racket -(require "main.rkt") +(require "main.rkt" "test-classes.rkt") (require rackunit) @@ -142,4 +142,7 @@ A collection of 33 coins, consisting of nickels, dimes, and quarters, has a valu (not (= (abs (- row1 row2)) (abs (- col1 col2)))) ;; test if two cells are in same row (not (= row1 row2)))) (list col1 col2))) -(check-equal? (length (send queens-problem get-solutions)) 92) \ No newline at end of file +(check-equal? (length (send queens-problem get-solutions)) 92) + +(module+ main + (displayln "Tests passed")) \ No newline at end of file diff --git a/csp/variable.rkt b/csp/variable.rkt index 3c7213f1..727a469e 100644 --- a/csp/variable.rkt +++ b/csp/variable.rkt @@ -2,16 +2,16 @@ (require racket/class "helper.rkt") (provide (all-defined-out)) -(define Variable +(define variable% (class* object% (printable<%>) (super-new) - (define (repr) (format "" _name)) + (define (repr) (format "" _name)) (define/public (custom-print out quoting-depth) (print (repr) out)) (define/public (custom-display out) (displayln (repr) out)) (define/public (custom-write out) (write (repr) out)) (init-field name) (field [_name name]))) -(define Variable? (is-a?/c Variable)) +(define variable%? (is-a?/c variable%)) -(define Unassigned (new Variable [name "Unassigned"])) \ No newline at end of file +(define Unassigned (new variable% [name "Unassigned"])) \ No newline at end of file From 634c32a2cb78054cbac564020f3a9570ee96ad80 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Sat, 4 Oct 2014 18:41:26 -0700 Subject: [PATCH 057/246] tweaks --- csp/solver.rkt | 42 +++++++++++++++++++----------------------- 1 file changed, 19 insertions(+), 23 deletions(-) diff --git a/csp/solver.rkt b/csp/solver.rkt index 38744fb6..2637a64d 100644 --- a/csp/solver.rkt +++ b/csp/solver.rkt @@ -27,7 +27,7 @@ (define values null) (define pushdomains null) (define variable #f) - (define lst null) + (define work-list null) (define want-to-return #f) (define return-k #f) (let/ec break-loop1 @@ -37,30 +37,29 @@ ;; Mix the Degree and Minimum Remaing Values (MRV) heuristics - (set! lst (sort (for/list ([variable (in-hash-keys domains)]) + (set! work-list (sort (for/list ([variable (in-hash-keys domains)]) (list (* -1 (length (hash-ref vconstraints variable))) (length ((hash-ref domains variable))) variable)) list-comparator)) ;(report lst) (let/ec break-for-loop - (for ([item (in-list lst)]) - (when (not ((last item) . in? . assignments)) - - ; Found unassigned variable - (set! variable (last item)) - ;(report variable unassigned-variable) - (set! values ((hash-ref domains variable))) - (set! pushdomains - (if forwardcheck - (for/list ([x (in-hash-keys domains)] - #:when (and (not (x . in? . assignments)) - (not (x . equal? . variable)))) - (hash-ref domains x)) - null)) - (break-for-loop))) + (for ([last-item (in-list (map last work-list))] + #:when (not (hash-has-key? assignments last-item))) + ; Found unassigned variable + (set! variable last-item) + ;(report variable unassigned-variable) + (set! values ((hash-ref domains variable))) + (set! pushdomains + (if forwardcheck + (for/list ([x (in-hash-keys domains)] + #:when (and (not (hash-has-key? assignments x)) + (not (equal? variable x)))) + (hash-ref domains x)) + null)) + (break-for-loop)) ;; if it makes it through the loop without breaking, then there are - ;; No unassigned variables. We've got a solution. Go back + ;; no unassigned variables. We've got a solution. Go back ;; to last variable, if there's one. (yield (hash-copy assignments)) (when (null? queue) (begin @@ -70,8 +69,7 @@ (set! variable (first variable-values-pushdomains)) (set! values (second variable-values-pushdomains)) (set! pushdomains (third variable-values-pushdomains)) - (for ([domain (in-list pushdomains)]) - (send domain pop-state))) + (for-each (λ(pd) (send pd pop-state)) pushdomains)) ;(report variable variable-preloop-2) ;(report assignments assignments-preloop-2) @@ -94,9 +92,7 @@ (set! variable (first variable-values-pushdomains)) (set! values (second variable-values-pushdomains)) (set! pushdomains (third variable-values-pushdomains)) - (when (not (null? pushdomains)) - (for ([domain (in-list pushdomains)]) - (send domain pop-state))) + (for-each (λ(pd) (send pd pop-state)) pushdomains) (when (not (null? values)) (break-loop3)) (hash-remove! assignments variable) (loop3)) From 5cd56d8b9dfb3a7d3d870060b087d01c5ec70d3d Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Sat, 4 Oct 2014 18:48:05 -0700 Subject: [PATCH 058/246] add for-each-send --- csp/helper.rkt | 3 +++ csp/solver.rkt | 10 ++++------ 2 files changed, 7 insertions(+), 6 deletions(-) diff --git a/csp/helper.rkt b/csp/helper.rkt index 71bc942f..5504ecd1 100644 --- a/csp/helper.rkt +++ b/csp/helper.rkt @@ -3,6 +3,9 @@ (provide (all-defined-out)) (require rackunit) +(define-syntax-rule (for-each-send proc objects) + (for-each (λ(o) (send o proc)) objects)) + (define-syntax-rule (make-proc<%> proc-name) (interface* () ([prop:procedure diff --git a/csp/solver.rkt b/csp/solver.rkt index 2637a64d..4f634623 100644 --- a/csp/solver.rkt +++ b/csp/solver.rkt @@ -69,7 +69,7 @@ (set! variable (first variable-values-pushdomains)) (set! values (second variable-values-pushdomains)) (set! pushdomains (third variable-values-pushdomains)) - (for-each (λ(pd) (send pd pop-state)) pushdomains)) + (for-each-send pop-state pushdomains)) ;(report variable variable-preloop-2) ;(report assignments assignments-preloop-2) @@ -92,7 +92,7 @@ (set! variable (first variable-values-pushdomains)) (set! values (second variable-values-pushdomains)) (set! pushdomains (third variable-values-pushdomains)) - (for-each (λ(pd) (send pd pop-state)) pushdomains) + (for-each-send pop-state pushdomains) (when (not (null? values)) (break-loop3)) (hash-remove! assignments variable) (loop3)) @@ -103,8 +103,7 @@ ;; Got a value. Check it. (hash-set! assignments variable (py-pop! values)) - (for ([domain (in-list pushdomains)]) - (send domain push-state)) + (for-each-send push-state pushdomains) ;(report pushdomains pushdomains1) ;(report domains domains1) @@ -121,8 +120,7 @@ (begin ;(displayln "now breaking loop 2") (break-loop2))) - (for ([domain (in-list pushdomains)]) - (send domain pop-state)) + (for-each-send pop-state pushdomains) (loop2))) From bad6780d665d9494984f59b05e2342c1c1a140c7 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Sat, 4 Oct 2014 18:58:20 -0700 Subject: [PATCH 059/246] refactor --- csp/solver.rkt | 30 ++++++++++++++++++------------ 1 file changed, 18 insertions(+), 12 deletions(-) diff --git a/csp/solver.rkt b/csp/solver.rkt index 4f634623..024f459e 100644 --- a/csp/solver.rkt +++ b/csp/solver.rkt @@ -12,6 +12,12 @@ (define solver%? (is-a?/c solver%)) +(struct vvp (variable values pushdomains)) +(define-syntax-rule (pop-vvp! vvps) + (let ([vvp (car vvps)]) + (set! vvps (cdr vvps)) + vvp)) + (define backtracking-solver% ;; Problem solver with backtracking capabilities (class solver% @@ -38,9 +44,9 @@ ;; Mix the Degree and Minimum Remaing Values (MRV) heuristics (set! work-list (sort (for/list ([variable (in-hash-keys domains)]) - (list (* -1 (length (hash-ref vconstraints variable))) - (length ((hash-ref domains variable))) - variable)) list-comparator)) + (list (* -1 (length (hash-ref vconstraints variable))) + (length ((hash-ref domains variable))) + variable)) list-comparator)) ;(report lst) (let/ec break-for-loop (for ([last-item (in-list (map last work-list))] @@ -65,10 +71,10 @@ (when (null? queue) (begin (set! want-to-return #t) (return-k))) - (define variable-values-pushdomains (py-pop! queue)) - (set! variable (first variable-values-pushdomains)) - (set! values (second variable-values-pushdomains)) - (set! pushdomains (third variable-values-pushdomains)) + (define vvp (pop-vvp! queue)) + (set! variable (vvp-variable vvp)) + (set! values (vvp-values vvp)) + (set! pushdomains (vvp-pushdomains vvp)) (for-each-send pop-state pushdomains)) ;(report variable variable-preloop-2) @@ -88,10 +94,10 @@ (let loop3 () (if (not (null? queue)) (let () - (define variable-values-pushdomains (py-pop! queue)) - (set! variable (first variable-values-pushdomains)) - (set! values (second variable-values-pushdomains)) - (set! pushdomains (third variable-values-pushdomains)) + (define vvp (pop-vvp! queue)) + (set! variable (vvp-variable vvp)) + (set! values (vvp-values vvp)) + (set! pushdomains (vvp-pushdomains vvp)) (for-each-send pop-state pushdomains) (when (not (null? values)) (break-loop3)) (hash-remove! assignments variable) @@ -125,7 +131,7 @@ (loop2))) ;; Push state before looking for next variable. - (py-append! queue (list variable values pushdomains)) + (set! queue (cons (vvp variable values pushdomains) queue)) ;(report queue new-queue) (loop1))) From b6503c03e94e1beab25e028dd5a439e7b6c6e9f3 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Sat, 4 Oct 2014 19:16:01 -0700 Subject: [PATCH 060/246] refactory --- csp/solver.rkt | 42 +++++++----------------------------------- 1 file changed, 7 insertions(+), 35 deletions(-) diff --git a/csp/solver.rkt b/csp/solver.rkt index 024f459e..ed6668f0 100644 --- a/csp/solver.rkt +++ b/csp/solver.rkt @@ -13,10 +13,10 @@ (define solver%? (is-a?/c solver%)) (struct vvp (variable values pushdomains)) -(define-syntax-rule (pop-vvp! vvps) +(define-syntax-rule (pop-vvp-values! vvps) (let ([vvp (car vvps)]) (set! vvps (cdr vvps)) - vvp)) + (values (vvp-variable vvp) (vvp-values vvp) (vvp-pushdomains vvp)))) (define backtracking-solver% ;; Problem solver with backtracking capabilities @@ -39,9 +39,6 @@ (let/ec break-loop1 (set! return-k break-loop1) (let loop1 () - ;(displayln "starting while loop 1") - - ;; Mix the Degree and Minimum Remaing Values (MRV) heuristics (set! work-list (sort (for/list ([variable (in-hash-keys domains)]) (list (* -1 (length (hash-ref vconstraints variable))) @@ -53,7 +50,6 @@ #:when (not (hash-has-key? assignments last-item))) ; Found unassigned variable (set! variable last-item) - ;(report variable unassigned-variable) (set! values ((hash-ref domains variable))) (set! pushdomains (if forwardcheck @@ -71,33 +67,20 @@ (when (null? queue) (begin (set! want-to-return #t) (return-k))) - (define vvp (pop-vvp! queue)) - (set! variable (vvp-variable vvp)) - (set! values (vvp-values vvp)) - (set! pushdomains (vvp-pushdomains vvp)) + (set!-values (variable values pushdomains) (pop-vvp-values! queue)) (for-each-send pop-state pushdomains)) - ;(report variable variable-preloop-2) - ;(report assignments assignments-preloop-2) - (let/ec break-loop2 (let loop2 () - ;(displayln "starting while loop 2") - ;; We have a variable. Do we have any values left? - ;(report values values-tested) - (when (null? values) - + (when (null? values) ;; No. Go back to last variable, if there's one. (hash-remove! assignments variable) (let/ec break-loop3 (let loop3 () (if (not (null? queue)) (let () - (define vvp (pop-vvp! queue)) - (set! variable (vvp-variable vvp)) - (set! values (vvp-values vvp)) - (set! pushdomains (vvp-pushdomains vvp)) + (set!-values (variable values pushdomains) (pop-vvp-values! queue)) (for-each-send pop-state pushdomains) (when (not (null? values)) (break-loop3)) (hash-remove! assignments variable) @@ -108,31 +91,20 @@ ;; Got a value. Check it. (hash-set! assignments variable (py-pop! values)) - (for-each-send push-state pushdomains) - ;(report pushdomains pushdomains1) - ;(report domains domains1) - (let/ec break-for-loop (for ([cvpair (in-list (hash-ref vconstraints variable))]) (match-define (list constraint variables) cvpair) (define the_result (send constraint call variables domains assignments pushdomains)) - ;(report pushdomains pushdomains2) - ;(report domains domains2) - ;(report the_result) - (when (not the_result) - ;; Value is not good. + (when (not the_result) ; Value is not good. (break-for-loop))) - (begin ;(displayln "now breaking loop 2") - (break-loop2))) + (break-loop2)) (for-each-send pop-state pushdomains) - (loop2))) ;; Push state before looking for next variable. (set! queue (cons (vvp variable values pushdomains) queue)) - ;(report queue new-queue) (loop1))) (if want-to-return From ca718a9a0fa31087a5e07c28a92f23e8ca193fd2 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Sat, 4 Oct 2014 19:50:18 -0700 Subject: [PATCH 061/246] delicacy --- csp/helper.rkt | 5 +++++ csp/solver.rkt | 60 ++++++++++++++++++++++++++++++++------------------ 2 files changed, 43 insertions(+), 22 deletions(-) diff --git a/csp/helper.rkt b/csp/helper.rkt index 5504ecd1..817d7c7b 100644 --- a/csp/helper.rkt +++ b/csp/helper.rkt @@ -39,6 +39,11 @@ (check-true (list-comparator '(1 1 "a") '(1 1 "b"))) (check-true (list-comparator '(1 1 a) '(1 1 b)))) +(define-syntax-rule (car-pop! xs) + (let ([i (car xs)]) + (set! xs (cdr xs)) + i)) + (define-syntax-rule (py-pop! xs) (let ([i (last xs)]) (set! xs (drop-right xs 1)) diff --git a/csp/solver.rkt b/csp/solver.rkt index ed6668f0..60ad02e2 100644 --- a/csp/solver.rkt +++ b/csp/solver.rkt @@ -14,9 +14,11 @@ (struct vvp (variable values pushdomains)) (define-syntax-rule (pop-vvp-values! vvps) - (let ([vvp (car vvps)]) - (set! vvps (cdr vvps)) - (values (vvp-variable vvp) (vvp-values vvp) (vvp-pushdomains vvp)))) + (if (null? vvps) + (error 'pop-vvp-values! (format "~a is null" vvps)) + (let ([vvp (car vvps)]) + (set! vvps (cdr vvps)) + (values (vvp-variable vvp) (vvp-values vvp) (vvp-pushdomains vvp))))) (define backtracking-solver% ;; Problem solver with backtracking capabilities @@ -61,14 +63,16 @@ (break-for-loop)) ;; if it makes it through the loop without breaking, then there are - ;; no unassigned variables. We've got a solution. Go back - ;; to last variable, if there's one. + ;; no unassigned variables. We've got a solution. (yield (hash-copy assignments)) - (when (null? queue) (begin - (set! want-to-return #t) - (return-k))) - (set!-values (variable values pushdomains) (pop-vvp-values! queue)) - (for-each-send pop-state pushdomains)) + + ;; Return to previous variable in queue if possible, otherwise all done + (cond + [(not (null? queue)) + (set!-values (variable values pushdomains) (pop-vvp-values! queue)) + (for-each-send pop-state pushdomains)] + [else + (set! want-to-return #t) (return-k)])) (let/ec break-loop2 (let loop2 () @@ -76,21 +80,33 @@ (when (null? values) ;; No. Go back to last variable, if there's one. (hash-remove! assignments variable) + + (if #f + (for/or ([i (in-naturals)]) + (when (null? queue) (set! want-to-return #t) (return-k)) + (set!-values (variable values pushdomains) (pop-vvp-values! queue)) + (for-each-send pop-state pushdomains) + (if (not (null? values)) + #t + (hash-remove! assignments variable))) + (let/ec break-loop3 - (let loop3 () - (if (not (null? queue)) - (let () - (set!-values (variable values pushdomains) (pop-vvp-values! queue)) - (for-each-send pop-state pushdomains) - (when (not (null? values)) (break-loop3)) - (hash-remove! assignments variable) - (loop3)) - (begin - (set! want-to-return #t) - (return-k)))))) + (let loop () + (when (null? queue) + (set! want-to-return #t) + (return-k)) + (set!-values (variable values pushdomains) (pop-vvp-values! queue)) + (for-each-send pop-state pushdomains) + (when (not (null? values)) (break-loop3)) + (hash-remove! assignments variable) + (loop))) + ) + ) + + ;; Got a value. Check it. - (hash-set! assignments variable (py-pop! values)) + (hash-set! assignments variable (car-pop! values)) (for-each-send push-state pushdomains) (let/ec break-for-loop (for ([cvpair (in-list (hash-ref vconstraints variable))]) From d5fe7ec60c27f82c0221215150762e7bc8dcc135 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Sun, 5 Oct 2014 07:59:24 -0700 Subject: [PATCH 062/246] bits --- csp/solver.rkt | 36 ++++++++---------------------------- 1 file changed, 8 insertions(+), 28 deletions(-) diff --git a/csp/solver.rkt b/csp/solver.rkt index 60ad02e2..52f09337 100644 --- a/csp/solver.rkt +++ b/csp/solver.rkt @@ -78,43 +78,23 @@ (let loop2 () ;; We have a variable. Do we have any values left? (when (null? values) - ;; No. Go back to last variable, if there's one. - (hash-remove! assignments variable) - - (if #f + ;; No. Go back to last variable, if there's one, else exit. (for/or ([i (in-naturals)]) + (hash-remove! assignments variable) (when (null? queue) (set! want-to-return #t) (return-k)) (set!-values (variable values pushdomains) (pop-vvp-values! queue)) (for-each-send pop-state pushdomains) - (if (not (null? values)) - #t - (hash-remove! assignments variable))) - - (let/ec break-loop3 - (let loop () - (when (null? queue) - (set! want-to-return #t) - (return-k)) - (set!-values (variable values pushdomains) (pop-vvp-values! queue)) - (for-each-send pop-state pushdomains) - (when (not (null? values)) (break-loop3)) - (hash-remove! assignments variable) - (loop))) - ) - ) - - + (not (null? values)))) ;; Got a value. Check it. (hash-set! assignments variable (car-pop! values)) (for-each-send push-state pushdomains) (let/ec break-for-loop - (for ([cvpair (in-list (hash-ref vconstraints variable))]) - (match-define (list constraint variables) cvpair) - (define the_result (send constraint call variables domains assignments pushdomains)) - (when (not the_result) ; Value is not good. - (break-for-loop))) - (break-loop2)) + (if (for/or ([cvpair (in-list (hash-ref vconstraints variable))]) + (match-define (list constraint variables) cvpair) + (not (send constraint call variables domains assignments pushdomains))) + (break-for-loop) + (break-loop2))) (for-each-send pop-state pushdomains) (loop2))) From 32079c022078e329735faf424dfcc1322edac603 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Sun, 5 Oct 2014 08:37:29 -0700 Subject: [PATCH 063/246] nits --- csp/constraint.rkt | 12 ++++++------ csp/solver.rkt | 44 ++++++++++++++++++++------------------------ 2 files changed, 26 insertions(+), 30 deletions(-) diff --git a/csp/constraint.rkt b/csp/constraint.rkt index 1ed991de..79ec866b 100644 --- a/csp/constraint.rkt +++ b/csp/constraint.rkt @@ -6,7 +6,7 @@ (class object% (super-new) - (define/public (call variables domains assignments [forward-check? #f]) + (define/public (is-true? variables domains assignments [forward-check? #f]) ;; Perform the constraint checking ;; If the forwardcheck parameter is not false, besides telling if @@ -31,7 +31,7 @@ (set-field! _list domain (for/fold ([domain-values (domain)]) ([value (in-list (domain))] - #:when (not (call variables domains (make-hash (list (cons variable value)))))) + #:when (not (is-true? variables domains (make-hash (list (cons variable value)))))) (remove value domain-values))) (set! constraints (remove (list this variables) constraints)) (hash-update! vconstraints variable (λ(val) (remove (list this variables) val))))) @@ -50,7 +50,7 @@ (define unassigned-variable-domain (hash-ref domains unassigned-variable)) (for ([value (in-list (unassigned-variable-domain))]) (hash-set! assignments unassigned-variable value) - (when (not (call variables domains assignments)) + (when (not (is-true? variables domains assignments)) (send unassigned-variable-domain hide-value value))) (hash-remove! assignments unassigned-variable) (not (null? unassigned-variable-domain))] ; if domain had no remaining values, the constraint will be impossible to meet, so return #f @@ -69,7 +69,7 @@ (inherit forward-check) - (define/override (call variables domains assignments [forward-check? #f] [_unassigned Unassigned]) + (define/override (is-true? variables domains assignments [forward-check? #f] [_unassigned Unassigned]) (define parms (map (λ(v) (hash-ref assignments v _unassigned)) variables)) (define missing (length (filter (λ(p) (equal? p _unassigned)) parms))) (if (> missing 0) @@ -85,7 +85,7 @@ (class constraint% (super-new) - (define/override (call variables domains assignments [forward-check? #f] [_unassigned Unassigned]) + (define/override (is-true? variables domains assignments [forward-check? #f] [_unassigned Unassigned]) (define-values (assigned-vars unassigned-vars) (partition (λ(var) (hash-has-key? assignments var)) variables)) (define assigned-values (map (λ(var) (hash-ref assignments var)) assigned-vars)) @@ -106,7 +106,7 @@ (class constraint% (super-new) - (define/override (call variables domains assignments [forward-check? #f] [_unassigned Unassigned]) + (define/override (is-true? variables domains assignments [forward-check? #f] [_unassigned Unassigned]) (define singlevalue _unassigned) (define value #f) (define domain #f) diff --git a/csp/solver.rkt b/csp/solver.rkt index 52f09337..75dddd16 100644 --- a/csp/solver.rkt +++ b/csp/solver.rkt @@ -74,30 +74,26 @@ [else (set! want-to-return #t) (return-k)])) - (let/ec break-loop2 - (let loop2 () - ;; We have a variable. Do we have any values left? - (when (null? values) - ;; No. Go back to last variable, if there's one, else exit. - (for/or ([i (in-naturals)]) - (hash-remove! assignments variable) - (when (null? queue) (set! want-to-return #t) (return-k)) - (set!-values (variable values pushdomains) (pop-vvp-values! queue)) - (for-each-send pop-state pushdomains) - (not (null? values)))) - - ;; Got a value. Check it. - (hash-set! assignments variable (car-pop! values)) - (for-each-send push-state pushdomains) - (let/ec break-for-loop - (if (for/or ([cvpair (in-list (hash-ref vconstraints variable))]) - (match-define (list constraint variables) cvpair) - (not (send constraint call variables domains assignments pushdomains))) - (break-for-loop) - (break-loop2))) - - (for-each-send pop-state pushdomains) - (loop2))) + (let constraint-checking-loop () + ;; We have a variable. Do we have any values left? + (when (null? values) + ;; No. Go back to last variable, if there is one, otherwise solver is done. + (for/or ([i (in-naturals)]) + (hash-remove! assignments variable) + (when (null? queue) (set! want-to-return #t) (return-k)) + (set!-values (variable values pushdomains) (pop-vvp-values! queue)) + (for-each-send pop-state pushdomains) + (not (null? values)))) + + ;; Got a value. Check it. + (hash-set! assignments variable (car-pop! values)) + (for-each-send push-state pushdomains) + (when (for/or ([cvpair (in-list (hash-ref vconstraints variable))]) + (match-define (list constraint variables) cvpair) + (not (send constraint is-true? variables domains assignments pushdomains))) + ;; constraint failed, so try again + (for-each-send pop-state pushdomains) + (constraint-checking-loop))) ;; Push state before looking for next variable. (set! queue (cons (vvp variable values pushdomains) queue)) From d0516947bf783e28697be1b0fc3df3b4e6d1a73c Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Sun, 5 Oct 2014 08:54:56 -0700 Subject: [PATCH 064/246] blits --- csp/solver.rkt | 22 ++++++++++------------ 1 file changed, 10 insertions(+), 12 deletions(-) diff --git a/csp/solver.rkt b/csp/solver.rkt index 75dddd16..6173d4fd 100644 --- a/csp/solver.rkt +++ b/csp/solver.rkt @@ -1,5 +1,5 @@ #lang racket/base -(require racket/class sugar/container racket/list racket/generator racket/match "helper.rkt") +(require racket/class sugar/container sugar/debug racket/list racket/generator racket/match "helper.rkt") (provide (all-defined-out)) (define solver% @@ -46,11 +46,10 @@ (list (* -1 (length (hash-ref vconstraints variable))) (length ((hash-ref domains variable))) variable)) list-comparator)) - ;(report lst) - (let/ec break-for-loop - (for ([last-item (in-list (map last work-list))] - #:when (not (hash-has-key? assignments last-item))) - ; Found unassigned variable + + (define found-unassigned-variable? + (for/first ([last-item (in-list (map last work-list))] + #:when (not (hash-has-key? assignments last-item))) (set! variable last-item) (set! values ((hash-ref domains variable))) (set! pushdomains @@ -60,14 +59,13 @@ (not (equal? variable x)))) (hash-ref domains x)) null)) - (break-for-loop)) - - ;; if it makes it through the loop without breaking, then there are - ;; no unassigned variables. We've got a solution. + variable)) + + ;; if there are no unassigned variables, we've got a solution. + (when (not found-unassigned-variable?) (yield (hash-copy assignments)) - - ;; Return to previous variable in queue if possible, otherwise all done (cond + ;; Return to previous variable in queue if possible, otherwise all done [(not (null? queue)) (set!-values (variable values pushdomains) (pop-vvp-values! queue)) (for-each-send pop-state pushdomains)] From b53201480b92729e00b42daaf03dd60682e0f1ef Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Sun, 5 Oct 2014 09:07:05 -0700 Subject: [PATCH 065/246] remove extraneous --- csp/solver.rkt | 30 ++++++++++++------------------ 1 file changed, 12 insertions(+), 18 deletions(-) diff --git a/csp/solver.rkt b/csp/solver.rkt index 6173d4fd..54dc3bd3 100644 --- a/csp/solver.rkt +++ b/csp/solver.rkt @@ -28,19 +28,14 @@ (field [_forwardcheck forwardcheck]) (define/override (get-solution-iter domains constraints vconstraints) - - (define forwardcheck _forwardcheck) (define assignments (make-hash)) (define queue null) + (define variable #f) (define values null) (define pushdomains null) - (define variable #f) - (define work-list null) - (define want-to-return #f) - (define return-k #f) - (let/ec break-loop1 - (set! return-k break-loop1) - (let loop1 () + (define work-list #f) + (let/ec return-k + (let main-loop () ;; Mix the Degree and Minimum Remaing Values (MRV) heuristics (set! work-list (sort (for/list ([variable (in-hash-keys domains)]) (list (* -1 (length (hash-ref vconstraints variable))) @@ -53,7 +48,7 @@ (set! variable last-item) (set! values ((hash-ref domains variable))) (set! pushdomains - (if forwardcheck + (if _forwardcheck (for/list ([x (in-hash-keys domains)] #:when (and (not (hash-has-key? assignments x)) (not (equal? variable x)))) @@ -69,8 +64,7 @@ [(not (null? queue)) (set!-values (variable values pushdomains) (pop-vvp-values! queue)) (for-each-send pop-state pushdomains)] - [else - (set! want-to-return #t) (return-k)])) + [else (return-k)])) (let constraint-checking-loop () ;; We have a variable. Do we have any values left? @@ -78,7 +72,7 @@ ;; No. Go back to last variable, if there is one, otherwise solver is done. (for/or ([i (in-naturals)]) (hash-remove! assignments variable) - (when (null? queue) (set! want-to-return #t) (return-k)) + (when (null? queue) (return-k)) (set!-values (variable values pushdomains) (pop-vvp-values! queue)) (for-each-send pop-state pushdomains) (not (null? values)))) @@ -88,18 +82,18 @@ (for-each-send push-state pushdomains) (when (for/or ([cvpair (in-list (hash-ref vconstraints variable))]) (match-define (list constraint variables) cvpair) - (not (send constraint is-true? variables domains assignments pushdomains))) + (not (send constraint broken? variables domains assignments pushdomains))) ;; constraint failed, so try again (for-each-send pop-state pushdomains) (constraint-checking-loop))) ;; Push state before looking for next variable. (set! queue (cons (vvp variable values pushdomains) queue)) - (loop1))) + (main-loop)) + + (error 'get-solution-iter "Should never get here")) - (if want-to-return - (void) - (error 'get-solution-iter "Whoops, broken solver"))) + (void)) (define (call-solution-generator domains constraints vconstraints #:first-only [first-only #f]) From ec1c4628ec4bb49e4760467f478a654d161d0b2d Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Sun, 5 Oct 2014 09:07:14 -0700 Subject: [PATCH 066/246] change to `broken?` --- csp/constraint.rkt | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/csp/constraint.rkt b/csp/constraint.rkt index 79ec866b..c67abe55 100644 --- a/csp/constraint.rkt +++ b/csp/constraint.rkt @@ -6,7 +6,7 @@ (class object% (super-new) - (define/public (is-true? variables domains assignments [forward-check? #f]) + (define/public (broken? variables domains assignments [forward-check? #f]) ;; Perform the constraint checking ;; If the forwardcheck parameter is not false, besides telling if @@ -31,7 +31,7 @@ (set-field! _list domain (for/fold ([domain-values (domain)]) ([value (in-list (domain))] - #:when (not (is-true? variables domains (make-hash (list (cons variable value)))))) + #:when (not (broken? variables domains (make-hash (list (cons variable value)))))) (remove value domain-values))) (set! constraints (remove (list this variables) constraints)) (hash-update! vconstraints variable (λ(val) (remove (list this variables) val))))) @@ -50,7 +50,7 @@ (define unassigned-variable-domain (hash-ref domains unassigned-variable)) (for ([value (in-list (unassigned-variable-domain))]) (hash-set! assignments unassigned-variable value) - (when (not (is-true? variables domains assignments)) + (when (not (broken? variables domains assignments)) (send unassigned-variable-domain hide-value value))) (hash-remove! assignments unassigned-variable) (not (null? unassigned-variable-domain))] ; if domain had no remaining values, the constraint will be impossible to meet, so return #f @@ -69,7 +69,7 @@ (inherit forward-check) - (define/override (is-true? variables domains assignments [forward-check? #f] [_unassigned Unassigned]) + (define/override (broken? variables domains assignments [forward-check? #f] [_unassigned Unassigned]) (define parms (map (λ(v) (hash-ref assignments v _unassigned)) variables)) (define missing (length (filter (λ(p) (equal? p _unassigned)) parms))) (if (> missing 0) @@ -85,7 +85,7 @@ (class constraint% (super-new) - (define/override (is-true? variables domains assignments [forward-check? #f] [_unassigned Unassigned]) + (define/override (broken? variables domains assignments [forward-check? #f] [_unassigned Unassigned]) (define-values (assigned-vars unassigned-vars) (partition (λ(var) (hash-has-key? assignments var)) variables)) (define assigned-values (map (λ(var) (hash-ref assignments var)) assigned-vars)) @@ -106,7 +106,7 @@ (class constraint% (super-new) - (define/override (is-true? variables domains assignments [forward-check? #f] [_unassigned Unassigned]) + (define/override (broken? variables domains assignments [forward-check? #f] [_unassigned Unassigned]) (define singlevalue _unassigned) (define value #f) (define domain #f) From 05efbcae7f5131f5cfb89f77cd9cabaabe87ff4d Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Sun, 5 Oct 2014 09:25:00 -0700 Subject: [PATCH 067/246] simpler --- csp/solver.rkt | 34 +++++++++++++++------------------- 1 file changed, 15 insertions(+), 19 deletions(-) diff --git a/csp/solver.rkt b/csp/solver.rkt index 54dc3bd3..8cd016d2 100644 --- a/csp/solver.rkt +++ b/csp/solver.rkt @@ -28,20 +28,20 @@ (field [_forwardcheck forwardcheck]) (define/override (get-solution-iter domains constraints vconstraints) + (define work-list (sort (for/list ([variable (in-hash-keys domains)]) + (list (* -1 (length (hash-ref vconstraints variable))) + (length ((hash-ref domains variable))) + variable)) list-comparator)) + ;; state-retention variables (define assignments (make-hash)) (define queue null) (define variable #f) (define values null) (define pushdomains null) - (define work-list #f) - (let/ec return-k + + (let/ec exit-k (let main-loop () - ;; Mix the Degree and Minimum Remaing Values (MRV) heuristics - (set! work-list (sort (for/list ([variable (in-hash-keys domains)]) - (list (* -1 (length (hash-ref vconstraints variable))) - (length ((hash-ref domains variable))) - variable)) list-comparator)) - + ;; mix the degree and minimum-remaining-values (MRV) heuristics (define found-unassigned-variable? (for/first ([last-item (in-list (map last work-list))] #:when (not (hash-has-key? assignments last-item))) @@ -64,18 +64,16 @@ [(not (null? queue)) (set!-values (variable values pushdomains) (pop-vvp-values! queue)) (for-each-send pop-state pushdomains)] - [else (return-k)])) + [else (exit-k)])) - (let constraint-checking-loop () - ;; We have a variable. Do we have any values left? - (when (null? values) - ;; No. Go back to last variable, if there is one, otherwise solver is done. + (let value-checking-loop () ; we have a variable. Do we have any values left? + (when (null? values) ; no, so try going back to last variable and getting some values (for/or ([i (in-naturals)]) + (when (null? queue) (exit-k)) ; no variables left, so solver is done (hash-remove! assignments variable) - (when (null? queue) (return-k)) (set!-values (variable values pushdomains) (pop-vvp-values! queue)) (for-each-send pop-state pushdomains) - (not (null? values)))) + (not (null? values)))) ;; Got a value. Check it. (hash-set! assignments variable (car-pop! values)) @@ -85,14 +83,12 @@ (not (send constraint broken? variables domains assignments pushdomains))) ;; constraint failed, so try again (for-each-send pop-state pushdomains) - (constraint-checking-loop))) + (value-checking-loop))) ;; Push state before looking for next variable. (set! queue (cons (vvp variable values pushdomains) queue)) (main-loop)) - - (error 'get-solution-iter "Should never get here")) - + (error 'get-solution-iter "Should never get here")) (void)) From 9ab000f7d2bfa246322c0dd656ff119b57eefcba Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Sun, 5 Oct 2014 11:52:25 -0700 Subject: [PATCH 068/246] cleanup --- csp/solver.rkt | 70 +++++++++++++++++++++++++------------------------- 1 file changed, 35 insertions(+), 35 deletions(-) diff --git a/csp/solver.rkt b/csp/solver.rkt index 8cd016d2..9f4f7779 100644 --- a/csp/solver.rkt +++ b/csp/solver.rkt @@ -1,5 +1,6 @@ #lang racket/base -(require racket/class sugar/container sugar/debug racket/list racket/generator racket/match "helper.rkt") +(require racket/class sugar/container sugar/debug racket/list + racket/bool racket/generator racket/match "helper.rkt") (provide (all-defined-out)) (define solver% @@ -33,62 +34,61 @@ (length ((hash-ref domains variable))) variable)) list-comparator)) ;; state-retention variables - (define assignments (make-hash)) - (define queue null) + (define possible-solution (make-hash)) + (define variable-queue null) (define variable #f) (define values null) (define pushdomains null) + (define (get-next-unassigned-variable) + (for/first ([last-item (in-list (map last work-list))] + #:when (not (hash-has-key? possible-solution last-item))) + (set! variable last-item) + (set! values ((hash-ref domains variable))) + (set! pushdomains + (if _forwardcheck + (for/list ([(var domain) (in-hash domains)] + #:when (nor (hash-has-key? possible-solution var) + (equal? variable var))) + domain) + null)) + variable)) + + (define (return-to-previous-variable) + (set!-values (variable values pushdomains) (pop-vvp-values! variable-queue)) + (for-each-send pop-state pushdomains)) + (let/ec exit-k + ;; mix the degree and minimum-remaining-values (MRV) heuristics (let main-loop () - ;; mix the degree and minimum-remaining-values (MRV) heuristics - (define found-unassigned-variable? - (for/first ([last-item (in-list (map last work-list))] - #:when (not (hash-has-key? assignments last-item))) - (set! variable last-item) - (set! values ((hash-ref domains variable))) - (set! pushdomains - (if _forwardcheck - (for/list ([x (in-hash-keys domains)] - #:when (and (not (hash-has-key? assignments x)) - (not (equal? variable x)))) - (hash-ref domains x)) - null)) - variable)) - - ;; if there are no unassigned variables, we've got a solution. - (when (not found-unassigned-variable?) - (yield (hash-copy assignments)) - (cond - ;; Return to previous variable in queue if possible, otherwise all done - [(not (null? queue)) - (set!-values (variable values pushdomains) (pop-vvp-values! queue)) - (for-each-send pop-state pushdomains)] - [else (exit-k)])) + (when (not (get-next-unassigned-variable)) + (yield (hash-copy possible-solution)) ; if there are no unassigned variables, solution is done. + (if (null? variable-queue) ; if queue isn't empty, return to previous variable, otherwise all done. + (exit-k) + (return-to-previous-variable))) (let value-checking-loop () ; we have a variable. Do we have any values left? (when (null? values) ; no, so try going back to last variable and getting some values (for/or ([i (in-naturals)]) - (when (null? queue) (exit-k)) ; no variables left, so solver is done - (hash-remove! assignments variable) - (set!-values (variable values pushdomains) (pop-vvp-values! queue)) - (for-each-send pop-state pushdomains) + (when (null? variable-queue) (exit-k)) ; no variables left, so solver is done + (hash-remove! possible-solution variable) + (return-to-previous-variable) (not (null? values)))) ;; Got a value. Check it. - (hash-set! assignments variable (car-pop! values)) + (hash-set! possible-solution variable (car-pop! values)) (for-each-send push-state pushdomains) (when (for/or ([cvpair (in-list (hash-ref vconstraints variable))]) (match-define (list constraint variables) cvpair) - (not (send constraint broken? variables domains assignments pushdomains))) + (not (send constraint broken? variables domains possible-solution pushdomains))) ;; constraint failed, so try again (for-each-send pop-state pushdomains) (value-checking-loop))) ;; Push state before looking for next variable. - (set! queue (cons (vvp variable values pushdomains) queue)) + (set! variable-queue (cons (vvp variable values pushdomains) variable-queue)) (main-loop)) - (error 'get-solution-iter "Should never get here")) + (error 'get-solution-iter "impossible to reach this")) (void)) From 02aae96912e771794ea5f606e79f646b22728d06 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Sun, 5 Oct 2014 11:53:18 -0700 Subject: [PATCH 069/246] nits --- csp/solver.rkt | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/csp/solver.rkt b/csp/solver.rkt index 9f4f7779..3bd26804 100644 --- a/csp/solver.rkt +++ b/csp/solver.rkt @@ -54,7 +54,7 @@ null)) variable)) - (define (return-to-previous-variable) + (define (set!-previous-variable) (set!-values (variable values pushdomains) (pop-vvp-values! variable-queue)) (for-each-send pop-state pushdomains)) @@ -65,14 +65,14 @@ (yield (hash-copy possible-solution)) ; if there are no unassigned variables, solution is done. (if (null? variable-queue) ; if queue isn't empty, return to previous variable, otherwise all done. (exit-k) - (return-to-previous-variable))) + (set!-previous-variable))) (let value-checking-loop () ; we have a variable. Do we have any values left? (when (null? values) ; no, so try going back to last variable and getting some values (for/or ([i (in-naturals)]) (when (null? variable-queue) (exit-k)) ; no variables left, so solver is done (hash-remove! possible-solution variable) - (return-to-previous-variable) + (set!-previous-variable) (not (null? values)))) ;; Got a value. Check it. From 05a763b9b577a39c418d0f258538222eabc6b284 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Sun, 5 Oct 2014 17:26:21 -0700 Subject: [PATCH 070/246] when to unless, etc --- csp/constraint.rkt | 2 +- csp/solver.rkt | 17 +++++++++-------- 2 files changed, 10 insertions(+), 9 deletions(-) diff --git a/csp/constraint.rkt b/csp/constraint.rkt index c67abe55..235d2532 100644 --- a/csp/constraint.rkt +++ b/csp/constraint.rkt @@ -31,7 +31,7 @@ (set-field! _list domain (for/fold ([domain-values (domain)]) ([value (in-list (domain))] - #:when (not (broken? variables domains (make-hash (list (cons variable value)))))) + #:unless (broken? variables domains (make-hash (list (cons variable value))))) (remove value domain-values))) (set! constraints (remove (list this variables) constraints)) (hash-update! vconstraints variable (λ(val) (remove (list this variables) val))))) diff --git a/csp/solver.rkt b/csp/solver.rkt index 3bd26804..ac97e3e7 100644 --- a/csp/solver.rkt +++ b/csp/solver.rkt @@ -29,10 +29,11 @@ (field [_forwardcheck forwardcheck]) (define/override (get-solution-iter domains constraints vconstraints) - (define work-list (sort (for/list ([variable (in-hash-keys domains)]) - (list (* -1 (length (hash-ref vconstraints variable))) - (length ((hash-ref domains variable))) - variable)) list-comparator)) + (define sorted-variables + (map last (sort (for/list ([(variable domain) (in-hash domains)]) + (list (- (length (hash-ref vconstraints variable))) ; first two elements used for sorting + (length (domain)) + variable)) list-comparator))) ;; state-retention variables (define possible-solution (make-hash)) (define variable-queue null) @@ -41,14 +42,14 @@ (define pushdomains null) (define (get-next-unassigned-variable) - (for/first ([last-item (in-list (map last work-list))] - #:when (not (hash-has-key? possible-solution last-item))) - (set! variable last-item) + (for/first ([sorted-variable (in-list sorted-variables)] + #:unless (hash-has-key? possible-solution sorted-variable)) + (set! variable sorted-variable) (set! values ((hash-ref domains variable))) (set! pushdomains (if _forwardcheck (for/list ([(var domain) (in-hash domains)] - #:when (nor (hash-has-key? possible-solution var) + #:unless (and (hash-has-key? possible-solution var) (equal? variable var))) domain) null)) From d00a51b2219e80e958d19af527c0e2334fb735ce Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Sun, 5 Oct 2014 17:28:42 -0700 Subject: [PATCH 071/246] when to unless --- csp/constraint.rkt | 6 +++--- csp/solver.rkt | 6 +++--- 2 files changed, 6 insertions(+), 6 deletions(-) diff --git a/csp/constraint.rkt b/csp/constraint.rkt index 235d2532..79faf7d7 100644 --- a/csp/constraint.rkt +++ b/csp/constraint.rkt @@ -123,13 +123,13 @@ (return-k)])) (when (and forward-check? (not (equal? singlevalue _unassigned))) (for ([variable (in-list variables)]) - (when (not (variable . in? . assignments)) + (unless (variable . in? . assignments) (set! domain (hash-ref domains variable)) - (when (not (singlevalue . in? . (domain))) + (unless (singlevalue . in? . (domain)) (set! return-value #f) (return-k)) (for ([value (in-list (domain))]) - (when (not (equal? value singlevalue)) + (unless (equal? value singlevalue) (send domain hide-value value)))))) (set! return-value #t) (return-k)) diff --git a/csp/solver.rkt b/csp/solver.rkt index ac97e3e7..71ab5c4a 100644 --- a/csp/solver.rkt +++ b/csp/solver.rkt @@ -49,8 +49,8 @@ (set! pushdomains (if _forwardcheck (for/list ([(var domain) (in-hash domains)] - #:unless (and (hash-has-key? possible-solution var) - (equal? variable var))) + #:unless (and (equal? variable var) + (hash-has-key? possible-solution var))) domain) null)) variable)) @@ -62,7 +62,7 @@ (let/ec exit-k ;; mix the degree and minimum-remaining-values (MRV) heuristics (let main-loop () - (when (not (get-next-unassigned-variable)) + (unless (get-next-unassigned-variable) (yield (hash-copy possible-solution)) ; if there are no unassigned variables, solution is done. (if (null? variable-queue) ; if queue isn't empty, return to previous variable, otherwise all done. (exit-k) From 9cd9b84c7cff80d0461b48aa27c60eb1bba39381 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Sun, 5 Oct 2014 18:10:36 -0700 Subject: [PATCH 072/246] cleanup --- csp/constraint.rkt | 16 ++--- csp/helper.rkt | 8 +++ .../trials/{abc.py => abcd.py} | 0 csp/solver.rkt | 64 +++++++++---------- 4 files changed, 48 insertions(+), 40 deletions(-) rename csp/python-constraint/trials/{abc.py => abcd.py} (100%) diff --git a/csp/constraint.rkt b/csp/constraint.rkt index 79faf7d7..c0d54a09 100644 --- a/csp/constraint.rkt +++ b/csp/constraint.rkt @@ -1,12 +1,12 @@ #lang racket/base -(require racket/class sugar/container sugar/list sugar/debug racket/list "helper.rkt" "variable.rkt") +(require racket/class racket/bool sugar/container sugar/list sugar/debug racket/list "helper.rkt" "variable.rkt") (provide (all-defined-out)) (define constraint% (class object% (super-new) - (define/public (broken? variables domains assignments [forward-check? #f]) + (define/public (is-true? variables domains assignments [forward-check? #f]) ;; Perform the constraint checking ;; If the forwardcheck parameter is not false, besides telling if @@ -31,7 +31,7 @@ (set-field! _list domain (for/fold ([domain-values (domain)]) ([value (in-list (domain))] - #:unless (broken? variables domains (make-hash (list (cons variable value))))) + #:unless (is-true? variables domains (make-hash (list (cons variable value))))) (remove value domain-values))) (set! constraints (remove (list this variables) constraints)) (hash-update! vconstraints variable (λ(val) (remove (list this variables) val))))) @@ -50,7 +50,7 @@ (define unassigned-variable-domain (hash-ref domains unassigned-variable)) (for ([value (in-list (unassigned-variable-domain))]) (hash-set! assignments unassigned-variable value) - (when (not (broken? variables domains assignments)) + (unless (is-true? variables domains assignments) (send unassigned-variable-domain hide-value value))) (hash-remove! assignments unassigned-variable) (not (null? unassigned-variable-domain))] ; if domain had no remaining values, the constraint will be impossible to meet, so return #f @@ -69,7 +69,7 @@ (inherit forward-check) - (define/override (broken? variables domains assignments [forward-check? #f] [_unassigned Unassigned]) + (define/override (is-true? variables domains assignments [forward-check? #f] [_unassigned Unassigned]) (define parms (map (λ(v) (hash-ref assignments v _unassigned)) variables)) (define missing (length (filter (λ(p) (equal? p _unassigned)) parms))) (if (> missing 0) @@ -85,7 +85,7 @@ (class constraint% (super-new) - (define/override (broken? variables domains assignments [forward-check? #f] [_unassigned Unassigned]) + (define/override (is-true? variables domains assignments [forward-check? #f] [_unassigned Unassigned]) (define-values (assigned-vars unassigned-vars) (partition (λ(var) (hash-has-key? assignments var)) variables)) (define assigned-values (map (λ(var) (hash-ref assignments var)) assigned-vars)) @@ -106,7 +106,7 @@ (class constraint% (super-new) - (define/override (broken? variables domains assignments [forward-check? #f] [_unassigned Unassigned]) + (define/override (is-true? variables domains assignments [forward-check? #f] [_unassigned Unassigned]) (define singlevalue _unassigned) (define value #f) (define domain #f) @@ -118,7 +118,7 @@ _unassigned)) (cond [(equal? singlevalue _unassigned) (set! singlevalue value)] - [(and (not (equal? value _unassigned)) (not (equal? value singlevalue))) + [(nor (equal? value _unassigned) (equal? value singlevalue)) (set! return-value #f) (return-k)])) (when (and forward-check? (not (equal? singlevalue _unassigned))) diff --git a/csp/helper.rkt b/csp/helper.rkt index 817d7c7b..fbe1ecdd 100644 --- a/csp/helper.rkt +++ b/csp/helper.rkt @@ -3,6 +3,14 @@ (provide (all-defined-out)) (require rackunit) +(define-syntax-rule (forever expr ...) + (for ([i (in-naturals)]) + expr ...)) + +(define-syntax-rule (forever/or expr ...) + (for/or ([i (in-naturals)]) + expr ...)) + (define-syntax-rule (for-each-send proc objects) (for-each (λ(o) (send o proc)) objects)) diff --git a/csp/python-constraint/trials/abc.py b/csp/python-constraint/trials/abcd.py similarity index 100% rename from csp/python-constraint/trials/abc.py rename to csp/python-constraint/trials/abcd.py diff --git a/csp/solver.rkt b/csp/solver.rkt index 71ab5c4a..301adb31 100644 --- a/csp/solver.rkt +++ b/csp/solver.rkt @@ -30,10 +30,10 @@ (define/override (get-solution-iter domains constraints vconstraints) (define sorted-variables - (map last (sort (for/list ([(variable domain) (in-hash domains)]) - (list (- (length (hash-ref vconstraints variable))) ; first two elements used for sorting - (length (domain)) - variable)) list-comparator))) + (map third (sort (map (λ(var) + (list (- (length (hash-ref vconstraints var))) ; first two elements used for sorting + (length ((hash-ref domains var))) + var)) (hash-keys domains)) list-comparator))) ;; state-retention variables (define possible-solution (make-hash)) (define variable-queue null) @@ -61,34 +61,34 @@ (let/ec exit-k ;; mix the degree and minimum-remaining-values (MRV) heuristics - (let main-loop () - (unless (get-next-unassigned-variable) - (yield (hash-copy possible-solution)) ; if there are no unassigned variables, solution is done. - (if (null? variable-queue) ; if queue isn't empty, return to previous variable, otherwise all done. - (exit-k) - (set!-previous-variable))) - - (let value-checking-loop () ; we have a variable. Do we have any values left? - (when (null? values) ; no, so try going back to last variable and getting some values - (for/or ([i (in-naturals)]) - (when (null? variable-queue) (exit-k)) ; no variables left, so solver is done - (hash-remove! possible-solution variable) - (set!-previous-variable) - (not (null? values)))) - - ;; Got a value. Check it. - (hash-set! possible-solution variable (car-pop! values)) - (for-each-send push-state pushdomains) - (when (for/or ([cvpair (in-list (hash-ref vconstraints variable))]) - (match-define (list constraint variables) cvpair) - (not (send constraint broken? variables domains possible-solution pushdomains))) - ;; constraint failed, so try again - (for-each-send pop-state pushdomains) - (value-checking-loop))) - - ;; Push state before looking for next variable. - (set! variable-queue (cons (vvp variable values pushdomains) variable-queue)) - (main-loop)) + (forever + (unless (get-next-unassigned-variable) + (yield (hash-copy possible-solution)) ; if there are no unassigned variables, solution is complete. + (if (null? variable-queue) ; then, if queue is empty ... + (exit-k) ; all done, no other solutions possible. + (set!-previous-variable))) ; or queue is not empty, so return to previous variable + + (let value-checking-loop () ; we have a variable. Do we have any values left? + (when (null? values) ; no, so try going back to last variable and getting some values + (forever/or + (when (null? variable-queue) (exit-k)) ; no variables left, so solver is done + (hash-remove! possible-solution variable) + (set!-previous-variable) + (not (null? values)))) + + ;; Got a value. Check it. + (hash-set! possible-solution variable (car-pop! values)) + (for-each-send push-state pushdomains) + (unless (for/and ([constraint+variables (in-list (hash-ref vconstraints variable))]) + (let ([constraint (car constraint+variables)] + [variables (cadr constraint+variables)]) + (send constraint is-true? variables domains possible-solution pushdomains))) + ;; constraint failed, so try again + (for-each-send pop-state pushdomains) + (value-checking-loop))) + + ;; Push state before looking for next variable. + (set! variable-queue (cons (vvp variable values pushdomains) variable-queue))) (error 'get-solution-iter "impossible to reach this")) (void)) From 0622a204bb380b64d92125ece9e2a327b8346cc8 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Sun, 5 Oct 2014 18:18:45 -0700 Subject: [PATCH 073/246] tidying --- csp/constraint.rkt | 4 ++-- csp/helper.rkt | 2 +- csp/solver.rkt | 24 ++++++++++++------------ 3 files changed, 15 insertions(+), 15 deletions(-) diff --git a/csp/constraint.rkt b/csp/constraint.rkt index c0d54a09..e1c763f6 100644 --- a/csp/constraint.rkt +++ b/csp/constraint.rkt @@ -53,7 +53,7 @@ (unless (is-true? variables domains assignments) (send unassigned-variable-domain hide-value value))) (hash-remove! assignments unassigned-variable) - (not (null? unassigned-variable-domain))] ; if domain had no remaining values, the constraint will be impossible to meet, so return #f + (not (empty? unassigned-variable-domain))] ; if domain had no remaining values, the constraint will be impossible to meet, so return #f [else #t])) )) @@ -96,7 +96,7 @@ [assigned-value (in-list assigned-values)] #:when (member assigned-value (unassigned-var-domain))) (send unassigned-var-domain hide-value assigned-value) - (null? unassigned-var-domain))) #f] ; if domain had no remaining values, the constraint will be impossible to meet, so return #f + (empty? unassigned-var-domain))) #f] ; if domain had no remaining values, the constraint will be impossible to meet, so return #f [else #t])))) (define all-different-constraint%? (is-a?/c all-different-constraint%)) diff --git a/csp/helper.rkt b/csp/helper.rkt index fbe1ecdd..c607c9ea 100644 --- a/csp/helper.rkt +++ b/csp/helper.rkt @@ -7,7 +7,7 @@ (for ([i (in-naturals)]) expr ...)) -(define-syntax-rule (forever/or expr ...) +(define-syntax-rule (forever/until expr ...) (for/or ([i (in-naturals)]) expr ...)) diff --git a/csp/solver.rkt b/csp/solver.rkt index 301adb31..491f9104 100644 --- a/csp/solver.rkt +++ b/csp/solver.rkt @@ -15,7 +15,7 @@ (struct vvp (variable values pushdomains)) (define-syntax-rule (pop-vvp-values! vvps) - (if (null? vvps) + (if (empty? vvps) (error 'pop-vvp-values! (format "~a is null" vvps)) (let ([vvp (car vvps)]) (set! vvps (cdr vvps)) @@ -29,11 +29,11 @@ (field [_forwardcheck forwardcheck]) (define/override (get-solution-iter domains constraints vconstraints) - (define sorted-variables - (map third (sort (map (λ(var) - (list (- (length (hash-ref vconstraints var))) ; first two elements used for sorting - (length ((hash-ref domains var))) - var)) (hash-keys domains)) list-comparator))) + (define sorted-variables (sort (hash-keys domains) list-comparator + #:key (λ(var) + (list (- (length (hash-ref vconstraints var))) + (length ((hash-ref domains var))) + var)))) ;; state-retention variables (define possible-solution (make-hash)) (define variable-queue null) @@ -64,17 +64,17 @@ (forever (unless (get-next-unassigned-variable) (yield (hash-copy possible-solution)) ; if there are no unassigned variables, solution is complete. - (if (null? variable-queue) ; then, if queue is empty ... + (if (empty? variable-queue) (exit-k) ; all done, no other solutions possible. - (set!-previous-variable))) ; or queue is not empty, so return to previous variable + (set!-previous-variable))) ; otherwise return to previous variable (let value-checking-loop () ; we have a variable. Do we have any values left? - (when (null? values) ; no, so try going back to last variable and getting some values - (forever/or - (when (null? variable-queue) (exit-k)) ; no variables left, so solver is done + (when (empty? values) ; no, so try going back to last variable and getting some values + (forever/until + (when (empty? variable-queue) (exit-k)) ; no variables left, so solver is done (hash-remove! possible-solution variable) (set!-previous-variable) - (not (null? values)))) + (not (empty? values)))) ;; Got a value. Check it. (hash-set! possible-solution variable (car-pop! values)) From 838ed30e5bb438c8da96ce0ff05d9ad6318eb27b Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Mon, 6 Oct 2014 00:18:26 -0700 Subject: [PATCH 074/246] works --- csp/constraint.rkt | 45 ++++++++++++++++++--------------------------- 1 file changed, 18 insertions(+), 27 deletions(-) diff --git a/csp/constraint.rkt b/csp/constraint.rkt index e1c763f6..0b561020 100644 --- a/csp/constraint.rkt +++ b/csp/constraint.rkt @@ -107,32 +107,23 @@ (super-new) (define/override (is-true? variables domains assignments [forward-check? #f] [_unassigned Unassigned]) - (define singlevalue _unassigned) - (define value #f) - (define domain #f) - (define return-value (void)) - (let/ec return-k - (for ([variable (in-list variables)]) - (set! value (if (hash-has-key? assignments variable) - (hash-ref assignments variable) - _unassigned)) - (cond - [(equal? singlevalue _unassigned) (set! singlevalue value)] - [(nor (equal? value _unassigned) (equal? value singlevalue)) - (set! return-value #f) - (return-k)])) - (when (and forward-check? (not (equal? singlevalue _unassigned))) - (for ([variable (in-list variables)]) - (unless (variable . in? . assignments) - (set! domain (hash-ref domains variable)) - (unless (singlevalue . in? . (domain)) - (set! return-value #f) - (return-k)) - (for ([value (in-list (domain))]) - (unless (equal? value singlevalue) - (send domain hide-value value)))))) - (set! return-value #t) - (return-k)) - return-value))) + (define-values (assigned-vars unassigned-vars) + (partition (λ(var) (hash-has-key? assignments var)) variables)) + (define assigned-values (map (λ(var) (hash-ref assignments var)) assigned-vars)) + (define single-value (if (not (empty? assigned-values)) + (car assigned-values) + _unassigned)) + (cond + [(not (andmap (λ(v) (equal? single-value v)) assigned-values)) #f] ; constraint broken: not all values the same + [(and forward-check? (not (equal? single-value _unassigned))) + (for/and ([unassigned-var-domain (in-list (map (λ(uv) (hash-ref domains uv)) unassigned-vars))]) + ;; if single-value is not a member of each domain, constraint will be broken later, so bail out + (and (member single-value (unassigned-var-domain)) + (for ([value (in-list (unassigned-var-domain))] + #:unless (equal? value single-value)) + (send unassigned-var-domain hide-value value))))] ; otherwise hide nonconforming values + [else #t])))) + (define all-equal-constraint%? (is-a?/c all-equal-constraint%)) + From 3659d4b8b559a77e35d3fbe7d9c27b409f61d4df Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Mon, 6 Oct 2014 08:29:05 -0700 Subject: [PATCH 075/246] einstein test --- csp/test-einstein.rkt | 139 ++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 139 insertions(+) create mode 100644 csp/test-einstein.rkt diff --git a/csp/test-einstein.rkt b/csp/test-einstein.rkt new file mode 100644 index 00000000..059a76c1 --- /dev/null +++ b/csp/test-einstein.rkt @@ -0,0 +1,139 @@ +#lang racket + +(require "problem.rkt" "constraint.rkt" sugar/debug) + +(define ep (new problem%)) + +(for ([idx '(1 2 3 4 5)]) + (send ep add-variable (format "color~a" idx) '("red" "ivory" "green" "yellow" "blue")) + + (send ep add-variable (format "nationality~a" idx) '("englishman" "spaniard" "ukrainian" "norwegian" "japanese")) + + (send ep add-variable (format "drink~a" idx) '("tea" "coffee" "milk" "orangejuice" "water")) + + (send ep add-variable (format "smoke~a" idx) '("oldgold" "kools" "chesterfields" "luckystrike" "parliaments")) + + (send ep add-variable (format "pet~a" idx) '("dogs" "snails" "foxes" "horses" "zebra"))) + +(for ([name '("color" "nationality" "drink" "smoke" "pet")]) + (send ep add-constraint (new all-different-constraint%) + (map (λ(idx) (format "~a~a" name idx)) '(1 2 3 4 5)))) + + +(for ([idx '(1 2 3 4 5)]) + (send ep add-constraint + (λ(n c) (or (not (equal? n "englishman")) (equal? c "red"))) + (list (format "nationality~a" idx) (format "color~a" idx))) + + + (send ep add-constraint + (λ(n p) (or (not (equal? n "spaniard")) (equal? p "dogs"))) + (list (format "nationality~a" idx) (format "pet~a" idx))) + + (send ep add-constraint + (λ(n d) (or (not (equal? n "ukrainian")) (equal? d "tea"))) + (list (format "nationality~a" idx) (format "drink~a" idx))) + + (if (< idx 5) + (send ep add-constraint + (λ(ca cb) (or (not (equal? ca "green")) (equal? cb "ivory"))) + (list (format "color~a" idx) (format "color~a" (add1 idx)))) + (send ep add-constraint + (λ(c) (not (equal? c "green"))) + (list (format "color~a" idx)))) + + (send ep add-constraint + (λ(c d) (or (not (equal? c "green")) (equal? d "coffee"))) + (list (format "color~a" idx) (format "drink~a" idx))) + + (send ep add-constraint + (λ(s p) (or (not (equal? s "oldgold")) (equal? p "snails"))) + (list (format "smoke~a" idx) (format "pet~a" idx))) + + (send ep add-constraint + (λ(c s) (or (not (equal? c "yellow")) (equal? s "kools"))) + (list (format "color~a" idx) (format "smoke~a" idx))) + + (when (= idx 3) + (send ep add-constraint + (λ(d) (equal? d "milk")) + (list (format "drink~a" idx)))) + + (when (= idx 1) + (send ep add-constraint + (λ(n) (equal? n "norwegian")) + (list (format "nationality~a" idx)))) + + (if (< 1 idx 5) + (send ep add-constraint + (λ(s pa pb) (or (not (equal? s "chesterfields")) (equal? pa "foxes") (equal? pb "foxes"))) + (list (format "smoke~a" idx) (format "pet~a" (add1 idx)) (format "pet~a" (sub1 idx)))) + (send ep add-constraint + (λ(s p) (or (not (equal? s "chesterfields")) (equal? p "foxes"))) + (list (format "smoke~a" idx) (format "pet~a" (if (= idx 1) 2 4))))) + + (if (< 1 idx 5) + (send ep add-constraint + (λ(p sa sb) (or (not (equal? p "horses")) (equal? sa "kools") (equal? sb "kools"))) + (list (format "pet~a" idx) (format "smoke~a" (add1 idx)) (format "smoke~a" (sub1 idx)))) + (send ep add-constraint + (λ(p s) (or (not (equal? p "horses")) (equal? s "kools"))) + (list (format "pet~a" idx) (format "smoke~a" (if (= idx 1) 2 4))))) + + (send ep add-constraint + (λ(s d) (or (not (equal? s "luckystrike")) (equal? d "orangejuice"))) + (list (format "smoke~a" idx) (format "drink~a" idx))) + + (send ep add-constraint + (λ(n s) (or (not (equal? n "japanese")) (equal? s "parliaments"))) + (list (format "nationality~a" idx) (format "smoke~a" idx))) + + + (if (< 1 idx 5) + (send ep add-constraint + (λ(n ca cb) (or (not (equal? n "norwegian")) (equal? ca "blue") (equal? cb "blue"))) + (list (format "nationality~a" idx) (format "color~a" (add1 idx)) (format "color~a" (sub1 idx)))) + (send ep add-constraint + (λ(n c) (or (not (equal? n "norwegian")) (equal? c "blue"))) + (list (format "nationality~a" idx) (format "color~a" (if (= idx 1) 2 4))))) + + + ) + + +(module+ main + (require rackunit) + +(define s (time (send ep get-solution))) + +(define result + (for*/list ([idx '(1 2 3 4 5)] + [name '("nationality" "color" "drink" "smoke" "pet")]) + (define key (format "~a~a" name idx)) + (format "~a ~a" key (hash-ref s key)))) + +(check-equal? result '("nationality1 norwegian" + "color1 yellow" + "drink1 water" + "smoke1 kools" + "pet1 foxes" + "nationality2 ukrainian" + "color2 blue" + "drink2 tea" + "smoke2 chesterfields" + "pet2 horses" + "nationality3 englishman" + "color3 red" + "drink3 milk" + "smoke3 oldgold" + "pet3 snails" + "nationality4 japanese" + "color4 green" + "drink4 coffee" + "smoke4 parliaments" + "pet4 zebra" + "nationality5 spaniard" + "color5 ivory" + "drink5 orangejuice" + "smoke5 luckystrike" + "pet5 dogs"))) \ No newline at end of file From 70ca48255bf560c6d49fc74ed40cff8f861c1373 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Mon, 6 Oct 2014 11:26:09 -0700 Subject: [PATCH 076/246] paste problem --- csp/test-einstein.rkt | 29 +++++++++++++++++++++++++++++ 1 file changed, 29 insertions(+) diff --git a/csp/test-einstein.rkt b/csp/test-einstein.rkt index 059a76c1..aeef4b4d 100644 --- a/csp/test-einstein.rkt +++ b/csp/test-einstein.rkt @@ -2,6 +2,35 @@ (require "problem.rkt" "constraint.rkt" sugar/debug) +#| +# There are no tricks, just pure logic, so good luck and don't give up. +# +# 1. In a street there are five houses, painted five different colours. +# 2. In each house lives a person of different nationality +# 3. These five homeowners each drink a different kind of beverage, smoke +# different brand of cigar and keep a different pet. +# +# THE QUESTION: WHO OWNS THE zebra? +# +# HINTS +# +# 1. The englishman lives in a red house. +# 2. The spaniard keeps dogs as pets. +# 5. The owner of the Green house drinks coffee. +# 3. The ukrainian drinks tea. +# 4. The Green house is on the left of the ivory house. +# 6. The person who smokes oldgold rears snails. +# 7. The owner of the Yellow house smokes kools. +# 8. The man living in the centre house drinks milk. +# 9. The Norwegian lives in the first house. +# 10. The man who smokes chesterfields lives next to the one who keeps foxes. +# 11. The man who keeps horses lives next to the man who smokes kools. +# 12. The man who smokes luckystrike drinks orangejuice. +# 13. The japanese smokes parliaments. +# 14. The Norwegian lives next to the blue house. +# 15. The man who smokes chesterfields has a neighbour who drinks water. +|# + (define ep (new problem%)) (for ([idx '(1 2 3 4 5)]) From 4525c68dff1014a7c30dc5ef929309d9bf03a347 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Mon, 6 Oct 2014 11:33:41 -0700 Subject: [PATCH 077/246] prune --- csp/search.rkt | 93 -------------------------------------------------- csp/utils.rkt | 43 ----------------------- 2 files changed, 136 deletions(-) delete mode 100644 csp/search.rkt delete mode 100644 csp/utils.rkt diff --git a/csp/search.rkt b/csp/search.rkt deleted file mode 100644 index e709a322..00000000 --- a/csp/search.rkt +++ /dev/null @@ -1,93 +0,0 @@ -#lang racket/base -(require racket/class racket/match) - -(provide (all-defined-out)) - -(define Problem - ;; The abstract class for a formal problem. You should subclass this and - ;; implement the method successor, and possibly __init__, goal_test, and - ;; path_cost. Then you will create instances of your subclass and solve them - ;; with the various search functions. - - (class object% - (super-new) - - (init-field initial [goal #f]) - ;; The constructor specifies the initial state, and possibly a goal - ;; state, if there is a unique goal. Your subclass's constructor can add - ;; other arguments. - - (abstract successor) - ;; Given a state, return a sequence of (action, state) pairs reachable - ;; from this state. If there are many successors, consider an iterator - ;; that yields the successors one at a time, rather than building them - ;; all at once. Iterators will work fine within the framework. - - (define/public (goal_test state) - ;; Return True if the state is a goal. The default method compares the - ;; state to self.goal, as specified in the constructor. Implement this - ;; method if checking against a single self.goal is not enough. - (and (equal? state goal) #t)) - - (define/public (path_cost c state1 action state2) - ;; Return the cost of a solution path that arrives at state2 from - ;; state1 via action, assuming cost c to get up to state1. If the problem - ;; is such that the path doesn't matter, this function will only look at - ;; state2. If the path does matter, it will consider c and maybe state1 - ;; and action. The default method costs 1 for every step in the path. - (add1 c)) - - (abstract value) - ;; For optimization problems, each state has a value. Hill-climbing - ;; and related algorithms try to maximize this value. - )) - -(require describe) - -(define Node - #| A node in a search tree. Contains a pointer to the parent (the node - that this is a successor of) and to the actual state for this node. Note - that if a state is arrived at by two paths, then there are two nodes with - the same state. Also includes the action that got us to this state, and - the total path_cost (also known as g) to reach the node. Other functions - may add an f and h value; see best_first_graph_search and astar_search for - an explanation of how the f and h values are handled. You will not need to - subclass this class. -|# - - (class* object% (printable<%>) - (super-new) - - (init-field state [parent #f] [action #f] [path_cost 0]) - (field [depth (if parent (add1 (get-field depth parent)) 0)]) - ;; Create a search tree Node, derived from a parent by an action. - - (define (repr) (format "" (get-field state this))) - (define/public (custom-print out quoting-depth) (print (repr) out)) - (define/public (custom-display out) (displayln (repr) out)) - (define/public (custom-write out) (write (repr) out)) - - (define/public (path) - ;; Create a list of nodes from the root to this node. - (define parent (get-field parent this)) - (cons this (if (not parent) - null - (send parent path)))) - - (define/public (expand problem) - ;; Return a list of nodes reachable from this node. - (for/list ([action-state-pair (in-list (send problem successor state))]) - (match-define (cons act next) action-state-pair) - (new Node [state next][parent this][action act] - [path_cost (send problem path_cost path_cost state act next)]))) - )) - -(module+ main - (require racket/format) - (define gp (new Node [state 'grandparent])) - (define p (new Node [state 'parent][parent gp])) - (get-field state p) - (get-field depth p) - (define c (new Node [state 'child] [parent p])) - (get-field depth c) - (send c path)) \ No newline at end of file diff --git a/csp/utils.rkt b/csp/utils.rkt deleted file mode 100644 index 8ee8cd49..00000000 --- a/csp/utils.rkt +++ /dev/null @@ -1,43 +0,0 @@ -#lang racket/base -(require racket/list racket/bool) - -(provide (all-defined-out)) - -(module+ test (require rackunit)) - - - -(define (count_if pred xs) - ;; Count the number of elements of seq for which the predicate is true. - (length (filter-not false? (map pred xs)))) - -(module+ test - (check-equal? (count_if procedure? (list 42 null max min)) 2)) - -(define (find_if pred xs) - ;; If there is an element of seq that satisfies predicate; return it. - (or (findf pred xs) null)) - -(module+ test - (check-equal? (find_if procedure? (list 3 min max)) min) - (check-equal? (find_if procedure? (list 1 2 3)) null)) - - -(define (every pred xs) - ;;;True if every element of seq satisfies predicate. - (andmap pred xs)) - -(module+ test - (check-true (every procedure? (list min max))) - (check-false (every procedure? (list min 3)))) - - -(define (argmin_random_tie xs proc) - ;; Return an element with lowest fn(seq[i]) score; break ties at random. - ;; Thus, for all s,f: argmin_random_tie(s, f) in argmin_list(s, f) - (define assocs (map (λ(x) (cons (proc x) x)) xs)) - (define min-value (apply min (map car assocs))) - (define min-xs (map cdr (filter (λ(a) (= min-value (car a))) assocs))) - (list-ref min-xs (random (length min-xs)))) - -;(argmin_random_tie (list (range 0 4) (range 5 9) (range 10 13) (range 20 23)) length) \ No newline at end of file From c03653fba34c0242f380163d08d739f14ef908d7 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Mon, 6 Oct 2014 19:54:15 -0700 Subject: [PATCH 078/246] kill --- csp/csp.rkt | 358 ---------------------------------------------------- 1 file changed, 358 deletions(-) delete mode 100644 csp/csp.rkt diff --git a/csp/csp.rkt b/csp/csp.rkt deleted file mode 100644 index e0cb48bc..00000000 --- a/csp/csp.rkt +++ /dev/null @@ -1,358 +0,0 @@ -#lang racket/base - -;; Adapted from work by Peter Norvig -;; http://aima-python.googlecode.com/svn/trunk/csp.py - -(require racket/list racket/bool racket/contract racket/class racket/match racket/generator racket/string) -(require sugar/debug) -(require "utils.rkt" "search.rkt") - -(module+ test (require rackunit)) - -(define CSP (class Problem - #| -This class describes finite-domain Constraint Satisfaction Problems. - A CSP is specified by the following inputs: - vars A list of variables; each is atomic (e.g. int or string). - domains A dict of {var:[possible_value, ...]} entries. - neighbors A dict of {var:[var,...]} that for each variable lists - the other variables that participate in constraints. - constraints A function f(A, a, B, b) that returns true if neighbors - A, B satisfy the constraint when they have values A=a, B=b - In the textbook and in most mathematical definitions, the - constraints are specified as explicit pairs of allowable values, - but the formulation here is easier to express and more compact for - most cases. (For example, the n-Queens problem can be represented - in O(n) space using this notation, instead of O(N^4) for the - explicit representation.) In terms of describing the CSP as a - problem, that's all there is. - - However, the class also supports data structures and methods that help you - solve CSPs by calling a search function on the CSP. Methods and slots are - as follows, where the argument 'a' represents an assignment, which is a - dict of {var:val} entries: - assign(var, val, a) Assign a[var] = val; do other bookkeeping - unassign(var, a) Do del a[var], plus other bookkeeping - nconflicts(var, val, a) Return the number of other variables that - conflict with var=val - curr_domains[var] Slot: remaining consistent values for var - Used by constraint propagation routines. - The following methods are used only by graph_search and tree_search: - actions(state) Return a list of actions - result(state, action) Return a successor of state - goal_test(state) Return true if all constraints satisfied - The following are just for debugging purposes: - nassigns Slot: tracks the number of assignments made - display(a) Print a human-readable representation -|# - (super-new) - - ;; Construct a CSP problem. If vars is empty, it becomes domains.keys(). - (init-field vars domains neighbors constraints) - (when (not vars) (set! vars (hash-keys domains))) - (inherit-field initial) - (set! initial (hash)) - (field [curr_domains #f][pruned #f][nassigns 0][fc #f][mac #f]) - - (define/public (assign var val assignment) - ;; Add {var: val} to assignment; Discard the old value if any. - ;; Do bookkeeping for curr_domains and nassigns. - (set! nassigns (add1 nassigns)) - (hash-set! assignment var val) - (if curr_domains - (when fc - (forward_check var val assignment)) - (when mac - (AC3 (map (λ(Xk) (cons Xk var)) (hash-ref neighbors var)))))) - - (define/public (unassign var val assignment) - ;; Remove {var: val} from assignment; that is backtrack. - ;; DO NOT call this if you are changing a variable to a new value; - ;; just call assign for that. - (when (hash-has-key? assignment var) - ;; Reset the curr_domain to be the full original domain - (when curr_domains - (hash-set! curr_domains var (hash-ref domains var))) - (hash-remove! assignment var))) - - (define/public (nconflicts var val assignment) - ;; Return the number of conflicts var=val has with other variables. - ;; Subclasses may implement this more efficiently - (define (conflict var2) - (define val2 (hash-ref assignment var2 #f)) - (and val2 (not (constraints var val var2 val2)))) - (count_if conflict (hash-ref neighbors var))) - - (define/public (forward_check var val assignment) - ;; Do forward checking (current domain reduction) for this assignment. - (when curr_domains - ;; Restore prunings from previous value of var - (for ([Bb-pair (in-list (hash-ref pruned var))]) - (match-define (cons B b) Bb-pair) - (hash-update! curr_domains B (λ(v) (append v b)))) - (hash-set! pruned var #f) - ;; Prune any other B=b assignment that conflicts with var=val - (for ([B (in-list (hash-ref neighbors var))]) - (when (not (hash-has-key? assignment B)) - (for ([b (in-list (hash-ref curr_domains B))]) - (when (not (constraints var val B b)) - (hash-update! curr_domains B (λ(v) (remove v b))) - (hash-update! pruned var (λ(v) (append v (cons B b)))))))))) - - (define/public (display assignment) - ;; Show a human-readable representation of the CSP. - (displayln (format "CSP: ~a with assignment: ~a" this assignment))) - - ;; These methods are for the tree and graph search interface: - - (define/public (succ assignment) - ;; Return a list of (action, state) pairs - (if (= (length assignment) (length vars)) - null - (let ([var (find_if (λ(v) (not (hash-has-key? assignment v))) vars)]) - (for/list ([val (in-list (hash-ref domains var))] #:when (= (nconflicts var val assignment) 0)) - (define a (hash-copy assignment)) - (hash-set! a var val) - (cons (cons var val) a))))) - - (define/override (goal_test assignment) - ;; The goal is to assign all vars, with all constraints satisfied. - (and (= (length assignment) (length vars)) - (every (λ(var) (= (nconflicts var (hash-ref assignment var) assignment) 0)) vars))) - - ;; This is for min_conflicts search - (define/public (conflicted_vars current) - ;; Return a list of variables in current assignment that are in conflict - (for/list ([var (in-list vars)] - #:when (> (nconflicts var (hash-ref current var) current) 0)) - var)) - )) - -;;______________________________________________________________________________ -;; CSP Backtracking Search - -(define (backtracking_search csp [mcv #f] [lcv #f] [fc #f] [mac #f]) - #| -Set up to do recursive backtracking search. Allow the following options: - mcv - If true, use Most Constrained Variable Heuristic - lcv - If true, use Least Constraining Value Heuristic - fc - If true, use Forward Checking - mac - If true, use Maintaining Arc Consistency. [Fig. 5.3] - >>> backtracking_search(australia) - {'WA': 'B', 'Q': 'B', 'T': 'B', 'V': 'B', 'SA': 'G', 'NT': 'R', 'NSW': 'R'} -|# - (when (or fc mac) - (set-field! curr_domains csp (hash)) - (set-field! pruned csp (hash))) - (set-field! mcv csp mcv) - (set-field! lcv csp lcv) - (set-field! fc csp fc) - (set-field! mac csp mac)) - -(define (recursive_backtracking assignment csp) - ;; Search for a consistent assignment for the csp. - ;; Each recursive call chooses a variable, and considers values for it. - (cond - [(= (length assignment) (length (get-field vars csp))) assignment] - [else - (define var (select_unassigned_variable assignment csp)) - (define result null) - (let/ec done ;; sneaky way of getting return-like functionality - (for ([val (in-list (order_domain_values var assignment csp))]) - (when (or (get-field fc csp) (= (send csp nconflicts var val assignment) 0)) - (send csp assign var val assignment) - (set! result (recursive_backtracking assignment csp)) - (when (not (null? result)) - (done)) - (send csp unassign var assignment))) - result)])) - - -(define (select_unassigned_variable assignment csp) - ;; Select the variable to work on next. Find - (if (get-field mcv csp) ; most constrained variable - (let () - (define unassigned (filter (λ(v) (not (hash-has-key? assignment v))) (get-field vars csp))) - (argmin_random_tie unassigned (λ(var) (* -1 (num_legal_values csp var assignment))))) - ;; else first unassigned variable - (for/first ([v (in-list (get-field vars csp))] #:when (not (hash-has-key? assignment v))) - v))) - -(define (order_domain_values var assignment csp) - ;; Decide what order to consider the domain variables. - (define domain (if (get-field curr_domains csp) - (hash-ref (get-field curr_domains csp) var) - (hash-ref (get-field domains csp) var))) - (when (get-field lcv csp) - ;; If LCV is specified, consider values with fewer conflicts first - (define key (λ(val) (send csp nconflicts var val assignment))) - (set! domain (sort domain < #:key key))) - (generator () - (let loop ([niamod (reverse domain)]) - (yield (car niamod)) - (loop (cdr niamod))))) - -(define (num_legal_values csp var assignment) - (if (get-field curr_domains csp) - (length (hash-ref (get-field curr_domains csp) var)) - (count_if (λ(val) (= (send csp nconflicts var val assignment) 0)) (hash-ref (get-field domains csp) var)))) - - -;;______________________________________________________________________________ -;; Constraint Propagation with AC-3 - - -(define (AC3 csp [queue null]) - (when (null? queue) - (set! queue (for*/list ([Xi (in-list (get-field vars csp))] - [Xk (in-list (hash-ref (get-field neighbors csp) Xi))]) - (cons Xi Xk)))) - (let loop ([eueuq (reverse queue)]) - (when (not (null? eueuq)) - (match-define (cons Xi Xj) (car eueuq)) - (set! eueuq (cdr eueuq)) ;; equivalent to python pop - (when (remove_inconsistent_values csp Xi Xj) - (set! eueuq - (append - (reverse (for/list ([Xk (in-list (hash-ref (get-field neighbors csp) Xi))]) - (cons Xk Xi))) - eueuq))) - (loop eueuq)))) - -(define (remove_inconsistent_values csp Xi Xj) - ;; Return true if we remove a value. - (define removed #f) - (for ([x (in-list (hash-ref (get-field curr_domains csp) Xi))]) - ;; If Xi=x conflicts with Xj=y for every possible y, eliminate Xi=x - (when (every (λ(y) (not (send csp constraints Xi x Xj y))) - (hash-ref (get-field curr_domains csp) Xj)) - (hash-update! (get-field curr_domains csp) Xi (λ(val) (remove val x))) - (set! removed #t))) - removed) - -;;______________________________________________________________________________ -;; Min-conflicts hillclimbing search for CSPs - -(define (min_conflicts csp [max_steps 1000000]) - ;; Solve a CSP by stochastic hillclimbing on the number of conflicts. - ;; Generate a complete assignment for all vars (probably with conflicts) - (define current (hash)) - (set-field! current csp current) - (for ([var (in-list (get-field vars csp))]) - (define val (min_conflicts_value csp var current)) - (send csp assign var val current)) - ;; Now repeatedly choose a random conflicted variable and change it - (define found-result #f) - (let/ec done ;; sneaky way of getting return-like functionality - (for ([i (in-range max_steps)]) - (define conflicted (send csp conflicted_vars current)) - (when (not conflicted) (set! found-result #t) (done)) - (define var (list-ref conflicted (random (length conflicted)))) - (define val (min_conflicts_value csp var current)) - (send csp assign var val current))) - (and found-result current)) - -(define (min_conflicts_value csp var current) - ;; Return the value that will give var the least number of conflicts. - ;; If there is a tie, choose at random. - (argmin_random_tie (hash-ref (get-field domains csp) var) - (λ(val) (send csp nconflicts var val current)))) - -;; ______________________________________________________________________________ -;; Map-Coloring Problems - -(define (parse_neighbors neighbors [vars null]) - #| - Convert a string of the form 'X: Y Z; Y: Z' into a dict mapping - regions to neighbors. The syntax is a region name followed by a ':' - followed by zero or more region names, followed by ';', repeated for - each region name. If you say 'X: Y' you don't need 'Y: X'. - >>> parse_neighbors('X: Y Z; Y: Z') - {'Y': ['X', 'Z'], 'X': ['Y', 'Z'], 'Z': ['X', 'Y']} -|# - (define nh (make-hash)) - (for ([v (in-list vars)]) (hash-set! nh v null)) - (define specs (for/list ([spec (in-list (string-split neighbors ";"))]) (string-split spec ":"))) - (for ([pair (in-list specs)]) - (match-define (list A Aneighbors) pair) - (set! A (string-trim A)) - (hash-ref! nh A null) - (for ([B (in-list (string-split Aneighbors))]) - (hash-update! nh A (λ(v) (append v (list B))) null) - (hash-update! nh B (λ(v) (append v (list A))) null))) - nh) - -(module+ test - (check-equal? (sort (hash->list (parse_neighbors "X: Y Z; Y: Z")) string Date: Mon, 6 Oct 2014 21:27:55 -0700 Subject: [PATCH 079/246] add note --- csp/solver.rkt | 14 ++++++++++++++ 1 file changed, 14 insertions(+) diff --git a/csp/solver.rkt b/csp/solver.rkt index 491f9104..c57b9589 100644 --- a/csp/solver.rkt +++ b/csp/solver.rkt @@ -21,6 +21,20 @@ (set! vvps (cdr vvps)) (values (vvp-variable vvp) (vvp-values vvp) (vvp-pushdomains vvp))))) +#| +(define (recursive-backtracking assignment csp) + (if (complete? assignment) + assignment + (let ([var (select-unassigned-variable csp-variables, assignment, csp)]) + (for/or ([value (in-list (order-domain-values var assignment csp))]) + if ((value . consistent-with? . assignment csp-constraints)) + (add-to assignment var value) + (define result (recursive-backtracking assignment csp)) + (when result + (and result (remove-from assignment var value))) + #f)))) +|# + (define backtracking-solver% ;; Problem solver with backtracking capabilities (class solver% From 5cecfa2a6941ac8099bb1d15b246468e5f1f430b Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Mon, 13 Oct 2014 11:43:37 -0700 Subject: [PATCH 080/246] add info.rkt --- csp/info.rkt | 7 +++++++ 1 file changed, 7 insertions(+) create mode 100644 csp/info.rkt diff --git a/csp/info.rkt b/csp/info.rkt new file mode 100644 index 00000000..2815b7d6 --- /dev/null +++ b/csp/info.rkt @@ -0,0 +1,7 @@ +#lang info +(define collection "csp") +(define deps '(("base" #:version "6.0") "sugar")) +(define update-implies '("sugar")) +;(define scribblings '(("scribblings/pollen.scrbl" (multi-page)))) +;(define raco-commands '(("pollen" pollen/raco "issue Pollen command" #f))) +;(define compile-omit-paths '("tests" "raco.rkt")) \ No newline at end of file From b5de86f326f6dcbd89b40be63c7c6d7dde00455d Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Tue, 28 Oct 2014 15:58:00 -0700 Subject: [PATCH 081/246] correct dependency --- csp/info.rkt | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/csp/info.rkt b/csp/info.rkt index 2815b7d6..bb3b0a3f 100644 --- a/csp/info.rkt +++ b/csp/info.rkt @@ -1,6 +1,6 @@ #lang info (define collection "csp") -(define deps '(("base" #:version "6.0") "sugar")) +(define deps '(("base" #:version "6.0") "sugar" "rackunit-lib")) (define update-implies '("sugar")) ;(define scribblings '(("scribblings/pollen.scrbl" (multi-page)))) ;(define raco-commands '(("pollen" pollen/raco "issue Pollen command" #f))) From 01613828788e19b71edddafaa27dfad0ec55cc78 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Sat, 16 May 2015 19:20:24 -0700 Subject: [PATCH 082/246] nit --- csp/test-classes.rkt | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/csp/test-classes.rkt b/csp/test-classes.rkt index 39680cc9..a0bc28f5 100644 --- a/csp/test-classes.rkt +++ b/csp/test-classes.rkt @@ -45,11 +45,11 @@ ;; FunctionConstraint, two ways: implicit and explicit (send problem reset) (send problem add-variables '(a b) '(1 2)) -(send problem add-constraint >) ; implicit +(send problem add-constraint <) ; implicit (check-hash-items (send problem get-solution) #hash((a . 1) (b . 2))) (send problem reset) (send problem add-variables '(a b) '(1 2)) -(send problem add-constraint (new function-constraint% [func >])) ; explicit +(send problem add-constraint (new function-constraint% [func <])) ; explicit (check-hash-items (send problem get-solution) #hash((a . 1) (b . 2))) ;; AllDifferentConstraint From 090cd5a818d9a78dc4b76cb5b479340913153ece Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Mon, 15 Feb 2016 13:53:48 -0800 Subject: [PATCH 083/246] fix dependency (closes #1) --- csp/constraint.rkt | 2 +- csp/problem.rkt | 2 +- csp/solver.rkt | 2 +- 3 files changed, 3 insertions(+), 3 deletions(-) diff --git a/csp/constraint.rkt b/csp/constraint.rkt index 0b561020..d73fcd2e 100644 --- a/csp/constraint.rkt +++ b/csp/constraint.rkt @@ -1,5 +1,5 @@ #lang racket/base -(require racket/class racket/bool sugar/container sugar/list sugar/debug racket/list "helper.rkt" "variable.rkt") +(require racket/class racket/bool sugar/unstable/container sugar/list sugar/debug racket/list "helper.rkt" "variable.rkt") (provide (all-defined-out)) (define constraint% diff --git a/csp/problem.rkt b/csp/problem.rkt index 852b795a..3883a69c 100644 --- a/csp/problem.rkt +++ b/csp/problem.rkt @@ -1,5 +1,5 @@ #lang racket/base -(require racket/class sugar/container sugar/debug racket/contract racket/match racket/generator racket/list) +(require racket/class sugar/unstable/container sugar/debug racket/contract racket/match racket/generator racket/list) (require "domain.rkt" "helper.rkt" "constraint.rkt" "solver.rkt") (provide (all-defined-out)) diff --git a/csp/solver.rkt b/csp/solver.rkt index c57b9589..742e63bd 100644 --- a/csp/solver.rkt +++ b/csp/solver.rkt @@ -1,5 +1,5 @@ #lang racket/base -(require racket/class sugar/container sugar/debug racket/list +(require racket/class sugar/unstable/container sugar/debug racket/list racket/bool racket/generator racket/match "helper.rkt") (provide (all-defined-out)) From c1ba286843e1ad36183cb6d19514c660e071116a Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Fri, 25 May 2018 15:33:01 -0700 Subject: [PATCH 084/246] fix tests --- csp/test-classes.rkt | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/csp/test-classes.rkt b/csp/test-classes.rkt index a0bc28f5..21e129e4 100644 --- a/csp/test-classes.rkt +++ b/csp/test-classes.rkt @@ -46,11 +46,13 @@ (send problem reset) (send problem add-variables '(a b) '(1 2)) (send problem add-constraint <) ; implicit -(check-hash-items (send problem get-solution) #hash((a . 1) (b . 2))) +(check-true (let ([s (sort (hash->list (send problem get-solution)) #:key cdr <)]) + (or (equal? s '((a . 1) (b . 2))) (equal? s '((b . 1) (a . 2)))))) (send problem reset) (send problem add-variables '(a b) '(1 2)) (send problem add-constraint (new function-constraint% [func <])) ; explicit -(check-hash-items (send problem get-solution) #hash((a . 1) (b . 2))) +(check-true (let ([s (sort (hash->list (send problem get-solution)) #:key cdr <)]) + (or (equal? s '((a . 1) (b . 2))) (equal? s '((b . 1) (a . 2)))))) ;; AllDifferentConstraint (send problem reset) From e8350c2d12a367a06196854b571b8aaa7c85d76f Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Mon, 8 Oct 2018 18:36:23 -0700 Subject: [PATCH 085/246] fresh implementation --- csp/csp.rkt | 161 ++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 161 insertions(+) create mode 100644 csp/csp.rkt diff --git a/csp/csp.rkt b/csp/csp.rkt new file mode 100644 index 00000000..26c40a59 --- /dev/null +++ b/csp/csp.rkt @@ -0,0 +1,161 @@ +#lang debug racket + +(struct $csp ([vars #:mutable] + [constraints #:mutable]) #:transparent) + +(struct $var (name vals) #:transparent) +(define $var-name? symbol?) +(struct $constraint (names proc) #:transparent) + +(define/contract (check-name-in-csp! caller csp name) + (symbol? $csp? $var-name? . -> . void?) + (define names (map $var-name ($csp-vars csp))) + (unless (memq name names) + (raise-argument-error caller (format "csp variable name: ~v" names) name))) + +(define/contract (nary-constraint? constraint num) + ($constraint? exact-nonnegative-integer? . -> . boolean?) + (= num (length ($constraint-names constraint)))) + +(define/contract (unary-constraint? constraint) + ($constraint? . -> . boolean?) + (nary-constraint? constraint 1)) + +(define/contract (binary-constraint? constraint) + ($constraint? . -> . boolean?) + (nary-constraint? constraint 2)) + +(define/contract (add-var! csp name [vals empty]) + (($csp? $var-name?) ((listof any/c)) . ->* . void?) + (when (memq name (map $var-name ($csp-vars csp))) + (raise-argument-error 'add-var! "var that doesn't exist" name)) + (set-$csp-vars! csp (cons ($var name vals) ($csp-vars csp)))) + +(define/contract (add-constraint! csp proc var-names) + ($csp? procedure? (listof $var-name?) . -> . void?) + (for ([name (in-list var-names)]) + (check-name-in-csp! 'add-constraint! csp name)) + (set-$csp-constraints! csp (cons ($constraint var-names proc) ($csp-constraints csp)))) + +(define/contract (apply-unary-constraint csp constraint) + ($csp? unary-constraint? . -> . $csp?) + (match-define ($constraint (list constraint-name) proc) constraint) + (check-has-solutions! + ($csp (for/list ([var (in-list ($csp-vars csp))]) + (match-define ($var name vals) var) + (if (eq? name constraint-name) + ($var name (filter proc vals)) + var)) + ;; once the constraint is applied, it can go away + (remove constraint ($csp-constraints csp))))) + +(define/contract (no-solutions? csp) + ($csp? . -> . boolean?) + (for/or ([var (in-list ($csp-vars csp))]) + (empty? ($var-vals var)))) + +(define/contract (check-has-solutions! csp) + ($csp? . -> . $csp?) + (when (no-solutions? csp) (raise 'no-solutions)) + csp) + +(define/contract (make-node-consistent csp) + ($csp? . -> . $csp?) + (for/fold ([csp csp]) + ([constraint (in-list ($csp-constraints csp))] + #:when (unary-constraint? constraint)) + (apply-unary-constraint csp constraint))) + +(define/contract ($csp-vals csp name) + ($csp? $var-name? . -> . (listof any/c)) + (check-name-in-csp! '$csp-vals csp name) + (for/first ([var (in-list ($csp-vars csp))] + #:when (eq? name ($var-name var))) + ($var-vals var))) + +(struct $arc (name constraint) #:transparent) + +(define/contract (revise csp arc) + ($csp? $arc? . -> . $csp?) + (match-define ($arc name ($constraint names constraint-proc)) arc) + (match-define (list other-name) (remove name names)) + (define proc (if (eq? name (first names)) ; name is on left + constraint-proc ; so val goes on left + (λ (val other-val) (constraint-proc other-val val)))) ; otherwise reverse arg order + (define (satisfies-arc? val) + (for/or ([other-val (in-list ($csp-vals csp other-name))]) + (proc val other-val))) + (apply-unary-constraint csp ($constraint (list name) + (procedure-rename + satisfies-arc? + (string->symbol (format "satisfies-arc-with-~a?" other-name)))))) + +(define/contract (binary-constraints->arcs constraints) + ((listof binary-constraint?) . -> . (listof $arc?)) + (for*/list ([constraint (in-list constraints)] + [name (in-list ($constraint-names constraint))]) + ($arc name constraint))) + +(define/contract (terminating-at arcs name) + ((listof $arc?) $var-name? . -> . (listof $arc?)) + ;; #true if name is in constraint name list and is not name of arc + (for/list ([arc (in-list arcs)] + #:when (and + (not (eq? name ($arc-name arc))) + (memq name ($constraint-names ($arc-constraint arc))))) + arc)) + +(define/contract (ac-3 csp) + ($csp? . -> . $csp?) + ;; as described by AIMA @ 265 + (define all-arcs (binary-constraints->arcs (filter binary-constraint? ($csp-constraints csp)))) + (for/fold ([csp csp] + [arcs all-arcs] + #:result csp) + ([i (in-naturals)] + #:break (empty? arcs)) + (match-define (cons arc other-arcs) arcs) + (match-define ($arc name _) arc) + (define revised-csp (revise csp arc)) + (values revised-csp (if (= (length ($csp-vals csp name)) (length ($csp-vals revised-csp name))) + ;; revision did not reduce the domain, so keep going + other-arcs + ;; revision reduced the domain, so supplement the list of arcs + (remove-duplicates (append (all-arcs . terminating-at . name) other-arcs)))))) + +(define/contract (make-arc-consistent csp) + ($csp? . -> . $csp?) + ;; csp is arc-consistent if every pair of variables (x y) + ;; has values in their domain that satisfy every binary constraint + (ac-3 csp)) + +(define/contract (solve csp) + ($csp? . -> . any/c) + ;; todo: backtracking search + ($csp-vars (make-arc-consistent (make-node-consistent csp)))) + + +(define csp ($csp empty empty)) + +(define digits (range 7)) +(add-var! csp 't digits) +(add-var! csp 'w digits) +(add-var! csp 'o '(2 6 7)) + +(define (sum-three t w o) (= 3 (+ t w o))) +(add-constraint! csp sum-three '(t w o)) + +(define diff (compose1 not =)) +(add-constraint! csp diff '(t w)) +(add-constraint! csp diff '(w o)) +(add-constraint! csp diff '(t o)) + +(add-constraint! csp < '(t w)) + +(define three-or-less (curryr <= 3)) +(add-constraint! csp three-or-less '(t)) +(add-constraint! csp three-or-less '(w)) +(add-constraint! csp three-or-less '(o)) + +csp +(solve csp) \ No newline at end of file From 031245eecd0bc97c43b299b8fcf4542674b1b0da Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Tue, 9 Oct 2018 19:18:16 -0700 Subject: [PATCH 086/246] more --- csp/csp.rkt | 111 +++++++++++++++++++++++++++++++++++++++++----------- 1 file changed, 88 insertions(+), 23 deletions(-) diff --git a/csp/csp.rkt b/csp/csp.rkt index 26c40a59..344c4111 100644 --- a/csp/csp.rkt +++ b/csp/csp.rkt @@ -34,31 +34,38 @@ (define/contract (add-constraint! csp proc var-names) ($csp? procedure? (listof $var-name?) . -> . void?) (for ([name (in-list var-names)]) - (check-name-in-csp! 'add-constraint! csp name)) + (check-name-in-csp! 'add-constraint! csp name)) (set-$csp-constraints! csp (cons ($constraint var-names proc) ($csp-constraints csp)))) -(define/contract (apply-unary-constraint csp constraint) - ($csp? unary-constraint? . -> . $csp?) - (match-define ($constraint (list constraint-name) proc) constraint) - (check-has-solutions! - ($csp (for/list ([var (in-list ($csp-vars csp))]) - (match-define ($var name vals) var) - (if (eq? name constraint-name) - ($var name (filter proc vals)) - var)) - ;; once the constraint is applied, it can go away - (remove constraint ($csp-constraints csp))))) (define/contract (no-solutions? csp) ($csp? . -> . boolean?) (for/or ([var (in-list ($csp-vars csp))]) - (empty? ($var-vals var)))) + (empty? ($var-vals var)))) (define/contract (check-has-solutions! csp) ($csp? . -> . $csp?) (when (no-solutions? csp) (raise 'no-solutions)) csp) +(struct $no-solutions () #:transparent) + +(define/contract (apply-unary-constraint csp constraint) + ($csp? unary-constraint? . -> . $csp?) + (match-define ($constraint (list constraint-name) proc) constraint) + (define new-csp ($csp (for/list ([var (in-list ($csp-vars csp))]) + (match-define ($var name vals) var) + (if (eq? name constraint-name) + ($var name (cond + [(promise? proc) (force proc)] + [else (filter proc vals)])) + var)) + ;; once the constraint is applied, it can go away + (remove constraint ($csp-constraints csp)))) + (when (no-solutions? new-csp) (raise ($no-solutions))) + new-csp) + + (define/contract (make-node-consistent csp) ($csp? . -> . $csp?) (for/fold ([csp csp]) @@ -71,7 +78,7 @@ (check-name-in-csp! '$csp-vals csp name) (for/first ([var (in-list ($csp-vars csp))] #:when (eq? name ($var-name var))) - ($var-vals var))) + ($var-vals var))) (struct $arc (name constraint) #:transparent) @@ -84,7 +91,7 @@ (λ (val other-val) (constraint-proc other-val val)))) ; otherwise reverse arg order (define (satisfies-arc? val) (for/or ([other-val (in-list ($csp-vals csp other-name))]) - (proc val other-val))) + (proc val other-val))) (apply-unary-constraint csp ($constraint (list name) (procedure-rename satisfies-arc? @@ -94,16 +101,13 @@ ((listof binary-constraint?) . -> . (listof $arc?)) (for*/list ([constraint (in-list constraints)] [name (in-list ($constraint-names constraint))]) - ($arc name constraint))) + ($arc name constraint))) (define/contract (terminating-at arcs name) ((listof $arc?) $var-name? . -> . (listof $arc?)) - ;; #true if name is in constraint name list and is not name of arc (for/list ([arc (in-list arcs)] - #:when (and - (not (eq? name ($arc-name arc))) - (memq name ($constraint-names ($arc-constraint arc))))) - arc)) + #:when (eq? name (second ($constraint-names ($arc-constraint arc))))) + arc)) (define/contract (ac-3 csp) ($csp? . -> . $csp?) @@ -129,10 +133,71 @@ ;; has values in their domain that satisfy every binary constraint (ac-3 csp)) +(define/contract (var-assigned? var) + ($var? . -> . boolean?) + (= 1 (length ($var-vals var)))) + +(define/contract (assignment-complete? csp) + ($csp? . -> . boolean?) + (andmap var-assigned? ($csp-vars csp))) + +(define/contract (unassigned-vars csp) + ($csp? . -> . (listof $var?)) + (filter-not var-assigned? ($csp-vars csp))) + +(define/contract (select-unassigned-var csp) + ($csp? . -> . $var?) + ;; minimum remaining values (MRV) rule + (argmin (λ (var) (length ($var-vals var))) (unassigned-vars csp))) + +(define/contract (order-domain-values vals) + ((listof any/c) . -> . (listof any/c)) + ;; todo: least constraining value sort + vals) + +;; todo: inferences between assignments +(define inference values) + +(define/contract (assign-val csp name val) + ($csp? $var-name? any/c . -> . $csp?) + (apply-unary-constraint csp ($constraint (list name) (delay (list val))))) + +(define/contract (assignment-consistent? csp name) + ($csp? $var-name? . -> . boolean?) + (define assigned-names (for/list ([var (in-list ($csp-vars csp))] + #:when (= 1 (length ($var-vals var)))) + ($var-name var))) + (define constraints-to-check + (for/list ([constraint (in-list ($csp-constraints csp))] + #:when (match-let ([($constraint constraint-names _) constraint]) + (and + (memq name constraint-names) + (for/and ([constraint-name (in-list constraint-names)]) + (memq constraint-name assigned-names))))) + constraint)) + ;; todo: remove constraints after testing and return reduced csp instead of boolean + (for/and ([constraint (in-list constraints-to-check)]) + (match-define ($constraint names pred) constraint) + (apply pred (for/list ([name (in-list names)]) + (car ($csp-vals csp name)))))) + + +(define/contract (backtrack csp) + ($csp? . -> . $csp?) + (cond + [(assignment-complete? csp) csp] + [(match-let ([($var name vals) (select-unassigned-var csp)]) + (for/or ([val (in-list (order-domain-values vals))]) + (with-handlers ([$no-solutions? (λ (exn) #f)]) + (define new-csp (assign-val csp name val)) + (and (assignment-consistent? new-csp name) + (backtrack (inference new-csp))))))] + [else (raise ($no-solutions))])) + + (define/contract (solve csp) ($csp? . -> . any/c) - ;; todo: backtracking search - ($csp-vars (make-arc-consistent (make-node-consistent csp)))) + (backtrack (make-arc-consistent (make-node-consistent csp)))) (define csp ($csp empty empty)) From 5216a955c576387c34310d27f9dfaa21d42afe40 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Wed, 10 Oct 2018 16:33:10 -0700 Subject: [PATCH 087/246] more --- csp/csp.rkt | 126 ++++++++++++++++++++++----------------------------- csp/test.rkt | 47 +++++++++++++++++++ 2 files changed, 102 insertions(+), 71 deletions(-) create mode 100644 csp/test.rkt diff --git a/csp/csp.rkt b/csp/csp.rkt index 344c4111..17976f9b 100644 --- a/csp/csp.rkt +++ b/csp/csp.rkt @@ -1,11 +1,25 @@ #lang debug racket - +(provide (all-defined-out)) (struct $csp ([vars #:mutable] [constraints #:mutable]) #:transparent) +(define (new-csp) ($csp null null)) + (struct $var (name vals) #:transparent) (define $var-name? symbol?) -(struct $constraint (names proc) #:transparent) +(struct $constraint (names proc) #:transparent + #:property prop:procedure + (λ (constraint csp) + (unless ($csp? csp) + (raise-argument-error '$constraint-proc "$csp" csp)) + (match-define ($constraint names proc) constraint) + (cond + [(empty? names) (proc)] + [else + (match-define (cons name other-names) names) + (for/and ([val (in-list ($csp-vals csp name))]) + ;; todo: reconsider efficiency of currying every value + (($constraint other-names (curry proc val)) csp))]))) (define/contract (check-name-in-csp! caller csp name) (symbol? $csp? $var-name? . -> . void?) @@ -13,9 +27,9 @@ (unless (memq name names) (raise-argument-error caller (format "csp variable name: ~v" names) name))) -(define/contract (nary-constraint? constraint num) +(define/contract (nary-constraint? constraint n) ($constraint? exact-nonnegative-integer? . -> . boolean?) - (= num (length ($constraint-names constraint)))) + (= n (length ($constraint-names constraint)))) (define/contract (unary-constraint? constraint) ($constraint? . -> . boolean?) @@ -31,24 +45,18 @@ (raise-argument-error 'add-var! "var that doesn't exist" name)) (set-$csp-vars! csp (cons ($var name vals) ($csp-vars csp)))) -(define/contract (add-constraint! csp proc var-names) - ($csp? procedure? (listof $var-name?) . -> . void?) +(define/contract (add-constraint! csp proc . var-names) + (($csp? procedure?) #:rest (listof $var-name?) . ->* . void?) (for ([name (in-list var-names)]) (check-name-in-csp! 'add-constraint! csp name)) (set-$csp-constraints! csp (cons ($constraint var-names proc) ($csp-constraints csp)))) - (define/contract (no-solutions? csp) ($csp? . -> . boolean?) (for/or ([var (in-list ($csp-vars csp))]) (empty? ($var-vals var)))) -(define/contract (check-has-solutions! csp) - ($csp? . -> . $csp?) - (when (no-solutions? csp) (raise 'no-solutions)) - csp) - -(struct $no-solutions () #:transparent) +(struct $csp-inconsistent () #:transparent) (define/contract (apply-unary-constraint csp constraint) ($csp? unary-constraint? . -> . $csp?) @@ -56,16 +64,15 @@ (define new-csp ($csp (for/list ([var (in-list ($csp-vars csp))]) (match-define ($var name vals) var) (if (eq? name constraint-name) - ($var name (cond - [(promise? proc) (force proc)] - [else (filter proc vals)])) + ($var name (if (promise? proc) + (force proc) + (filter proc vals))) var)) ;; once the constraint is applied, it can go away (remove constraint ($csp-constraints csp)))) - (when (no-solutions? new-csp) (raise ($no-solutions))) + (when (no-solutions? new-csp) (raise ($csp-inconsistent))) new-csp) - (define/contract (make-node-consistent csp) ($csp? . -> . $csp?) (for/fold ([csp csp]) @@ -141,9 +148,17 @@ ($csp? . -> . boolean?) (andmap var-assigned? ($csp-vars csp))) +(define (assigned-helper csp) (partition var-assigned? ($csp-vars csp))) + (define/contract (unassigned-vars csp) ($csp? . -> . (listof $var?)) - (filter-not var-assigned? ($csp-vars csp))) + (match-define-values (assigned unassigned) (assigned-helper csp)) + unassigned) + +(define/contract (assigned-vars csp) + ($csp? . -> . (listof $var?)) + (match-define-values (assigned unassigned) (assigned-helper csp)) + assigned) (define/contract (select-unassigned-var csp) ($csp? . -> . $var?) @@ -156,30 +171,23 @@ vals) ;; todo: inferences between assignments -(define inference values) +(define infer values) (define/contract (assign-val csp name val) ($csp? $var-name? any/c . -> . $csp?) - (apply-unary-constraint csp ($constraint (list name) (delay (list val))))) - -(define/contract (assignment-consistent? csp name) - ($csp? $var-name? . -> . boolean?) - (define assigned-names (for/list ([var (in-list ($csp-vars csp))] - #:when (= 1 (length ($var-vals var)))) - ($var-name var))) - (define constraints-to-check - (for/list ([constraint (in-list ($csp-constraints csp))] - #:when (match-let ([($constraint constraint-names _) constraint]) - (and - (memq name constraint-names) - (for/and ([constraint-name (in-list constraint-names)]) - (memq constraint-name assigned-names))))) - constraint)) - ;; todo: remove constraints after testing and return reduced csp instead of boolean - (for/and ([constraint (in-list constraints-to-check)]) - (match-define ($constraint names pred) constraint) - (apply pred (for/list ([name (in-list names)]) - (car ($csp-vals csp name)))))) + (validate-assignment (apply-unary-constraint csp ($constraint (list name) (delay (list val)))) name)) + +(define/contract (validate-assignment csp name) + ($csp? $var-name? . -> . $csp?) + (define assigned-names (map $var-name (assigned-vars csp))) + (for/fold ([csp csp]) + ([constraint (in-list ($csp-constraints csp))] + #:when (match-let ([($constraint cnames _) constraint]) + (and (memq name cnames) + (for/and ([cname (in-list cnames)]) + (memq cname assigned-names))))) + (unless (constraint csp) (raise ($csp-inconsistent))) + ($csp ($csp-vars csp) (remove constraint ($csp-constraints csp))))) (define/contract (backtrack csp) @@ -188,39 +196,15 @@ [(assignment-complete? csp) csp] [(match-let ([($var name vals) (select-unassigned-var csp)]) (for/or ([val (in-list (order-domain-values vals))]) - (with-handlers ([$no-solutions? (λ (exn) #f)]) - (define new-csp (assign-val csp name val)) - (and (assignment-consistent? new-csp name) - (backtrack (inference new-csp))))))] - [else (raise ($no-solutions))])) + (with-handlers ([$csp-inconsistent? (λ (exn) #f)]) + (backtrack (infer (assign-val csp name val))))))] + [else (raise ($csp-inconsistent))])) - (define/contract (solve csp) ($csp? . -> . any/c) (backtrack (make-arc-consistent (make-node-consistent csp)))) - -(define csp ($csp empty empty)) - -(define digits (range 7)) -(add-var! csp 't digits) -(add-var! csp 'w digits) -(add-var! csp 'o '(2 6 7)) - -(define (sum-three t w o) (= 3 (+ t w o))) -(add-constraint! csp sum-three '(t w o)) - -(define diff (compose1 not =)) -(add-constraint! csp diff '(t w)) -(add-constraint! csp diff '(w o)) -(add-constraint! csp diff '(t o)) - -(add-constraint! csp < '(t w)) - -(define three-or-less (curryr <= 3)) -(add-constraint! csp three-or-less '(t)) -(add-constraint! csp three-or-less '(w)) -(add-constraint! csp three-or-less '(o)) - -csp -(solve csp) \ No newline at end of file +(define/contract (alldiff . xs) + (() #:rest (listof any/c) . ->* . boolean?) + (for*/and ([comb (in-combinations xs 2)]) + (not (apply equal? comb)))) diff --git a/csp/test.rkt b/csp/test.rkt new file mode 100644 index 00000000..c96495ff --- /dev/null +++ b/csp/test.rkt @@ -0,0 +1,47 @@ +#lang racket +(require "csp.rkt" rackunit) + +(let ([demo (new-csp)]) + (define digits (range 7)) + (add-var! demo 't digits) + (add-var! demo 'w digits) + (add-var! demo 'o '(2 6 7)) + + (define (sum-three t w o) (= 3 (+ t w o))) + (add-constraint! demo sum-three 't 'w 'o) + + (define diff (compose1 not =)) + (add-constraint! demo diff 't 'w) + (add-constraint! demo diff 'w 'o) + (add-constraint! demo diff 't 'o) + + (add-constraint! demo < 't 'w) + + (define three-or-less (curryr <= 3)) + (add-constraint! demo three-or-less 't) + (add-constraint! demo three-or-less 'w) + (add-constraint! demo three-or-less 'o) + (check-equal? (solve demo) ($csp (list ($var 'o '(2)) ($var 'w '(1)) ($var 't '(0))) '()))) + +(define ttf (new-csp)) +(define digs (range 10)) +(add-var! ttf 't digs) +(add-var! ttf 'w digs) +(add-var! ttf 'o digs) +(add-var! ttf 'f digs) +(add-var! ttf 'u digs) +(add-var! ttf 'r digs) + +(add-var! ttf 'c10 digs) +(add-var! ttf 'c100 digs) +(add-var! ttf 'c1000 digs) + +(add-constraint! ttf alldiff 't 'w 'o 'f 'u 'r) +(define (adder arg1 arg2 ones-digit tens-digit) (= (+ arg1 arg2) (+ (* 10 tens-digit) ones-digit))) +(add-constraint! ttf adder 'o 'o 'r 'c10) +(add-constraint! ttf adder 'w 'w 'u 'c100) +(add-constraint! ttf adder 't 't 'o 'c1000) +(add-constraint! ttf positive? 'f) +(add-constraint! ttf = 'f 'c1000) + +(check-equal? (solve ttf) ($csp (list ($var 'c1000 '(1)) ($var 'c100 '(0)) ($var 'c10 '(0)) ($var 'r '(8)) ($var 'u '(6)) ($var 'f '(1)) ($var 'o '(4)) ($var 'w '(3)) ($var 't '(7))) '())) From 686514dfb20f41877bbcd46f14d159eec1c267b7 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Wed, 10 Oct 2018 17:48:21 -0700 Subject: [PATCH 088/246] still --- csp/csp.rkt | 18 ++++++++++++------ csp/test.rkt | 25 +++++++++++++++++++++++-- 2 files changed, 35 insertions(+), 8 deletions(-) diff --git a/csp/csp.rkt b/csp/csp.rkt index 17976f9b..ff9d25cc 100644 --- a/csp/csp.rkt +++ b/csp/csp.rkt @@ -45,6 +45,9 @@ (raise-argument-error 'add-var! "var that doesn't exist" name)) (set-$csp-vars! csp (cons ($var name vals) ($csp-vars csp)))) +(define (unique-varnames? xs) + (and (andmap $var-name? xs) (not (check-duplicates xs eq?)))) + (define/contract (add-constraint! csp proc . var-names) (($csp? procedure?) #:rest (listof $var-name?) . ->* . void?) (for ([name (in-list var-names)]) @@ -73,7 +76,7 @@ (when (no-solutions? new-csp) (raise ($csp-inconsistent))) new-csp) -(define/contract (make-node-consistent csp) +(define/contract (make-nodes-consistent csp) ($csp? . -> . $csp?) (for/fold ([csp csp]) ([constraint (in-list ($csp-constraints csp))] @@ -134,7 +137,7 @@ ;; revision reduced the domain, so supplement the list of arcs (remove-duplicates (append (all-arcs . terminating-at . name) other-arcs)))))) -(define/contract (make-arc-consistent csp) +(define/contract (make-arcs-consistent csp) ($csp? . -> . $csp?) ;; csp is arc-consistent if every pair of variables (x y) ;; has values in their domain that satisfy every binary constraint @@ -200,11 +203,14 @@ (backtrack (infer (assign-val csp name val))))))] [else (raise ($csp-inconsistent))])) -(define/contract (solve csp) - ($csp? . -> . any/c) - (backtrack (make-arc-consistent (make-node-consistent csp)))) +(define/contract (solve csp [finish-proc values]) + (($csp?) (procedure?) . ->* . any/c) + (finish-proc (backtrack (make-arcs-consistent (make-nodes-consistent csp))))) + +(define ($csp-ref csp name) + (car ($csp-vals csp name))) (define/contract (alldiff . xs) (() #:rest (listof any/c) . ->* . boolean?) - (for*/and ([comb (in-combinations xs 2)]) + (for/and ([comb (in-combinations xs 2)]) (not (apply equal? comb)))) diff --git a/csp/test.rkt b/csp/test.rkt index c96495ff..af5d9171 100644 --- a/csp/test.rkt +++ b/csp/test.rkt @@ -1,4 +1,4 @@ -#lang racket +#lang at-exp racket (require "csp.rkt" rackunit) (let ([demo (new-csp)]) @@ -23,6 +23,8 @@ (add-constraint! demo three-or-less 'o) (check-equal? (solve demo) ($csp (list ($var 'o '(2)) ($var 'w '(1)) ($var 't '(0))) '()))) + +;; TWO + TWO = FOUR (define ttf (new-csp)) (define digs (range 10)) (add-var! ttf 't digs) @@ -44,4 +46,23 @@ (add-constraint! ttf positive? 'f) (add-constraint! ttf = 'f 'c1000) -(check-equal? (solve ttf) ($csp (list ($var 'c1000 '(1)) ($var 'c100 '(0)) ($var 'c10 '(0)) ($var 'r '(8)) ($var 'u '(6)) ($var 'f '(1)) ($var 'o '(4)) ($var 'w '(3)) ($var 't '(7))) '())) + +(define ttf-solution (solve ttf)) +(check-equal? ttf-solution + ($csp + (list + ($var 'c1000 '(1)) + ($var 'c100 '(0)) + ($var 'c10 '(0)) + ($var 'r '(8)) + ($var 'u '(6)) + ($var 'f '(1)) + ($var 'o '(4)) + ($var 'w '(3)) + ($var 't '(7))) + '())) + +(define (ttf-print csp) + (format "~a~a~a + ~a~a~a = ~a~a~a~a" ($csp-ref csp 't) ($csp-ref csp 'w) ($csp-ref csp 'o) ($csp-ref csp 't) ($csp-ref csp 'w) ($csp-ref csp 'o) ($csp-ref csp 'f) ($csp-ref csp 'o) ($csp-ref csp 'u) ($csp-ref csp 'r))) + +(check-equal? (solve ttf-solution ttf-print) "734 + 734 = 1468") From dd0aa8a6555f83415f9bfbeb2f48959f117e290d Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Wed, 10 Oct 2018 21:15:54 -0700 Subject: [PATCH 089/246] gen --- csp/csp.rkt | 18 ++++++++----- csp/test.rkt | 74 ++++++++++++++++++++++++---------------------------- 2 files changed, 46 insertions(+), 46 deletions(-) diff --git a/csp/csp.rkt b/csp/csp.rkt index ff9d25cc..807ac685 100644 --- a/csp/csp.rkt +++ b/csp/csp.rkt @@ -3,7 +3,7 @@ (struct $csp ([vars #:mutable] [constraints #:mutable]) #:transparent) -(define (new-csp) ($csp null null)) +(define (make-csp) ($csp null null)) (struct $var (name vals) #:transparent) (define $var-name? symbol?) @@ -41,15 +41,21 @@ (define/contract (add-var! csp name [vals empty]) (($csp? $var-name?) ((listof any/c)) . ->* . void?) - (when (memq name (map $var-name ($csp-vars csp))) + (add-vars! csp (list name) vals)) + +(define/contract (add-vars! csp names [vals empty]) + (($csp? (listof $var-name?)) ((listof any/c)) . ->* . void?) + (for ([name (in-list names)] + #:when (memq name (map $var-name ($csp-vars csp)))) (raise-argument-error 'add-var! "var that doesn't exist" name)) - (set-$csp-vars! csp (cons ($var name vals) ($csp-vars csp)))) + (for ([name (in-list names)]) + (set-$csp-vars! csp (cons ($var name vals) ($csp-vars csp))))) (define (unique-varnames? xs) (and (andmap $var-name? xs) (not (check-duplicates xs eq?)))) -(define/contract (add-constraint! csp proc . var-names) - (($csp? procedure?) #:rest (listof $var-name?) . ->* . void?) +(define/contract (add-constraint! csp proc var-names) + ($csp? procedure? (listof $var-name?) . -> . void?) (for ([name (in-list var-names)]) (check-name-in-csp! 'add-constraint! csp name)) (set-$csp-constraints! csp (cons ($constraint var-names proc) ($csp-constraints csp)))) @@ -213,4 +219,4 @@ (define/contract (alldiff . xs) (() #:rest (listof any/c) . ->* . boolean?) (for/and ([comb (in-combinations xs 2)]) - (not (apply equal? comb)))) + (not (apply equal? comb)))) diff --git a/csp/test.rkt b/csp/test.rkt index af5d9171..5d9a1fc1 100644 --- a/csp/test.rkt +++ b/csp/test.rkt @@ -1,57 +1,34 @@ #lang at-exp racket (require "csp.rkt" rackunit) -(let ([demo (new-csp)]) - (define digits (range 7)) - (add-var! demo 't digits) - (add-var! demo 'w digits) - (add-var! demo 'o '(2 6 7)) +(define demo (make-csp)) +(add-vars! demo '(t w) (range 7)) +(add-var! demo 'o '(2 6 7)) - (define (sum-three t w o) (= 3 (+ t w o))) - (add-constraint! demo sum-three 't 'w 'o) +(define (sum-three t w o) (= 3 (+ t w o))) +(add-constraint! demo sum-three '(t w o)) +(add-constraint! demo alldiff '(t w o)) +(add-constraint! demo < '(t w o)) - (define diff (compose1 not =)) - (add-constraint! demo diff 't 'w) - (add-constraint! demo diff 'w 'o) - (add-constraint! demo diff 't 'o) - - (add-constraint! demo < 't 'w) - - (define three-or-less (curryr <= 3)) - (add-constraint! demo three-or-less 't) - (add-constraint! demo three-or-less 'w) - (add-constraint! demo three-or-less 'o) - (check-equal? (solve demo) ($csp (list ($var 'o '(2)) ($var 'w '(1)) ($var 't '(0))) '()))) +(check-equal? (solve demo) ($csp (list ($var 'o '(2)) ($var 'w '(1)) ($var 't '(0))) '())) ;; TWO + TWO = FOUR -(define ttf (new-csp)) -(define digs (range 10)) -(add-var! ttf 't digs) -(add-var! ttf 'w digs) -(add-var! ttf 'o digs) -(add-var! ttf 'f digs) -(add-var! ttf 'u digs) -(add-var! ttf 'r digs) - -(add-var! ttf 'c10 digs) -(add-var! ttf 'c100 digs) -(add-var! ttf 'c1000 digs) - -(add-constraint! ttf alldiff 't 'w 'o 'f 'u 'r) -(define (adder arg1 arg2 ones-digit tens-digit) (= (+ arg1 arg2) (+ (* 10 tens-digit) ones-digit))) -(add-constraint! ttf adder 'o 'o 'r 'c10) -(add-constraint! ttf adder 'w 'w 'u 'c100) -(add-constraint! ttf adder 't 't 'o 'c1000) -(add-constraint! ttf positive? 'f) -(add-constraint! ttf = 'f 'c1000) +(define ttf (make-csp)) +(add-vars! ttf '(t w o f u r c10 c100) (range 10)) +(add-constraint! ttf alldiff '(t w o f u r)) +(define (adder arg1 arg2 ones-digit tens-digit) + (= (+ arg1 arg2) (+ (* 10 tens-digit) ones-digit))) +(add-constraint! ttf adder '(o o r c10)) +(add-constraint! ttf adder '(w w u c100)) +(add-constraint! ttf adder '(t t o f)) +(add-constraint! ttf positive? '(f)) (define ttf-solution (solve ttf)) (check-equal? ttf-solution ($csp (list - ($var 'c1000 '(1)) ($var 'c100 '(0)) ($var 'c10 '(0)) ($var 'r '(8)) @@ -66,3 +43,20 @@ (format "~a~a~a + ~a~a~a = ~a~a~a~a" ($csp-ref csp 't) ($csp-ref csp 'w) ($csp-ref csp 'o) ($csp-ref csp 't) ($csp-ref csp 'w) ($csp-ref csp 'o) ($csp-ref csp 'f) ($csp-ref csp 'o) ($csp-ref csp 'u) ($csp-ref csp 'r))) (check-equal? (solve ttf-solution ttf-print) "734 + 734 = 1468") + + +;; ABC problem: +;; what is the minimum value of +;; ABC +;; ------- +;; A+B+C + +(define abc (make-csp)) +(add-vars! abc '(a b c) (range 1 10)) +(define (test-solution s) (let ([a (car ($csp-vals abc 'a))] + [b (car ($csp-vals abc 'b))] + [c (car ($csp-vals abc 'c))]) + (/ (+ (* 100 a) (* 10 b) c) (+ a b c)))) + +;; todo: gather all solutins in generator +(test-solution (solve abc)) \ No newline at end of file From f769d4cbbc252f2b5dd9c2c6eb494b4e8768ca15 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Thu, 11 Oct 2018 08:39:59 -0700 Subject: [PATCH 090/246] gen --- csp/csp.rkt | 14 +++++++++++++- csp/test.rkt | 22 ++++++++++++++++------ 2 files changed, 29 insertions(+), 7 deletions(-) diff --git a/csp/csp.rkt b/csp/csp.rkt index 807ac685..4cb60a81 100644 --- a/csp/csp.rkt +++ b/csp/csp.rkt @@ -197,7 +197,6 @@ (memq cname assigned-names))))) (unless (constraint csp) (raise ($csp-inconsistent))) ($csp ($csp-vars csp) (remove constraint ($csp-constraints csp))))) - (define/contract (backtrack csp) ($csp? . -> . $csp?) @@ -213,6 +212,19 @@ (($csp?) (procedure?) . ->* . any/c) (finish-proc (backtrack (make-arcs-consistent (make-nodes-consistent csp))))) +(require racket/generator) +(define/contract (backtrack-solver csp) + ($csp? . -> . generator?) + (generator () + (let loop ([csp csp]) + (cond + [(assignment-complete? csp) (yield csp)] + [else + (match-define ($var name vals) (select-unassigned-var csp)) + (for ([val (in-list (order-domain-values vals))]) + (with-handlers ([$csp-inconsistent? (λ (exn) #f)]) + (loop (infer (assign-val csp name val)))))])))) + (define ($csp-ref csp name) (car ($csp-vals csp name))) diff --git a/csp/test.rkt b/csp/test.rkt index 5d9a1fc1..7ee0304b 100644 --- a/csp/test.rkt +++ b/csp/test.rkt @@ -52,11 +52,21 @@ ;; A+B+C (define abc (make-csp)) -(add-vars! abc '(a b c) (range 1 10)) -(define (test-solution s) (let ([a (car ($csp-vals abc 'a))] - [b (car ($csp-vals abc 'b))] - [c (car ($csp-vals abc 'c))]) - (/ (+ (* 100 a) (* 10 b) c) (+ a b c)))) +(add-vars! abc '(a b c) (range 1 3)) +(define (test-solution abc) + (let ([a ($csp-ref abc 'a)] + [b ($csp-ref abc 'b)] + [c ($csp-ref abc 'c)]) + (/ (+ (* 100 a) (* 10 b) c) (+ a b c)))) + ;; todo: gather all solutins in generator -(test-solution (solve abc)) \ No newline at end of file +(define bs (backtrack-solver abc)) +(bs) +(bs) +(bs) +(bs) +(bs) +(bs) +(bs) +(bs) \ No newline at end of file From 8af1407e12abe64e8c7b6d502ca7731a86ec8d12 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Thu, 11 Oct 2018 09:03:21 -0700 Subject: [PATCH 091/246] more --- csp/csp.rkt | 39 ++++++++++++++++++++++----------------- csp/test.rkt | 18 +++++------------- 2 files changed, 27 insertions(+), 30 deletions(-) diff --git a/csp/csp.rkt b/csp/csp.rkt index 4cb60a81..6515f2ae 100644 --- a/csp/csp.rkt +++ b/csp/csp.rkt @@ -1,4 +1,5 @@ #lang debug racket +(require racket/generator) (provide (all-defined-out)) (struct $csp ([vars #:mutable] [constraints #:mutable]) #:transparent) @@ -198,32 +199,36 @@ (unless (constraint csp) (raise ($csp-inconsistent))) ($csp ($csp-vars csp) (remove constraint ($csp-constraints csp))))) -(define/contract (backtrack csp) - ($csp? . -> . $csp?) - (cond - [(assignment-complete? csp) csp] - [(match-let ([($var name vals) (select-unassigned-var csp)]) - (for/or ([val (in-list (order-domain-values vals))]) - (with-handlers ([$csp-inconsistent? (λ (exn) #f)]) - (backtrack (infer (assign-val csp name val))))))] - [else (raise ($csp-inconsistent))])) - -(define/contract (solve csp [finish-proc values]) - (($csp?) (procedure?) . ->* . any/c) - (finish-proc (backtrack (make-arcs-consistent (make-nodes-consistent csp))))) - -(require racket/generator) +(define gen-stop-val (gensym)) (define/contract (backtrack-solver csp) ($csp? . -> . generator?) (generator () - (let loop ([csp csp]) + (let backtrack ([csp csp]) (cond [(assignment-complete? csp) (yield csp)] [else (match-define ($var name vals) (select-unassigned-var csp)) (for ([val (in-list (order-domain-values vals))]) (with-handlers ([$csp-inconsistent? (λ (exn) #f)]) - (loop (infer (assign-val csp name val)))))])))) + (backtrack (infer (assign-val csp name val))))) + gen-stop-val])))) + +(define (make-backtrack-iterator csp) + (backtrack-solver (make-arcs-consistent (make-nodes-consistent csp)))) + +(define/contract (solve csp [finish-proc values]) + (($csp?) (procedure?) . ->* . any/c) + (or + (for/first ([solution (in-producer (make-backtrack-iterator csp) gen-stop-val)]) + (finish-proc solution)) + (raise ($csp-inconsistent)))) + +(define/contract (solve* csp [finish-proc values]) + (($csp?) (procedure?) . ->* . (listof any/c)) + (define solutions (for/list ([solution (in-producer (make-backtrack-iterator csp) gen-stop-val)]) + (finish-proc solution))) + (when (empty? solutions) (raise ($csp-inconsistent))) + solutions) (define ($csp-ref csp name) (car ($csp-vals csp name))) diff --git a/csp/test.rkt b/csp/test.rkt index 7ee0304b..7f3bef70 100644 --- a/csp/test.rkt +++ b/csp/test.rkt @@ -52,21 +52,13 @@ ;; A+B+C (define abc (make-csp)) -(add-vars! abc '(a b c) (range 1 3)) -(define (test-solution abc) +(add-vars! abc '(a b c) (range 1 10)) +(define (solution-score abc) (let ([a ($csp-ref abc 'a)] [b ($csp-ref abc 'b)] [c ($csp-ref abc 'c)]) (/ (+ (* 100 a) (* 10 b) c) (+ a b c)))) - -;; todo: gather all solutins in generator -(define bs (backtrack-solver abc)) -(bs) -(bs) -(bs) -(bs) -(bs) -(bs) -(bs) -(bs) \ No newline at end of file +(check-equal? + (argmin solution-score (solve* abc)) + ($csp (list ($var 'c '(9)) ($var 'b '(9)) ($var 'a '(1))) '())) \ No newline at end of file From 78dfe65b983feab2ed22f394d54afb8276515f9b Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Thu, 11 Oct 2018 14:37:21 -0700 Subject: [PATCH 092/246] more probs --- csp/csp.rkt | 64 ++++++++++++++++-------- csp/test.rkt | 138 ++++++++++++++++++++++++++++++++++++++++++++------- 2 files changed, 162 insertions(+), 40 deletions(-) diff --git a/csp/csp.rkt b/csp/csp.rkt index 6515f2ae..de1bb04c 100644 --- a/csp/csp.rkt +++ b/csp/csp.rkt @@ -126,13 +126,30 @@ #:when (eq? name (second ($constraint-names ($arc-constraint arc))))) arc)) +(define/contract (constraint-names-assigned? csp constraint) + ($csp? $constraint? . -> . boolean?) + (define assigned-var-names + (for/list ([var (in-list (assigned-vars csp))]) + ($var-name var))) + (match-define ($constraint names _) constraint) + (for/and ([name (in-list names)]) + (memq name assigned-var-names))) + +(define/contract (remove-obsolete-constraints csp) + ($csp? . -> . $csp?) + ($csp + ($csp-vars csp) + (for/list ([constraint (in-list ($csp-constraints csp))] + #:unless (constraint-names-assigned? csp constraint)) + constraint))) + (define/contract (ac-3 csp) ($csp? . -> . $csp?) ;; as described by AIMA @ 265 (define all-arcs (binary-constraints->arcs (filter binary-constraint? ($csp-constraints csp)))) (for/fold ([csp csp] [arcs all-arcs] - #:result csp) + #:result (remove-obsolete-constraints csp)) ([i (in-naturals)] #:break (empty? arcs)) (match-define (cons arc other-arcs) arcs) @@ -173,7 +190,10 @@ (define/contract (select-unassigned-var csp) ($csp? . -> . $var?) ;; minimum remaining values (MRV) rule - (argmin (λ (var) (length ($var-vals var))) (unassigned-vars csp))) + (define uvars (unassigned-vars csp)) + (when (empty? uvars) + (raise-argument-error 'select-unassigned-var "nonempty list of vars" uvars)) + (argmin (λ (var) (length ($var-vals var))) uvars)) (define/contract (order-domain-values vals) ((listof any/c) . -> . (listof any/c)) @@ -197,43 +217,45 @@ (for/and ([cname (in-list cnames)]) (memq cname assigned-names))))) (unless (constraint csp) (raise ($csp-inconsistent))) - ($csp ($csp-vars csp) (remove constraint ($csp-constraints csp))))) + (remove-obsolete-constraints csp))) -(define gen-stop-val (gensym)) -(define/contract (backtrack-solver csp) +(define solver-stop-val (gensym 'solver-stop)) +(define/contract (backtracking-solution-generator csp) ($csp? . -> . generator?) (generator () - (let backtrack ([csp csp]) - (cond - [(assignment-complete? csp) (yield csp)] - [else - (match-define ($var name vals) (select-unassigned-var csp)) - (for ([val (in-list (order-domain-values vals))]) - (with-handlers ([$csp-inconsistent? (λ (exn) #f)]) - (backtrack (infer (assign-val csp name val))))) - gen-stop-val])))) - -(define (make-backtrack-iterator csp) - (backtrack-solver (make-arcs-consistent (make-nodes-consistent csp)))) + (begin0 + solver-stop-val + (let backtrack ([csp csp]) + (cond + [(assignment-complete? csp) (yield csp)] + [else ;; we have at least 1 unassigned var + (match-define ($var name vals) (select-unassigned-var csp)) + (for ([val (in-list (order-domain-values vals))]) + (with-handlers ([$csp-inconsistent? (const #f)]) + (backtrack (infer (assign-val csp name val)))))]))))) + +(define (backtracking-solver csp) + (backtracking-solution-generator (make-arcs-consistent (make-nodes-consistent csp)))) (define/contract (solve csp [finish-proc values]) (($csp?) (procedure?) . ->* . any/c) (or - (for/first ([solution (in-producer (make-backtrack-iterator csp) gen-stop-val)]) + (for/first ([solution (in-producer (backtracking-solver csp) solver-stop-val)]) (finish-proc solution)) (raise ($csp-inconsistent)))) (define/contract (solve* csp [finish-proc values]) (($csp?) (procedure?) . ->* . (listof any/c)) - (define solutions (for/list ([solution (in-producer (make-backtrack-iterator csp) gen-stop-val)]) + (define solutions (for/list ([solution (in-producer (backtracking-solver csp) solver-stop-val)]) (finish-proc solution))) (when (empty? solutions) (raise ($csp-inconsistent))) solutions) + (define ($csp-ref csp name) (car ($csp-vals csp name))) (define/contract (alldiff . xs) (() #:rest (listof any/c) . ->* . boolean?) - (for/and ([comb (in-combinations xs 2)]) - (not (apply equal? comb)))) + (= (length (remove-duplicates xs)) (length xs))) + diff --git a/csp/test.rkt b/csp/test.rkt index 7f3bef70..e482e9be 100644 --- a/csp/test.rkt +++ b/csp/test.rkt @@ -15,34 +15,35 @@ ;; TWO + TWO = FOUR (define ttf (make-csp)) -(add-vars! ttf '(t w o f u r c10 c100) (range 10)) +(add-vars! ttf '(t w o f u r) (range 10)) + +(define (word-value . xs) + (let ([xs (reverse xs)]) + (for/sum ([i (in-range (length xs))]) + (* (list-ref xs i) (expt 10 i))))) (add-constraint! ttf alldiff '(t w o f u r)) -(define (adder arg1 arg2 ones-digit tens-digit) - (= (+ arg1 arg2) (+ (* 10 tens-digit) ones-digit))) -(add-constraint! ttf adder '(o o r c10)) -(add-constraint! ttf adder '(w w u c100)) -(add-constraint! ttf adder '(t t o f)) +(add-constraint! ttf (λ (t w o f u r) (= (+ (word-value t w o) (word-value t w o)) + (word-value f o u r))) '(t w o f u r)) +(add-constraint! ttf positive? '(t)) (add-constraint! ttf positive? '(f)) (define ttf-solution (solve ttf)) (check-equal? ttf-solution ($csp (list - ($var 'c100 '(0)) - ($var 'c10 '(0)) - ($var 'r '(8)) - ($var 'u '(6)) + ($var 'r '(0)) + ($var 'u '(3)) ($var 'f '(1)) - ($var 'o '(4)) - ($var 'w '(3)) + ($var 'o '(5)) + ($var 'w '(6)) ($var 't '(7))) '())) (define (ttf-print csp) (format "~a~a~a + ~a~a~a = ~a~a~a~a" ($csp-ref csp 't) ($csp-ref csp 'w) ($csp-ref csp 'o) ($csp-ref csp 't) ($csp-ref csp 'w) ($csp-ref csp 'o) ($csp-ref csp 'f) ($csp-ref csp 'o) ($csp-ref csp 'u) ($csp-ref csp 'r))) -(check-equal? (solve ttf-solution ttf-print) "734 + 734 = 1468") +(check-equal? (solve ttf-solution ttf-print) "765 + 765 = 1530") ;; ABC problem: @@ -53,12 +54,111 @@ (define abc (make-csp)) (add-vars! abc '(a b c) (range 1 10)) -(define (solution-score abc) - (let ([a ($csp-ref abc 'a)] - [b ($csp-ref abc 'b)] - [c ($csp-ref abc 'c)]) +(define (solution-score sol) + (let ([a ($csp-ref sol 'a)] + [b ($csp-ref sol 'b)] + [c ($csp-ref sol 'c)]) (/ (+ (* 100 a) (* 10 b) c) (+ a b c)))) + +(define abc-sols (solve* abc)) +(check-equal? (* 9 9 9) (length abc-sols)) (check-equal? - (argmin solution-score (solve* abc)) - ($csp (list ($var 'c '(9)) ($var 'b '(9)) ($var 'a '(1))) '())) \ No newline at end of file + (argmin solution-score abc-sols) + ($csp (list ($var 'c '(9)) ($var 'b '(9)) ($var 'a '(1))) '())) + + +;; quarter problem: +;; 26 dollars and quarters +;; that add up to $17. + +(define quarter-problem (make-csp)) +(add-vars! quarter-problem '(dollars quarters) (range 26)) +(add-constraint! quarter-problem (λ (d q) (= 26 (+ d q))) '(dollars quarters)) +(add-constraint! quarter-problem (λ (d q) (= 17 (+ d (* 0.25 q)))) '(dollars quarters)) +(check-equal? (solve quarter-problem) + ($csp (list ($var 'quarters '(12)) ($var 'dollars '(14))) '())) + + +;; nickel problem +#| +A collection of 33 coins, consisting of nickels, dimes, and quarters, has a value of $3.30. If there are three times as many nickels as quarters, and one-half as many dimes as nickels, how many coins of each kind are there? +|# +(define ndq-problem (make-csp)) +(add-vars! ndq-problem '(n d q) (range 33)) +(add-constraint! ndq-problem (λ (n d q) (= 33 (+ n d q))) '(n d q)) +(add-constraint! ndq-problem (λ (n d q) (= 330 (+ (* n 5) (* d 10) (* q 25)))) '(n d q)) +(add-constraint! ndq-problem (λ (n q) (= (* 3 q) n)) '(n q)) +(add-constraint! ndq-problem (λ (d n) (= (* 2 d) n)) '(d n)) +(check-equal? (solve ndq-problem) + ($csp (list ($var 'q '(6)) ($var 'd '(9)) ($var 'n '(18))) '())) + + +;; xsum +#| +# Reorganize the following numbers in a way that each line of +# 5 numbers sum to 27. +# +# 1 6 +# 2 7 +# 3 +# 8 4 +# 9 5 +# +|# + +(define xsum-problem (make-csp)) +(add-vars! xsum-problem '(l1 l2 l3 l4 r1 r2 r3 r4 x) (range 1 10)) +(add-constraint! xsum-problem (λ (l1 l2 l3 l4 x) + (and (< l1 l2 l3 l4) + (= 27 (+ l1 l2 l3 l4 x)))) '(l1 l2 l3 l4 x)) +(add-constraint! xsum-problem (λ (r1 r2 r3 r4 x) + (and (< r1 r2 r3 r4) + (= 27 (+ r1 r2 r3 r4 x)))) '(r1 r2 r3 r4 x)) +(add-constraint! xsum-problem alldiff '(l1 l2 l3 l4 r1 r2 r3 r4 x)) + +;; todo: too slow +#;(check-equal? (length (solve* xsum-problem)) 8) + + +;; send more money problem +#| +# Assign equal values to equal letters, and different values to +# different letters, in a way that satisfies the following sum: +# +# SEND +# + MORE +# ------ +# MONEY +|# + +(define smm (make-csp)) +(add-vars! smm '(s e n d m o r y) (range 10)) +(add-constraint! smm positive? '(s)) +(add-constraint! smm positive? '(m)) +(add-constraint! smm (λ (s e n d m o r y) + (= (+ (word-value s e n d) (word-value m o r e)) + (word-value m o n e y))) '(s e n d m o r y)) +(add-constraint! smm alldiff '(s e n d m o r y)) + +;; todo: too slow +;(solve smm) + +;; queens problem +;; place queens on chessboard so they do not intersect +(define queens-problem (make-csp)) +(define queens '(q0 q1 q2 q3 q4 q5 q6 q7)) +(define rows (range 8)) +(add-vars! queens-problem queens rows) +(for* ([(qa qa-col) (in-indexed queens)] + [(qb qb-col) (in-indexed queens)] + #:when (< qa-col qb-col)) + (add-constraint! queens-problem + (λ (qa-row qb-row) + (and + (not (= (abs (- qa-row qb-row)) (abs (- qa-col qb-col)))) ; same diagonal? + (not (= qa-row qb-row)))) ; same row? + (list qa qb))) + +(check-equal? 92 (length (solve* queens-problem))) + From ca374e46a583761285d97f8548d3e656d6bd17cd Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Thu, 11 Oct 2018 16:14:29 -0700 Subject: [PATCH 093/246] simplify --- csp/csp.rkt | 168 +++++++++++++++++++++++---------------------------- csp/test.rkt | 58 +++++++++--------- 2 files changed, 105 insertions(+), 121 deletions(-) diff --git a/csp/csp.rkt b/csp/csp.rkt index de1bb04c..d8108a77 100644 --- a/csp/csp.rkt +++ b/csp/csp.rkt @@ -19,8 +19,8 @@ [else (match-define (cons name other-names) names) (for/and ([val (in-list ($csp-vals csp name))]) - ;; todo: reconsider efficiency of currying every value - (($constraint other-names (curry proc val)) csp))]))) + ;; todo: reconsider efficiency of currying every value + (($constraint other-names (curry proc val)) csp))]))) (define/contract (check-name-in-csp! caller csp name) (symbol? $csp? $var-name? . -> . void?) @@ -28,8 +28,7 @@ (unless (memq name names) (raise-argument-error caller (format "csp variable name: ~v" names) name))) -(define/contract (nary-constraint? constraint n) - ($constraint? exact-nonnegative-integer? . -> . boolean?) +(define (nary-constraint? constraint n) (= n (length ($constraint-names constraint)))) (define/contract (unary-constraint? constraint) @@ -40,31 +39,33 @@ ($constraint? . -> . boolean?) (nary-constraint? constraint 2)) -(define/contract (add-var! csp name [vals empty]) - (($csp? $var-name?) ((listof any/c)) . ->* . void?) - (add-vars! csp (list name) vals)) - -(define/contract (add-vars! csp names [vals empty]) - (($csp? (listof $var-name?)) ((listof any/c)) . ->* . void?) - (for ([name (in-list names)] - #:when (memq name (map $var-name ($csp-vars csp)))) - (raise-argument-error 'add-var! "var that doesn't exist" name)) - (for ([name (in-list names)]) - (set-$csp-vars! csp (cons ($var name vals) ($csp-vars csp))))) - -(define (unique-varnames? xs) - (and (andmap $var-name? xs) (not (check-duplicates xs eq?)))) +(define/contract (add-vars! csp names [vals-or-procedure empty]) + (($csp? (listof $var-name?)) ((or/c (listof any/c) procedure?)) . ->* . void?) + (for/fold ([vars ($csp-vars csp)] + #:result (set-$csp-vars! csp vars)) + ([name (in-list names)]) + (when (memq name (map $var-name vars)) + (raise-argument-error 'add-vars! "var that doesn't exist" name)) + (append vars + (let ([vals (if (procedure? vals-or-procedure) + (vals-or-procedure) + vals-or-procedure)]) + (list ($var name vals)))))) + +(define/contract (add-var! csp name [vals-or-procedure empty]) + (($csp? $var-name?) ((or/c (listof any/c) procedure?)) . ->* . void?) + (add-vars! csp (list name) vals-or-procedure)) (define/contract (add-constraint! csp proc var-names) ($csp? procedure? (listof $var-name?) . -> . void?) (for ([name (in-list var-names)]) - (check-name-in-csp! 'add-constraint! csp name)) - (set-$csp-constraints! csp (cons ($constraint var-names proc) ($csp-constraints csp)))) + (check-name-in-csp! 'add-constraint! csp name)) + (set-$csp-constraints! csp (append ($csp-constraints csp) (list ($constraint var-names proc))))) (define/contract (no-solutions? csp) ($csp? . -> . boolean?) (for/or ([var (in-list ($csp-vars csp))]) - (empty? ($var-vals var)))) + (empty? ($var-vals var)))) (struct $csp-inconsistent () #:transparent) @@ -72,12 +73,12 @@ ($csp? unary-constraint? . -> . $csp?) (match-define ($constraint (list constraint-name) proc) constraint) (define new-csp ($csp (for/list ([var (in-list ($csp-vars csp))]) - (match-define ($var name vals) var) - (if (eq? name constraint-name) - ($var name (if (promise? proc) - (force proc) - (filter proc vals))) - var)) + (match-define ($var name vals) var) + (if (eq? name constraint-name) + ($var name (if (promise? proc) + (force proc) + (filter proc vals))) + var)) ;; once the constraint is applied, it can go away (remove constraint ($csp-constraints csp)))) (when (no-solutions? new-csp) (raise ($csp-inconsistent))) @@ -95,11 +96,11 @@ (check-name-in-csp! '$csp-vals csp name) (for/first ([var (in-list ($csp-vars csp))] #:when (eq? name ($var-name var))) - ($var-vals var))) + ($var-vals var))) (struct $arc (name constraint) #:transparent) -(define/contract (revise csp arc) +(define/contract (reduce-domains-by-arc csp arc) ($csp? $arc? . -> . $csp?) (match-define ($arc name ($constraint names constraint-proc)) arc) (match-define (list other-name) (remove name names)) @@ -108,7 +109,7 @@ (λ (val other-val) (constraint-proc other-val val)))) ; otherwise reverse arg order (define (satisfies-arc? val) (for/or ([other-val (in-list ($csp-vals csp other-name))]) - (proc val other-val))) + (proc val other-val))) (apply-unary-constraint csp ($constraint (list name) (procedure-rename satisfies-arc? @@ -118,30 +119,26 @@ ((listof binary-constraint?) . -> . (listof $arc?)) (for*/list ([constraint (in-list constraints)] [name (in-list ($constraint-names constraint))]) - ($arc name constraint))) + ($arc name constraint))) (define/contract (terminating-at arcs name) ((listof $arc?) $var-name? . -> . (listof $arc?)) (for/list ([arc (in-list arcs)] #:when (eq? name (second ($constraint-names ($arc-constraint arc))))) - arc)) - -(define/contract (constraint-names-assigned? csp constraint) - ($csp? $constraint? . -> . boolean?) - (define assigned-var-names - (for/list ([var (in-list (assigned-vars csp))]) - ($var-name var))) - (match-define ($constraint names _) constraint) - (for/and ([name (in-list names)]) - (memq name assigned-var-names))) - -(define/contract (remove-obsolete-constraints csp) + arc)) + +(define/contract (constraint-assigned? csp constraint) + ($csp? $constraint? . -> . any/c) + (for/and ([name (in-list ($constraint-names constraint))]) + (memq name (map $var-name (assigned-vars csp))))) + +(define/contract (remove-assigned-constraints csp) ($csp? . -> . $csp?) ($csp ($csp-vars csp) (for/list ([constraint (in-list ($csp-constraints csp))] - #:unless (constraint-names-assigned? csp constraint)) - constraint))) + #:unless (constraint-assigned? csp constraint)) + constraint))) (define/contract (ac-3 csp) ($csp? . -> . $csp?) @@ -149,13 +146,13 @@ (define all-arcs (binary-constraints->arcs (filter binary-constraint? ($csp-constraints csp)))) (for/fold ([csp csp] [arcs all-arcs] - #:result (remove-obsolete-constraints csp)) + #:result (remove-assigned-constraints csp)) ([i (in-naturals)] #:break (empty? arcs)) (match-define (cons arc other-arcs) arcs) (match-define ($arc name _) arc) - (define revised-csp (revise csp arc)) - (values revised-csp (if (= (length ($csp-vals csp name)) (length ($csp-vals revised-csp name))) + (define reduced-csp (reduce-domains-by-arc csp arc)) + (values reduced-csp (if (= (length ($csp-vals csp name)) (length ($csp-vals reduced-csp name))) ;; revision did not reduce the domain, so keep going other-arcs ;; revision reduced the domain, so supplement the list of arcs @@ -189,10 +186,10 @@ (define/contract (select-unassigned-var csp) ($csp? . -> . $var?) - ;; minimum remaining values (MRV) rule (define uvars (unassigned-vars csp)) (when (empty? uvars) - (raise-argument-error 'select-unassigned-var "nonempty list of vars" uvars)) + (raise-argument-error 'select-unassigned-var "csp with unassigned vars" csp)) + ;; minimum remaining values (MRV) rule (argmin (λ (var) (length ($var-vals var))) uvars)) (define/contract (order-domain-values vals) @@ -203,57 +200,46 @@ ;; todo: inferences between assignments (define infer values) +(define/contract (constraint-has-name? constraint name) + ($constraint? $var-name? . -> . boolean?) + (and (memq name ($constraint-names constraint)) #true)) + (define/contract (assign-val csp name val) ($csp? $var-name? any/c . -> . $csp?) - (validate-assignment (apply-unary-constraint csp ($constraint (list name) (delay (list val)))) name)) - -(define/contract (validate-assignment csp name) - ($csp? $var-name? . -> . $csp?) - (define assigned-names (map $var-name (assigned-vars csp))) - (for/fold ([csp csp]) + (define csp-with-assignment (apply-unary-constraint csp ($constraint (list name) (delay (list val))))) + (for/fold ([csp csp-with-assignment]) ([constraint (in-list ($csp-constraints csp))] - #:when (match-let ([($constraint cnames _) constraint]) - (and (memq name cnames) - (for/and ([cname (in-list cnames)]) - (memq cname assigned-names))))) + #:when (and (constraint-has-name? constraint name) + (constraint-assigned? csp constraint))) (unless (constraint csp) (raise ($csp-inconsistent))) - (remove-obsolete-constraints csp))) + (remove-assigned-constraints csp))) -(define solver-stop-val (gensym 'solver-stop)) -(define/contract (backtracking-solution-generator csp) +(define/contract (backtracking-solver csp) ($csp? . -> . generator?) (generator () - (begin0 - solver-stop-val - (let backtrack ([csp csp]) - (cond - [(assignment-complete? csp) (yield csp)] - [else ;; we have at least 1 unassigned var - (match-define ($var name vals) (select-unassigned-var csp)) - (for ([val (in-list (order-domain-values vals))]) - (with-handlers ([$csp-inconsistent? (const #f)]) - (backtrack (infer (assign-val csp name val)))))]))))) - -(define (backtracking-solver csp) - (backtracking-solution-generator (make-arcs-consistent (make-nodes-consistent csp)))) - -(define/contract (solve csp [finish-proc values]) - (($csp?) (procedure?) . ->* . any/c) - (or - (for/first ([solution (in-producer (backtracking-solver csp) solver-stop-val)]) - (finish-proc solution)) - (raise ($csp-inconsistent)))) - -(define/contract (solve* csp [finish-proc values]) - (($csp?) (procedure?) . ->* . (listof any/c)) - (define solutions (for/list ([solution (in-producer (backtracking-solver csp) solver-stop-val)]) - (finish-proc solution))) - (when (empty? solutions) (raise ($csp-inconsistent))) + (let backtrack ([csp (make-arcs-consistent (make-nodes-consistent csp))]) + (cond + [(assignment-complete? csp) (yield csp)] + [else ;; we have at least 1 unassigned var + (match-define ($var name vals) (select-unassigned-var csp)) + (for ([val (in-list (order-domain-values vals))]) + (with-handlers ([$csp-inconsistent? (const #f)]) + (backtrack (infer (assign-val csp name val)))))])))) + +(define/contract (solve* csp [finish-proc values][solution-limit +inf.0]) + (($csp?) (procedure? integer?) . ->* . (listof any/c)) + (define solutions + (for/list ([solution (in-producer (backtracking-solver csp) (void))] + [idx (in-range solution-limit)]) + (finish-proc solution))) + (unless (pair? solutions) (raise ($csp-inconsistent))) solutions) +(define/contract (solve csp [finish-proc values]) + (($csp?) (procedure?) . ->* . any/c) + (first (solve* csp finish-proc 1))) -(define ($csp-ref csp name) - (car ($csp-vals csp name))) +(define ($csp-ref csp name) (car ($csp-vals csp name))) (define/contract (alldiff . xs) (() #:rest (listof any/c) . ->* . boolean?) diff --git a/csp/test.rkt b/csp/test.rkt index e482e9be..5d5a1c2b 100644 --- a/csp/test.rkt +++ b/csp/test.rkt @@ -10,17 +10,17 @@ (add-constraint! demo alldiff '(t w o)) (add-constraint! demo < '(t w o)) -(check-equal? (solve demo) ($csp (list ($var 'o '(2)) ($var 'w '(1)) ($var 't '(0))) '())) +(check-equal? (time (solve demo)) ($csp (list ($var 't '(0)) ($var 'w '(1)) ($var 'o '(2))) '())) ;; TWO + TWO = FOUR (define ttf (make-csp)) -(add-vars! ttf '(t w o f u r) (range 10)) +(add-vars! ttf '(t w o f u r) (reverse (range 10))) (define (word-value . xs) (let ([xs (reverse xs)]) (for/sum ([i (in-range (length xs))]) - (* (list-ref xs i) (expt 10 i))))) + (* (list-ref xs i) (expt 10 i))))) (add-constraint! ttf alldiff '(t w o f u r)) (add-constraint! ttf (λ (t w o f u r) (= (+ (word-value t w o) (word-value t w o)) @@ -28,22 +28,22 @@ (add-constraint! ttf positive? '(t)) (add-constraint! ttf positive? '(f)) -(define ttf-solution (solve ttf)) +(define ttf-solution (time (solve ttf))) (check-equal? ttf-solution ($csp (list - ($var 'r '(0)) - ($var 'u '(3)) + ($var 't '(9)) + ($var 'w '(3)) + ($var 'o '(8)) ($var 'f '(1)) - ($var 'o '(5)) - ($var 'w '(6)) - ($var 't '(7))) + ($var 'u '(7)) + ($var 'r '(6))) '())) (define (ttf-print csp) (format "~a~a~a + ~a~a~a = ~a~a~a~a" ($csp-ref csp 't) ($csp-ref csp 'w) ($csp-ref csp 'o) ($csp-ref csp 't) ($csp-ref csp 'w) ($csp-ref csp 'o) ($csp-ref csp 'f) ($csp-ref csp 'o) ($csp-ref csp 'u) ($csp-ref csp 'r))) -(check-equal? (solve ttf-solution ttf-print) "765 + 765 = 1530") +(check-equal? (time (solve ttf-solution ttf-print)) "938 + 938 = 1876") ;; ABC problem: @@ -61,11 +61,11 @@ (/ (+ (* 100 a) (* 10 b) c) (+ a b c)))) -(define abc-sols (solve* abc)) +(define abc-sols (time (solve* abc))) (check-equal? (* 9 9 9) (length abc-sols)) (check-equal? (argmin solution-score abc-sols) - ($csp (list ($var 'c '(9)) ($var 'b '(9)) ($var 'a '(1))) '())) + ($csp (list ($var 'a '(1)) ($var 'b '(9)) ($var 'c '(9))) '())) ;; quarter problem: @@ -76,8 +76,8 @@ (add-vars! quarter-problem '(dollars quarters) (range 26)) (add-constraint! quarter-problem (λ (d q) (= 26 (+ d q))) '(dollars quarters)) (add-constraint! quarter-problem (λ (d q) (= 17 (+ d (* 0.25 q)))) '(dollars quarters)) -(check-equal? (solve quarter-problem) - ($csp (list ($var 'quarters '(12)) ($var 'dollars '(14))) '())) +(check-equal? (time (solve quarter-problem)) + ($csp (list ($var 'dollars '(14)) ($var 'quarters '(12))) '())) ;; nickel problem @@ -90,8 +90,8 @@ A collection of 33 coins, consisting of nickels, dimes, and quarters, has a valu (add-constraint! ndq-problem (λ (n d q) (= 330 (+ (* n 5) (* d 10) (* q 25)))) '(n d q)) (add-constraint! ndq-problem (λ (n q) (= (* 3 q) n)) '(n q)) (add-constraint! ndq-problem (λ (d n) (= (* 2 d) n)) '(d n)) -(check-equal? (solve ndq-problem) - ($csp (list ($var 'q '(6)) ($var 'd '(9)) ($var 'n '(18))) '())) +(check-equal? (time (solve ndq-problem)) + ($csp (list ($var 'n '(18)) ($var 'd '(9)) ($var 'q '(6))) '())) ;; xsum @@ -109,16 +109,14 @@ A collection of 33 coins, consisting of nickels, dimes, and quarters, has a valu (define xsum-problem (make-csp)) (add-vars! xsum-problem '(l1 l2 l3 l4 r1 r2 r3 r4 x) (range 1 10)) -(add-constraint! xsum-problem (λ (l1 l2 l3 l4 x) - (and (< l1 l2 l3 l4) - (= 27 (+ l1 l2 l3 l4 x)))) '(l1 l2 l3 l4 x)) -(add-constraint! xsum-problem (λ (r1 r2 r3 r4 x) - (and (< r1 r2 r3 r4) - (= 27 (+ r1 r2 r3 r4 x)))) '(r1 r2 r3 r4 x)) +(add-constraint! xsum-problem < '(l1 l2 l3 l4)) +(add-constraint! xsum-problem < '(r1 r2 r3 r4)) +(add-constraint! xsum-problem (λ (l1 l2 l3 l4 x) (= 27 (+ l1 l2 l3 l4 x))) '(l1 l2 l3 l4 x)) +(add-constraint! xsum-problem (λ (r1 r2 r3 r4 x) (= 27 (+ r1 r2 r3 r4 x))) '(r1 r2 r3 r4 x)) (add-constraint! xsum-problem alldiff '(l1 l2 l3 l4 r1 r2 r3 r4 x)) ;; todo: too slow -#;(check-equal? (length (solve* xsum-problem)) 8) +#;(check-equal? (length (time (solve* xsum-problem))) 8) ;; send more money problem @@ -138,7 +136,7 @@ A collection of 33 coins, consisting of nickels, dimes, and quarters, has a valu (add-constraint! smm positive? '(m)) (add-constraint! smm (λ (s e n d m o r y) (= (+ (word-value s e n d) (word-value m o r e)) - (word-value m o n e y))) '(s e n d m o r y)) + (word-value m o n e y))) '(s e n d m o r y)) (add-constraint! smm alldiff '(s e n d m o r y)) ;; todo: too slow @@ -153,12 +151,12 @@ A collection of 33 coins, consisting of nickels, dimes, and quarters, has a valu (for* ([(qa qa-col) (in-indexed queens)] [(qb qb-col) (in-indexed queens)] #:when (< qa-col qb-col)) - (add-constraint! queens-problem - (λ (qa-row qb-row) - (and - (not (= (abs (- qa-row qb-row)) (abs (- qa-col qb-col)))) ; same diagonal? - (not (= qa-row qb-row)))) ; same row? - (list qa qb))) + (add-constraint! queens-problem + (λ (qa-row qb-row) + (and + (not (= (abs (- qa-row qb-row)) (abs (- qa-col qb-col)))) ; same diagonal? + (not (= qa-row qb-row)))) ; same row? + (list qa qb))) (check-equal? 92 (length (solve* queens-problem))) From 19ca1054e43ba09073f79563557f020b85fb0d9a Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Thu, 11 Oct 2018 16:43:44 -0700 Subject: [PATCH 094/246] shufflina --- csp/test.rkt | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/csp/test.rkt b/csp/test.rkt index 5d5a1c2b..114d585f 100644 --- a/csp/test.rkt +++ b/csp/test.rkt @@ -108,7 +108,7 @@ A collection of 33 coins, consisting of nickels, dimes, and quarters, has a valu |# (define xsum-problem (make-csp)) -(add-vars! xsum-problem '(l1 l2 l3 l4 r1 r2 r3 r4 x) (range 1 10)) +(add-vars! xsum-problem '(l1 l2 l3 l4 r1 r2 r3 r4 x) (λ () (shuffle (range 1 10))) (add-constraint! xsum-problem < '(l1 l2 l3 l4)) (add-constraint! xsum-problem < '(r1 r2 r3 r4)) (add-constraint! xsum-problem (λ (l1 l2 l3 l4 x) (= 27 (+ l1 l2 l3 l4 x))) '(l1 l2 l3 l4 x)) From d61a87258b24437da207e53c9cd78060c543517c Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Thu, 11 Oct 2018 16:58:50 -0700 Subject: [PATCH 095/246] notes --- csp/csp.rkt | 14 +++++++++----- csp/test.rkt | 2 +- 2 files changed, 10 insertions(+), 6 deletions(-) diff --git a/csp/csp.rkt b/csp/csp.rkt index d8108a77..1ddb3638 100644 --- a/csp/csp.rkt +++ b/csp/csp.rkt @@ -67,7 +67,7 @@ (for/or ([var (in-list ($csp-vars csp))]) (empty? ($var-vals var)))) -(struct $csp-inconsistent () #:transparent) +(struct inconsistency-error () #:transparent) (define/contract (apply-unary-constraint csp constraint) ($csp? unary-constraint? . -> . $csp?) @@ -75,13 +75,17 @@ (define new-csp ($csp (for/list ([var (in-list ($csp-vars csp))]) (match-define ($var name vals) var) (if (eq? name constraint-name) + ;; special rule: use promise for a constant value + ;; to skip the filtering ($var name (if (promise? proc) (force proc) (filter proc vals))) var)) ;; once the constraint is applied, it can go away + ;; ps this is not the same as an "assigned" constraint + ;; because the var may still have multiple values (remove constraint ($csp-constraints csp)))) - (when (no-solutions? new-csp) (raise ($csp-inconsistent))) + (when (no-solutions? new-csp) (raise (inconsistency-error))) new-csp) (define/contract (make-nodes-consistent csp) @@ -211,7 +215,7 @@ ([constraint (in-list ($csp-constraints csp))] #:when (and (constraint-has-name? constraint name) (constraint-assigned? csp constraint))) - (unless (constraint csp) (raise ($csp-inconsistent))) + (unless (constraint csp) (raise (inconsistency-error))) (remove-assigned-constraints csp))) (define/contract (backtracking-solver csp) @@ -223,7 +227,7 @@ [else ;; we have at least 1 unassigned var (match-define ($var name vals) (select-unassigned-var csp)) (for ([val (in-list (order-domain-values vals))]) - (with-handlers ([$csp-inconsistent? (const #f)]) + (with-handlers ([inconsistency-error? void]) (backtrack (infer (assign-val csp name val)))))])))) (define/contract (solve* csp [finish-proc values][solution-limit +inf.0]) @@ -232,7 +236,7 @@ (for/list ([solution (in-producer (backtracking-solver csp) (void))] [idx (in-range solution-limit)]) (finish-proc solution))) - (unless (pair? solutions) (raise ($csp-inconsistent))) + (unless (pair? solutions) (raise (inconsistency-error))) solutions) (define/contract (solve csp [finish-proc values]) diff --git a/csp/test.rkt b/csp/test.rkt index 114d585f..b2992f58 100644 --- a/csp/test.rkt +++ b/csp/test.rkt @@ -108,7 +108,7 @@ A collection of 33 coins, consisting of nickels, dimes, and quarters, has a valu |# (define xsum-problem (make-csp)) -(add-vars! xsum-problem '(l1 l2 l3 l4 r1 r2 r3 r4 x) (λ () (shuffle (range 1 10))) +(add-vars! xsum-problem '(l1 l2 l3 l4 r1 r2 r3 r4 x) (λ () (shuffle (range 1 10)))) (add-constraint! xsum-problem < '(l1 l2 l3 l4)) (add-constraint! xsum-problem < '(r1 r2 r3 r4)) (add-constraint! xsum-problem (λ (l1 l2 l3 l4 x) (= 27 (+ l1 l2 l3 l4 x))) '(l1 l2 l3 l4 x)) From 04b736ea08aa01e17a577adbdd027868521b300f Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Thu, 11 Oct 2018 18:25:45 -0700 Subject: [PATCH 096/246] pairwise constraints --- csp/csp.rkt | 44 ++++++++++++++++++++++++++------------ csp/test.rkt | 60 ++++++++++++++++++++++++++-------------------------- 2 files changed, 60 insertions(+), 44 deletions(-) diff --git a/csp/csp.rkt b/csp/csp.rkt index 1ddb3638..7e3bc751 100644 --- a/csp/csp.rkt +++ b/csp/csp.rkt @@ -56,11 +56,21 @@ (($csp? $var-name?) ((or/c (listof any/c) procedure?)) . ->* . void?) (add-vars! csp (list name) vals-or-procedure)) +(define/contract (add-constraints! csp proc namess) + ($csp? procedure? (listof (listof $var-name?)) . -> . void?) + (set-$csp-constraints! csp (append ($csp-constraints csp) + (for/list ([names (in-list namess)]) + (for ([name (in-list names)]) + (check-name-in-csp! 'add-constraint! csp name)) + ($constraint names proc))))) + +(define/contract (add-pairwise-constraint! csp proc var-names) + ($csp? procedure? (listof $var-name?) . -> . void?) + (add-constraints! csp proc (combinations var-names 2))) + (define/contract (add-constraint! csp proc var-names) ($csp? procedure? (listof $var-name?) . -> . void?) - (for ([name (in-list var-names)]) - (check-name-in-csp! 'add-constraint! csp name)) - (set-$csp-constraints! csp (append ($csp-constraints csp) (list ($constraint var-names proc))))) + (add-constraints! csp proc (list var-names))) (define/contract (no-solutions? csp) ($csp? . -> . boolean?) @@ -136,7 +146,7 @@ (for/and ([name (in-list ($constraint-names constraint))]) (memq name (map $var-name (assigned-vars csp))))) -(define/contract (remove-assigned-constraints csp) +(define/contract (remove-extraneous-constraints csp) ($csp? . -> . $csp?) ($csp ($csp-vars csp) @@ -150,7 +160,7 @@ (define all-arcs (binary-constraints->arcs (filter binary-constraint? ($csp-constraints csp)))) (for/fold ([csp csp] [arcs all-arcs] - #:result (remove-assigned-constraints csp)) + #:result (remove-extraneous-constraints csp)) ([i (in-naturals)] #:break (empty? arcs)) (match-define (cons arc other-arcs) arcs) @@ -201,10 +211,7 @@ ;; todo: least constraining value sort vals) -;; todo: inferences between assignments -(define infer values) - -(define/contract (constraint-has-name? constraint name) +(define/contract (constraint-contains-name? constraint name) ($constraint? $var-name? . -> . boolean?) (and (memq name ($constraint-names constraint)) #true)) @@ -213,10 +220,15 @@ (define csp-with-assignment (apply-unary-constraint csp ($constraint (list name) (delay (list val))))) (for/fold ([csp csp-with-assignment]) ([constraint (in-list ($csp-constraints csp))] - #:when (and (constraint-has-name? constraint name) + #:when (and (constraint-contains-name? constraint name) (constraint-assigned? csp constraint))) (unless (constraint csp) (raise (inconsistency-error))) - (remove-assigned-constraints csp))) + (remove-extraneous-constraints csp))) + +;; todo: inferences between assignments +(define/contract (infer csp) + ($csp? . -> . $csp?) + (values csp)) (define/contract (backtracking-solver csp) ($csp? . -> . generator?) @@ -245,7 +257,11 @@ (define ($csp-ref csp name) (car ($csp-vals csp name))) -(define/contract (alldiff . xs) - (() #:rest (listof any/c) . ->* . boolean?) - (= (length (remove-duplicates xs)) (length xs))) +(define/contract (alldiff x y) + (any/c any/c . -> . boolean?) + (not (equal? x y))) + +(define/contract (alldiff= x y) + (any/c any/c . -> . boolean?) + (not (= x y))) diff --git a/csp/test.rkt b/csp/test.rkt index b2992f58..69044ef1 100644 --- a/csp/test.rkt +++ b/csp/test.rkt @@ -7,8 +7,8 @@ (define (sum-three t w o) (= 3 (+ t w o))) (add-constraint! demo sum-three '(t w o)) -(add-constraint! demo alldiff '(t w o)) -(add-constraint! demo < '(t w o)) +(add-pairwise-constraint! demo alldiff= '(t w o)) +(add-pairwise-constraint! demo < '(t w o)) (check-equal? (time (solve demo)) ($csp (list ($var 't '(0)) ($var 'w '(1)) ($var 'o '(2))) '())) @@ -22,7 +22,8 @@ (for/sum ([i (in-range (length xs))]) (* (list-ref xs i) (expt 10 i))))) -(add-constraint! ttf alldiff '(t w o f u r)) +(add-pairwise-constraint! ttf alldiff= '(t w o f u r)) +(add-constraint! ttf (λ (o r) (= (modulo (+ o o) 10) r)) '(o r)) (add-constraint! ttf (λ (t w o f u r) (= (+ (word-value t w o) (word-value t w o)) (word-value f o u r))) '(t w o f u r)) (add-constraint! ttf positive? '(t)) @@ -32,18 +33,18 @@ (check-equal? ttf-solution ($csp (list - ($var 't '(9)) + ($var 't '(7)) ($var 'w '(3)) - ($var 'o '(8)) + ($var 'o '(4)) ($var 'f '(1)) - ($var 'u '(7)) - ($var 'r '(6))) + ($var 'u '(6)) + ($var 'r '(8))) '())) (define (ttf-print csp) (format "~a~a~a + ~a~a~a = ~a~a~a~a" ($csp-ref csp 't) ($csp-ref csp 'w) ($csp-ref csp 'o) ($csp-ref csp 't) ($csp-ref csp 'w) ($csp-ref csp 'o) ($csp-ref csp 'f) ($csp-ref csp 'o) ($csp-ref csp 'u) ($csp-ref csp 'r))) -(check-equal? (time (solve ttf-solution ttf-print)) "938 + 938 = 1876") +(check-equal? (time (solve ttf-solution ttf-print)) "734 + 734 = 1468") ;; ABC problem: @@ -72,11 +73,11 @@ ;; 26 dollars and quarters ;; that add up to $17. -(define quarter-problem (make-csp)) -(add-vars! quarter-problem '(dollars quarters) (range 26)) -(add-constraint! quarter-problem (λ (d q) (= 26 (+ d q))) '(dollars quarters)) -(add-constraint! quarter-problem (λ (d q) (= 17 (+ d (* 0.25 q)))) '(dollars quarters)) -(check-equal? (time (solve quarter-problem)) +(define quarters (make-csp)) +(add-vars! quarters '(dollars quarters) (range 26)) +(add-constraint! quarters (λ (d q) (= 26 (+ d q))) '(dollars quarters)) +(add-constraint! quarters (λ (d q) (= 17 (+ d (* 0.25 q)))) '(dollars quarters)) +(check-equal? (time (solve quarters)) ($csp (list ($var 'dollars '(14)) ($var 'quarters '(12))) '())) @@ -84,13 +85,13 @@ #| A collection of 33 coins, consisting of nickels, dimes, and quarters, has a value of $3.30. If there are three times as many nickels as quarters, and one-half as many dimes as nickels, how many coins of each kind are there? |# -(define ndq-problem (make-csp)) -(add-vars! ndq-problem '(n d q) (range 33)) -(add-constraint! ndq-problem (λ (n d q) (= 33 (+ n d q))) '(n d q)) -(add-constraint! ndq-problem (λ (n d q) (= 330 (+ (* n 5) (* d 10) (* q 25)))) '(n d q)) -(add-constraint! ndq-problem (λ (n q) (= (* 3 q) n)) '(n q)) -(add-constraint! ndq-problem (λ (d n) (= (* 2 d) n)) '(d n)) -(check-equal? (time (solve ndq-problem)) +(define nickels (make-csp)) +(add-vars! nickels '(n d q) (range 33)) +(add-constraint! nickels (λ (n d q) (= 33 (+ n d q))) '(n d q)) +(add-constraint! nickels (λ (n d q) (= 330 (+ (* n 5) (* d 10) (* q 25)))) '(n d q)) +(add-constraint! nickels (λ (n q) (= (* 3 q) n)) '(n q)) +(add-constraint! nickels (λ (d n) (= (* 2 d) n)) '(d n)) +(check-equal? (time (solve nickels)) ($csp (list ($var 'n '(18)) ($var 'd '(9)) ($var 'q '(6))) '())) @@ -107,16 +108,15 @@ A collection of 33 coins, consisting of nickels, dimes, and quarters, has a valu # |# -(define xsum-problem (make-csp)) -(add-vars! xsum-problem '(l1 l2 l3 l4 r1 r2 r3 r4 x) (λ () (shuffle (range 1 10)))) -(add-constraint! xsum-problem < '(l1 l2 l3 l4)) -(add-constraint! xsum-problem < '(r1 r2 r3 r4)) -(add-constraint! xsum-problem (λ (l1 l2 l3 l4 x) (= 27 (+ l1 l2 l3 l4 x))) '(l1 l2 l3 l4 x)) -(add-constraint! xsum-problem (λ (r1 r2 r3 r4 x) (= 27 (+ r1 r2 r3 r4 x))) '(r1 r2 r3 r4 x)) -(add-constraint! xsum-problem alldiff '(l1 l2 l3 l4 r1 r2 r3 r4 x)) +(define xsum (make-csp)) +(add-vars! xsum '(l1 l2 l3 l4 r1 r2 r3 r4 x) (λ () (shuffle (range 1 10)))) +(add-pairwise-constraint! xsum < '(l1 l2 l3 l4)) +(add-pairwise-constraint! xsum < '(r1 r2 r3 r4)) +(add-constraint! xsum (λ (l1 l2 l3 l4 x) (= 27 (+ l1 l2 l3 l4 x))) '(l1 l2 l3 l4 x)) +(add-constraint! xsum (λ (r1 r2 r3 r4 x) (= 27 (+ r1 r2 r3 r4 x))) '(r1 r2 r3 r4 x)) +(add-pairwise-constraint! xsum alldiff= '(l1 l2 l3 l4 r1 r2 r3 r4 x)) -;; todo: too slow -#;(check-equal? (length (time (solve* xsum-problem))) 8) +(check-equal? (length (time (solve* xsum))) 8) ;; send more money problem @@ -137,7 +137,7 @@ A collection of 33 coins, consisting of nickels, dimes, and quarters, has a valu (add-constraint! smm (λ (s e n d m o r y) (= (+ (word-value s e n d) (word-value m o r e)) (word-value m o n e y))) '(s e n d m o r y)) -(add-constraint! smm alldiff '(s e n d m o r y)) +(add-constraint! smm alldiff= '(s e n d m o r y)) ;; todo: too slow ;(solve smm) From ae8c3e4937050527c4442c1487a72d9bd510053e Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Thu, 11 Oct 2018 19:28:05 -0700 Subject: [PATCH 097/246] more ac-3 --- csp/csp.rkt | 62 ++++++++++++++++++++++++++++++---------------------- csp/test.rkt | 14 ++++++------ 2 files changed, 43 insertions(+), 33 deletions(-) diff --git a/csp/csp.rkt b/csp/csp.rkt index 7e3bc751..0b7d8535 100644 --- a/csp/csp.rkt +++ b/csp/csp.rkt @@ -1,10 +1,11 @@ #lang debug racket -(require racket/generator) +(require racket/generator sugar/debug) (provide (all-defined-out)) (struct $csp ([vars #:mutable] [constraints #:mutable]) #:transparent) (define (make-csp) ($csp null null)) +(define debug (make-parameter #false)) (struct $var (name vals) #:transparent) (define $var-name? symbol?) @@ -26,7 +27,7 @@ (symbol? $csp? $var-name? . -> . void?) (define names (map $var-name ($csp-vars csp))) (unless (memq name names) - (raise-argument-error caller (format "csp variable name: ~v" names) name))) + (raise-argument-error caller (format "one of these existing csp var names: ~v" names) name))) (define (nary-constraint? constraint n) (= n (length ($constraint-names constraint)))) @@ -56,21 +57,23 @@ (($csp? $var-name?) ((or/c (listof any/c) procedure?)) . ->* . void?) (add-vars! csp (list name) vals-or-procedure)) -(define/contract (add-constraints! csp proc namess) - ($csp? procedure? (listof (listof $var-name?)) . -> . void?) +(define/contract (add-constraints! csp proc namess [proc-name #false]) + (($csp? procedure? (listof (listof $var-name?))) ((or/c #false $var-name?)) . ->* . void?) (set-$csp-constraints! csp (append ($csp-constraints csp) (for/list ([names (in-list namess)]) (for ([name (in-list names)]) (check-name-in-csp! 'add-constraint! csp name)) - ($constraint names proc))))) + ($constraint names (if proc-name + (procedure-rename proc proc-name) + proc)))))) -(define/contract (add-pairwise-constraint! csp proc var-names) - ($csp? procedure? (listof $var-name?) . -> . void?) - (add-constraints! csp proc (combinations var-names 2))) +(define/contract (add-pairwise-constraint! csp proc var-names [proc-name #false]) + (($csp? procedure? (listof $var-name?)) ($var-name?) . ->* . void?) + (add-constraints! csp proc (combinations var-names 2) proc-name)) -(define/contract (add-constraint! csp proc var-names) - ($csp? procedure? (listof $var-name?) . -> . void?) - (add-constraints! csp proc (list var-names))) +(define/contract (add-constraint! csp proc var-names [proc-name #false]) + (($csp? procedure? (listof $var-name?)) ($var-name?) . ->* . void?) + (add-constraints! csp proc (list var-names) proc-name)) (define/contract (no-solutions? csp) ($csp? . -> . boolean?) @@ -146,21 +149,25 @@ (for/and ([name (in-list ($constraint-names constraint))]) (memq name (map $var-name (assigned-vars csp))))) -(define/contract (remove-extraneous-constraints csp) - ($csp? . -> . $csp?) +(define/contract (remove-assigned-constraints csp [arity #false]) + (($csp?) (exact-nonnegative-integer?) . ->* . $csp?) ($csp ($csp-vars csp) (for/list ([constraint (in-list ($csp-constraints csp))] - #:unless (constraint-assigned? csp constraint)) + #:unless (and (if arity (= (length ($constraint-names constraint)) arity) #true) + (constraint-assigned? csp constraint))) constraint))) +(define (remove-assigned-binary-constraints csp) + (remove-assigned-constraints csp 2)) + (define/contract (ac-3 csp) ($csp? . -> . $csp?) ;; as described by AIMA @ 265 (define all-arcs (binary-constraints->arcs (filter binary-constraint? ($csp-constraints csp)))) (for/fold ([csp csp] [arcs all-arcs] - #:result (remove-extraneous-constraints csp)) + #:result (remove-assigned-binary-constraints csp)) ([i (in-naturals)] #:break (empty? arcs)) (match-define (cons arc other-arcs) arcs) @@ -182,9 +189,9 @@ ($var? . -> . boolean?) (= 1 (length ($var-vals var)))) -(define/contract (assignment-complete? csp) +(define/contract (solution-complete? csp) ($csp? . -> . boolean?) - (andmap var-assigned? ($csp-vars csp))) + (and (andmap var-assigned? ($csp-vars csp)) (empty? ($csp-constraints csp)))) (define (assigned-helper csp) (partition var-assigned? ($csp-vars csp))) @@ -215,27 +222,31 @@ ($constraint? $var-name? . -> . boolean?) (and (memq name ($constraint-names constraint)) #true)) +(define/contract (test-assignments csp) + ($csp? . -> . $csp?) + (define assigned-names (map $var-name (assigned-vars csp))) + (for/fold ([csp csp]) + ([constraint (in-list ($csp-constraints csp))] + #:when (constraint-assigned? csp constraint)) + (unless (constraint csp) (raise (inconsistency-error))) + (remove-assigned-constraints csp))) + (define/contract (assign-val csp name val) ($csp? $var-name? any/c . -> . $csp?) (define csp-with-assignment (apply-unary-constraint csp ($constraint (list name) (delay (list val))))) - (for/fold ([csp csp-with-assignment]) - ([constraint (in-list ($csp-constraints csp))] - #:when (and (constraint-contains-name? constraint name) - (constraint-assigned? csp constraint))) - (unless (constraint csp) (raise (inconsistency-error))) - (remove-extraneous-constraints csp))) + (test-assignments csp-with-assignment)) ;; todo: inferences between assignments (define/contract (infer csp) ($csp? . -> . $csp?) - (values csp)) + (test-assignments (make-arcs-consistent csp))) (define/contract (backtracking-solver csp) ($csp? . -> . generator?) (generator () (let backtrack ([csp (make-arcs-consistent (make-nodes-consistent csp))]) (cond - [(assignment-complete? csp) (yield csp)] + [(solution-complete? csp) (yield csp)] [else ;; we have at least 1 unassigned var (match-define ($var name vals) (select-unassigned-var csp)) (for ([val (in-list (order-domain-values vals))]) @@ -264,4 +275,3 @@ (define/contract (alldiff= x y) (any/c any/c . -> . boolean?) (not (= x y))) - diff --git a/csp/test.rkt b/csp/test.rkt index 69044ef1..f5ffe4de 100644 --- a/csp/test.rkt +++ b/csp/test.rkt @@ -87,10 +87,10 @@ A collection of 33 coins, consisting of nickels, dimes, and quarters, has a valu |# (define nickels (make-csp)) (add-vars! nickels '(n d q) (range 33)) -(add-constraint! nickels (λ (n d q) (= 33 (+ n d q))) '(n d q)) -(add-constraint! nickels (λ (n d q) (= 330 (+ (* n 5) (* d 10) (* q 25)))) '(n d q)) -(add-constraint! nickels (λ (n q) (= (* 3 q) n)) '(n q)) -(add-constraint! nickels (λ (d n) (= (* 2 d) n)) '(d n)) +(add-constraint! nickels (λ (n d q) (= 33 (+ n d q))) '(n d q) 'count-33) +(add-constraint! nickels (λ (n d q) (= 330 (+ (* n 5) (* d 10) (* q 25)))) '(n d q) 'total-3.30) +(add-constraint! nickels (λ (n q) (= (* 3 q) n)) '(n q) 'triple-nickel) +(add-constraint! nickels (λ (d n) (= (* 2 d) n)) '(d n) 'double-nickel) (check-equal? (time (solve nickels)) ($csp (list ($var 'n '(18)) ($var 'd '(9)) ($var 'q '(6))) '())) @@ -131,13 +131,13 @@ A collection of 33 coins, consisting of nickels, dimes, and quarters, has a valu |# (define smm (make-csp)) -(add-vars! smm '(s e n d m o r y) (range 10)) +(add-vars! smm '(s e n d m o r y) (λ () (shuffle (range 10)))) (add-constraint! smm positive? '(s)) (add-constraint! smm positive? '(m)) (add-constraint! smm (λ (s e n d m o r y) (= (+ (word-value s e n d) (word-value m o r e)) (word-value m o n e y))) '(s e n d m o r y)) -(add-constraint! smm alldiff= '(s e n d m o r y)) +(add-pairwise-constraint! smm alldiff= '(s e n d m o r y)) ;; todo: too slow ;(solve smm) @@ -158,5 +158,5 @@ A collection of 33 coins, consisting of nickels, dimes, and quarters, has a valu (not (= qa-row qb-row)))) ; same row? (list qa qb))) -(check-equal? 92 (length (solve* queens-problem))) +(check-equal? 92 (length (time (solve* queens-problem)))) From 2a372088472ac21c8dbaeacdf44a347df19cff67 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Thu, 11 Oct 2018 22:52:54 -0700 Subject: [PATCH 098/246] arity reduction --- csp/csp.rkt | 117 ++++++++++++++++++++++++++++++++++++---------------- 1 file changed, 81 insertions(+), 36 deletions(-) diff --git a/csp/csp.rkt b/csp/csp.rkt index 0b7d8535..bd12dba4 100644 --- a/csp/csp.rkt +++ b/csp/csp.rkt @@ -20,8 +20,8 @@ [else (match-define (cons name other-names) names) (for/and ([val (in-list ($csp-vals csp name))]) - ;; todo: reconsider efficiency of currying every value - (($constraint other-names (curry proc val)) csp))]))) + ;; todo: reconsider efficiency of currying every value + (($constraint other-names (curry proc val)) csp))]))) (define/contract (check-name-in-csp! caller csp name) (symbol? $csp? $var-name? . -> . void?) @@ -61,11 +61,11 @@ (($csp? procedure? (listof (listof $var-name?))) ((or/c #false $var-name?)) . ->* . void?) (set-$csp-constraints! csp (append ($csp-constraints csp) (for/list ([names (in-list namess)]) - (for ([name (in-list names)]) - (check-name-in-csp! 'add-constraint! csp name)) - ($constraint names (if proc-name - (procedure-rename proc proc-name) - proc)))))) + (for ([name (in-list names)]) + (check-name-in-csp! 'add-constraint! csp name)) + ($constraint names (if proc-name + (procedure-rename proc proc-name) + proc)))))) (define/contract (add-pairwise-constraint! csp proc var-names [proc-name #false]) (($csp? procedure? (listof $var-name?)) ($var-name?) . ->* . void?) @@ -78,7 +78,7 @@ (define/contract (no-solutions? csp) ($csp? . -> . boolean?) (for/or ([var (in-list ($csp-vars csp))]) - (empty? ($var-vals var)))) + (empty? ($var-vals var)))) (struct inconsistency-error () #:transparent) @@ -86,14 +86,14 @@ ($csp? unary-constraint? . -> . $csp?) (match-define ($constraint (list constraint-name) proc) constraint) (define new-csp ($csp (for/list ([var (in-list ($csp-vars csp))]) - (match-define ($var name vals) var) - (if (eq? name constraint-name) - ;; special rule: use promise for a constant value - ;; to skip the filtering - ($var name (if (promise? proc) - (force proc) - (filter proc vals))) - var)) + (match-define ($var name vals) var) + (if (eq? name constraint-name) + ;; special rule: use promise for a constant value + ;; to skip the filtering + ($var name (if (promise? proc) + (force proc) + (filter proc vals))) + var)) ;; once the constraint is applied, it can go away ;; ps this is not the same as an "assigned" constraint ;; because the var may still have multiple values @@ -113,7 +113,7 @@ (check-name-in-csp! '$csp-vals csp name) (for/first ([var (in-list ($csp-vars csp))] #:when (eq? name ($var-name var))) - ($var-vals var))) + ($var-vals var))) (struct $arc (name constraint) #:transparent) @@ -126,37 +126,37 @@ (λ (val other-val) (constraint-proc other-val val)))) ; otherwise reverse arg order (define (satisfies-arc? val) (for/or ([other-val (in-list ($csp-vals csp other-name))]) - (proc val other-val))) + (proc val other-val))) (apply-unary-constraint csp ($constraint (list name) (procedure-rename satisfies-arc? - (string->symbol (format "satisfies-arc-with-~a?" other-name)))))) + (string->symbol (format "~a-arc-to-~a" (object-name proc) other-name)))))) (define/contract (binary-constraints->arcs constraints) ((listof binary-constraint?) . -> . (listof $arc?)) (for*/list ([constraint (in-list constraints)] [name (in-list ($constraint-names constraint))]) - ($arc name constraint))) + ($arc name constraint))) (define/contract (terminating-at arcs name) ((listof $arc?) $var-name? . -> . (listof $arc?)) (for/list ([arc (in-list arcs)] #:when (eq? name (second ($constraint-names ($arc-constraint arc))))) - arc)) + arc)) (define/contract (constraint-assigned? csp constraint) ($csp? $constraint? . -> . any/c) (for/and ([name (in-list ($constraint-names constraint))]) - (memq name (map $var-name (assigned-vars csp))))) + (memq name (map $var-name (assigned-vars csp))))) (define/contract (remove-assigned-constraints csp [arity #false]) - (($csp?) (exact-nonnegative-integer?) . ->* . $csp?) + (($csp?) ((or/c #false exact-nonnegative-integer?)) . ->* . $csp?) ($csp ($csp-vars csp) (for/list ([constraint (in-list ($csp-constraints csp))] #:unless (and (if arity (= (length ($constraint-names constraint)) arity) #true) (constraint-assigned? csp constraint))) - constraint))) + constraint))) (define (remove-assigned-binary-constraints csp) (remove-assigned-constraints csp 2)) @@ -222,24 +222,69 @@ ($constraint? $var-name? . -> . boolean?) (and (memq name ($constraint-names constraint)) #true)) -(define/contract (test-assignments csp) +(define/contract (validate-assignments csp) ($csp? . -> . $csp?) - (define assigned-names (map $var-name (assigned-vars csp))) - (for/fold ([csp csp]) - ([constraint (in-list ($csp-constraints csp))] - #:when (constraint-assigned? csp constraint)) - (unless (constraint csp) (raise (inconsistency-error))) - (remove-assigned-constraints csp))) + (for ([constraint (in-list ($csp-constraints csp))] + #:when (constraint-assigned? csp constraint)) + (unless (constraint csp) (raise (inconsistency-error)))) + (reduce-constraint-arity (remove-assigned-constraints csp))) (define/contract (assign-val csp name val) ($csp? $var-name? any/c . -> . $csp?) (define csp-with-assignment (apply-unary-constraint csp ($constraint (list name) (delay (list val))))) - (test-assignments csp-with-assignment)) + (validate-assignments csp-with-assignment)) + +(define (reduce-arity proc args) + (procedure-rename + (λ xs + (apply proc (for/fold ([acc empty] + [xs xs] + [vals (filter-not symbol? args)] + #:result (reverse acc)) + ([arg (in-list args)]) + (if (symbol? arg) + (values (cons (car xs) acc) (cdr xs) vals) + (values (cons (car vals) acc) xs (cdr vals)))))) + (string->symbol (format "reduced-arity-~a" (object-name proc))))) + +(module+ test + (require rackunit) + (define f (λ (a b c d) (+ a b c d))) + (check-equal? 10 ((reduce-arity f '(1 b c d)) 2 3 4)) + (check-equal? 10 ((reduce-arity f '(1 2 c d)) 3 4)) + (check-equal? 10 ((reduce-arity f '(1 2 3 d)) 4)) + (check-equal? 10 ((reduce-arity f '(1 b 3 d)) 2 4)) + (check-equal? 10 ((reduce-arity f '(a b 3 d)) 1 2 4))) + +(define/contract (reduce-constraint-arity csp [minimum-arity 3]) + (($csp?) (exact-nonnegative-integer?) . ->* . $csp?) + (define assigned-names (map $var-name (assigned-vars csp))) + ($csp ($csp-vars csp) + (for/list ([constraint (in-list ($csp-constraints csp))]) + (match-define ($constraint cnames proc) constraint) + (cond + [(and (<= minimum-arity (length cnames)) + (for/or ([cname (in-list cnames)]) + (memq cname assigned-names))) + ($constraint (for/list ([cname (in-list cnames)] + #:unless (memq cname assigned-names)) + cname) + (reduce-arity proc (for/list ([cname (in-list cnames)]) + (if (memq cname assigned-names) + (car ($csp-vals csp cname)) + cname))))] + [else constraint])))) + +(module+ test + (define creduce (assign-val ($csp (list ($var 'a '(1 2 3)) ($var 'b '(2 3)) ($var 'c '(1 2 3 4 5))) (list ($constraint '(a b c) (procedure-rename (λ (a b c) (= (+ a b c) 4)) 'summer)))) 'a 1)) + (check-equal? + (make-arcs-consistent (reduce-constraint-arity creduce)) + ($csp (list ($var 'a '(1)) ($var 'b '(2)) ($var 'c '(1))) '()))) ;; todo: inferences between assignments (define/contract (infer csp) ($csp? . -> . $csp?) - (test-assignments (make-arcs-consistent csp))) + (validate-assignments (make-arcs-consistent csp))) (define/contract (backtracking-solver csp) ($csp? . -> . generator?) @@ -250,15 +295,15 @@ [else ;; we have at least 1 unassigned var (match-define ($var name vals) (select-unassigned-var csp)) (for ([val (in-list (order-domain-values vals))]) - (with-handlers ([inconsistency-error? void]) - (backtrack (infer (assign-val csp name val)))))])))) + (with-handlers ([inconsistency-error? void]) + (backtrack (infer (assign-val csp name val)))))])))) (define/contract (solve* csp [finish-proc values][solution-limit +inf.0]) (($csp?) (procedure? integer?) . ->* . (listof any/c)) (define solutions (for/list ([solution (in-producer (backtracking-solver csp) (void))] [idx (in-range solution-limit)]) - (finish-proc solution))) + (finish-proc solution))) (unless (pair? solutions) (raise (inconsistency-error))) solutions) From 7fe4aee3d4f53b84e57e2e71357218031d474e7e Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Fri, 12 Oct 2018 07:25:22 -0700 Subject: [PATCH 099/246] errority --- csp/csp.rkt | 80 +++++++++++++++++++++++++++-------------------------- 1 file changed, 41 insertions(+), 39 deletions(-) diff --git a/csp/csp.rkt b/csp/csp.rkt index bd12dba4..da450314 100644 --- a/csp/csp.rkt +++ b/csp/csp.rkt @@ -20,8 +20,8 @@ [else (match-define (cons name other-names) names) (for/and ([val (in-list ($csp-vals csp name))]) - ;; todo: reconsider efficiency of currying every value - (($constraint other-names (curry proc val)) csp))]))) + ;; todo: reconsider efficiency of currying every value + (($constraint other-names (curry proc val)) csp))]))) (define/contract (check-name-in-csp! caller csp name) (symbol? $csp? $var-name? . -> . void?) @@ -61,11 +61,11 @@ (($csp? procedure? (listof (listof $var-name?))) ((or/c #false $var-name?)) . ->* . void?) (set-$csp-constraints! csp (append ($csp-constraints csp) (for/list ([names (in-list namess)]) - (for ([name (in-list names)]) - (check-name-in-csp! 'add-constraint! csp name)) - ($constraint names (if proc-name - (procedure-rename proc proc-name) - proc)))))) + (for ([name (in-list names)]) + (check-name-in-csp! 'add-constraint! csp name)) + ($constraint names (if proc-name + (procedure-rename proc proc-name) + proc)))))) (define/contract (add-pairwise-constraint! csp proc var-names [proc-name #false]) (($csp? procedure? (listof $var-name?)) ($var-name?) . ->* . void?) @@ -78,7 +78,7 @@ (define/contract (no-solutions? csp) ($csp? . -> . boolean?) (for/or ([var (in-list ($csp-vars csp))]) - (empty? ($var-vals var)))) + (empty? ($var-vals var)))) (struct inconsistency-error () #:transparent) @@ -86,14 +86,14 @@ ($csp? unary-constraint? . -> . $csp?) (match-define ($constraint (list constraint-name) proc) constraint) (define new-csp ($csp (for/list ([var (in-list ($csp-vars csp))]) - (match-define ($var name vals) var) - (if (eq? name constraint-name) - ;; special rule: use promise for a constant value - ;; to skip the filtering - ($var name (if (promise? proc) - (force proc) - (filter proc vals))) - var)) + (match-define ($var name vals) var) + (if (eq? name constraint-name) + ;; special rule: use promise for a constant value + ;; to skip the filtering + ($var name (if (promise? proc) + (force proc) + (filter proc vals))) + var)) ;; once the constraint is applied, it can go away ;; ps this is not the same as an "assigned" constraint ;; because the var may still have multiple values @@ -113,7 +113,7 @@ (check-name-in-csp! '$csp-vals csp name) (for/first ([var (in-list ($csp-vars csp))] #:when (eq? name ($var-name var))) - ($var-vals var))) + ($var-vals var))) (struct $arc (name constraint) #:transparent) @@ -126,7 +126,7 @@ (λ (val other-val) (constraint-proc other-val val)))) ; otherwise reverse arg order (define (satisfies-arc? val) (for/or ([other-val (in-list ($csp-vals csp other-name))]) - (proc val other-val))) + (proc val other-val))) (apply-unary-constraint csp ($constraint (list name) (procedure-rename satisfies-arc? @@ -136,18 +136,18 @@ ((listof binary-constraint?) . -> . (listof $arc?)) (for*/list ([constraint (in-list constraints)] [name (in-list ($constraint-names constraint))]) - ($arc name constraint))) + ($arc name constraint))) (define/contract (terminating-at arcs name) ((listof $arc?) $var-name? . -> . (listof $arc?)) (for/list ([arc (in-list arcs)] #:when (eq? name (second ($constraint-names ($arc-constraint arc))))) - arc)) + arc)) (define/contract (constraint-assigned? csp constraint) ($csp? $constraint? . -> . any/c) (for/and ([name (in-list ($constraint-names constraint))]) - (memq name (map $var-name (assigned-vars csp))))) + (memq name (map $var-name (assigned-vars csp))))) (define/contract (remove-assigned-constraints csp [arity #false]) (($csp?) ((or/c #false exact-nonnegative-integer?)) . ->* . $csp?) @@ -156,7 +156,7 @@ (for/list ([constraint (in-list ($csp-constraints csp))] #:unless (and (if arity (= (length ($constraint-names constraint)) arity) #true) (constraint-assigned? csp constraint))) - constraint))) + constraint))) (define (remove-assigned-binary-constraints csp) (remove-assigned-constraints csp 2)) @@ -226,7 +226,7 @@ ($csp? . -> . $csp?) (for ([constraint (in-list ($csp-constraints csp))] #:when (constraint-assigned? csp constraint)) - (unless (constraint csp) (raise (inconsistency-error)))) + (unless (constraint csp) (raise (inconsistency-error)))) (reduce-constraint-arity (remove-assigned-constraints csp))) (define/contract (assign-val csp name val) @@ -235,6 +235,8 @@ (validate-assignments csp-with-assignment)) (define (reduce-arity proc args) + (unless (= (length args) (procedure-arity proc)) + (raise-argument-error 'reduce-arity (format "list of length ~a, same as procedure arity" (procedure-arity proc)) args)) (procedure-rename (λ xs (apply proc (for/fold ([acc empty] @@ -261,19 +263,19 @@ (define assigned-names (map $var-name (assigned-vars csp))) ($csp ($csp-vars csp) (for/list ([constraint (in-list ($csp-constraints csp))]) - (match-define ($constraint cnames proc) constraint) - (cond - [(and (<= minimum-arity (length cnames)) - (for/or ([cname (in-list cnames)]) - (memq cname assigned-names))) - ($constraint (for/list ([cname (in-list cnames)] - #:unless (memq cname assigned-names)) - cname) - (reduce-arity proc (for/list ([cname (in-list cnames)]) - (if (memq cname assigned-names) - (car ($csp-vals csp cname)) - cname))))] - [else constraint])))) + (match-define ($constraint cnames proc) constraint) + (cond + [(and (<= minimum-arity (length cnames)) + (for/or ([cname (in-list cnames)]) + (memq cname assigned-names))) + ($constraint (for/list ([cname (in-list cnames)] + #:unless (memq cname assigned-names)) + cname) + (reduce-arity proc (for/list ([cname (in-list cnames)]) + (if (memq cname assigned-names) + (car ($csp-vals csp cname)) + cname))))] + [else constraint])))) (module+ test (define creduce (assign-val ($csp (list ($var 'a '(1 2 3)) ($var 'b '(2 3)) ($var 'c '(1 2 3 4 5))) (list ($constraint '(a b c) (procedure-rename (λ (a b c) (= (+ a b c) 4)) 'summer)))) 'a 1)) @@ -295,15 +297,15 @@ [else ;; we have at least 1 unassigned var (match-define ($var name vals) (select-unassigned-var csp)) (for ([val (in-list (order-domain-values vals))]) - (with-handlers ([inconsistency-error? void]) - (backtrack (infer (assign-val csp name val)))))])))) + (with-handlers ([inconsistency-error? void]) + (backtrack (infer (assign-val csp name val)))))])))) (define/contract (solve* csp [finish-proc values][solution-limit +inf.0]) (($csp?) (procedure? integer?) . ->* . (listof any/c)) (define solutions (for/list ([solution (in-producer (backtracking-solver csp) (void))] [idx (in-range solution-limit)]) - (finish-proc solution))) + (finish-proc solution))) (unless (pair? solutions) (raise (inconsistency-error))) solutions) From 4ccea6d0965d0838fc3b0de398d1b69e7f58ad0c Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Fri, 12 Oct 2018 07:43:34 -0700 Subject: [PATCH 100/246] better error --- csp/csp.rkt | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/csp/csp.rkt b/csp/csp.rkt index da450314..28cad5d7 100644 --- a/csp/csp.rkt +++ b/csp/csp.rkt @@ -237,8 +237,12 @@ (define (reduce-arity proc args) (unless (= (length args) (procedure-arity proc)) (raise-argument-error 'reduce-arity (format "list of length ~a, same as procedure arity" (procedure-arity proc)) args)) + (define reduced-arity-name (string->symbol (format "reduced-arity-~a" (object-name proc)))) + (define new-arity (length (filter symbol? args))) (procedure-rename (λ xs + (unless (= (length xs) new-arity) + (apply raise-arity-error reduced-arity-name new-arity xs)) (apply proc (for/fold ([acc empty] [xs xs] [vals (filter-not symbol? args)] @@ -247,7 +251,7 @@ (if (symbol? arg) (values (cons (car xs) acc) (cdr xs) vals) (values (cons (car vals) acc) xs (cdr vals)))))) - (string->symbol (format "reduced-arity-~a" (object-name proc))))) + reduced-arity-name)) (module+ test (require rackunit) From 5c38eb68a17585eb0395f535ac7790a884e43a81 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Fri, 12 Oct 2018 07:46:45 -0700 Subject: [PATCH 101/246] hm --- csp/csp.rkt | 13 +++++++------ 1 file changed, 7 insertions(+), 6 deletions(-) diff --git a/csp/csp.rkt b/csp/csp.rkt index 28cad5d7..32e7162c 100644 --- a/csp/csp.rkt +++ b/csp/csp.rkt @@ -234,20 +234,21 @@ (define csp-with-assignment (apply-unary-constraint csp ($constraint (list name) (delay (list val))))) (validate-assignments csp-with-assignment)) -(define (reduce-arity proc args) - (unless (= (length args) (procedure-arity proc)) - (raise-argument-error 'reduce-arity (format "list of length ~a, same as procedure arity" (procedure-arity proc)) args)) +(define (reduce-arity proc pattern) + (unless (= (length pattern) (procedure-arity proc)) + (raise-argument-error 'reduce-arity (format "list of length ~a, same as procedure arity" (procedure-arity proc)) pattern)) (define reduced-arity-name (string->symbol (format "reduced-arity-~a" (object-name proc)))) - (define new-arity (length (filter symbol? args))) + (define-values (id-names vals) (partition symbol? pattern)) + (define new-arity (length id-names)) (procedure-rename (λ xs (unless (= (length xs) new-arity) (apply raise-arity-error reduced-arity-name new-arity xs)) (apply proc (for/fold ([acc empty] [xs xs] - [vals (filter-not symbol? args)] + [vals vals] #:result (reverse acc)) - ([arg (in-list args)]) + ([arg (in-list pattern)]) (if (symbol? arg) (values (cons (car xs) acc) (cdr xs) vals) (values (cons (car vals) acc) xs (cdr vals)))))) From 3c5bda43d500c13624fe1481c0ce940414070f30 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Fri, 12 Oct 2018 08:57:15 -0700 Subject: [PATCH 102/246] improve arity error --- csp/csp.rkt | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/csp/csp.rkt b/csp/csp.rkt index 32e7162c..f7ced556 100644 --- a/csp/csp.rkt +++ b/csp/csp.rkt @@ -235,7 +235,9 @@ (validate-assignments csp-with-assignment)) (define (reduce-arity proc pattern) - (unless (= (length pattern) (procedure-arity proc)) + (unless (match (procedure-arity proc) + [(arity-at-least val) (<= val (length pattern))] + [(? number? val) (= val (length pattern))]) (raise-argument-error 'reduce-arity (format "list of length ~a, same as procedure arity" (procedure-arity proc)) pattern)) (define reduced-arity-name (string->symbol (format "reduced-arity-~a" (object-name proc)))) (define-values (id-names vals) (partition symbol? pattern)) @@ -248,8 +250,8 @@ [xs xs] [vals vals] #:result (reverse acc)) - ([arg (in-list pattern)]) - (if (symbol? arg) + ([pat-item (in-list pattern)]) + (if (symbol? pat-item) (values (cons (car xs) acc) (cdr xs) vals) (values (cons (car vals) acc) xs (cdr vals)))))) reduced-arity-name)) From 56d975667fce93882be55c764c6889d35a52aa43 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Sat, 13 Oct 2018 06:56:34 -0700 Subject: [PATCH 103/246] state count --- csp/csp.rkt | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/csp/csp.rkt b/csp/csp.rkt index f7ced556..1b6bcb80 100644 --- a/csp/csp.rkt +++ b/csp/csp.rkt @@ -329,3 +329,8 @@ (define/contract (alldiff= x y) (any/c any/c . -> . boolean?) (not (= x y))) + +(define/contract (state-count csp) + ($csp? . -> . exact-nonnegative-integer?) + (for/product ([var (in-list ($csp-vars csp))]) + (length ($var-vals var)))) \ No newline at end of file From 9629c000ebf174b0016e5405550959a4fe47ad01 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Sat, 13 Oct 2018 09:29:12 -0700 Subject: [PATCH 104/246] degree tiebreaker --- csp/csp.rkt | 99 ++++++++++++++++++++++++++++++---------------------- csp/test.rkt | 8 ++++- 2 files changed, 64 insertions(+), 43 deletions(-) diff --git a/csp/csp.rkt b/csp/csp.rkt index 1b6bcb80..49aa370d 100644 --- a/csp/csp.rkt +++ b/csp/csp.rkt @@ -20,8 +20,8 @@ [else (match-define (cons name other-names) names) (for/and ([val (in-list ($csp-vals csp name))]) - ;; todo: reconsider efficiency of currying every value - (($constraint other-names (curry proc val)) csp))]))) + ;; todo: reconsider efficiency of currying every value + (($constraint other-names (curry proc val)) csp))]))) (define/contract (check-name-in-csp! caller csp name) (symbol? $csp? $var-name? . -> . void?) @@ -61,11 +61,11 @@ (($csp? procedure? (listof (listof $var-name?))) ((or/c #false $var-name?)) . ->* . void?) (set-$csp-constraints! csp (append ($csp-constraints csp) (for/list ([names (in-list namess)]) - (for ([name (in-list names)]) - (check-name-in-csp! 'add-constraint! csp name)) - ($constraint names (if proc-name - (procedure-rename proc proc-name) - proc)))))) + (for ([name (in-list names)]) + (check-name-in-csp! 'add-constraint! csp name)) + ($constraint names (if proc-name + (procedure-rename proc proc-name) + proc)))))) (define/contract (add-pairwise-constraint! csp proc var-names [proc-name #false]) (($csp? procedure? (listof $var-name?)) ($var-name?) . ->* . void?) @@ -78,7 +78,7 @@ (define/contract (no-solutions? csp) ($csp? . -> . boolean?) (for/or ([var (in-list ($csp-vars csp))]) - (empty? ($var-vals var)))) + (zero? (remaining-values var)))) (struct inconsistency-error () #:transparent) @@ -86,14 +86,14 @@ ($csp? unary-constraint? . -> . $csp?) (match-define ($constraint (list constraint-name) proc) constraint) (define new-csp ($csp (for/list ([var (in-list ($csp-vars csp))]) - (match-define ($var name vals) var) - (if (eq? name constraint-name) - ;; special rule: use promise for a constant value - ;; to skip the filtering - ($var name (if (promise? proc) - (force proc) - (filter proc vals))) - var)) + (match-define ($var name vals) var) + (if (eq? name constraint-name) + ;; special rule: use promise for a constant value + ;; to skip the filtering + ($var name (if (promise? proc) + (force proc) + (filter proc vals))) + var)) ;; once the constraint is applied, it can go away ;; ps this is not the same as an "assigned" constraint ;; because the var may still have multiple values @@ -113,7 +113,7 @@ (check-name-in-csp! '$csp-vals csp name) (for/first ([var (in-list ($csp-vars csp))] #:when (eq? name ($var-name var))) - ($var-vals var))) + ($var-vals var))) (struct $arc (name constraint) #:transparent) @@ -126,7 +126,7 @@ (λ (val other-val) (constraint-proc other-val val)))) ; otherwise reverse arg order (define (satisfies-arc? val) (for/or ([other-val (in-list ($csp-vals csp other-name))]) - (proc val other-val))) + (proc val other-val))) (apply-unary-constraint csp ($constraint (list name) (procedure-rename satisfies-arc? @@ -136,18 +136,18 @@ ((listof binary-constraint?) . -> . (listof $arc?)) (for*/list ([constraint (in-list constraints)] [name (in-list ($constraint-names constraint))]) - ($arc name constraint))) + ($arc name constraint))) (define/contract (terminating-at arcs name) ((listof $arc?) $var-name? . -> . (listof $arc?)) (for/list ([arc (in-list arcs)] #:when (eq? name (second ($constraint-names ($arc-constraint arc))))) - arc)) + arc)) (define/contract (constraint-assigned? csp constraint) ($csp? $constraint? . -> . any/c) (for/and ([name (in-list ($constraint-names constraint))]) - (memq name (map $var-name (assigned-vars csp))))) + (memq name (map $var-name (assigned-vars csp))))) (define/contract (remove-assigned-constraints csp [arity #false]) (($csp?) ((or/c #false exact-nonnegative-integer?)) . ->* . $csp?) @@ -156,7 +156,7 @@ (for/list ([constraint (in-list ($csp-constraints csp))] #:unless (and (if arity (= (length ($constraint-names constraint)) arity) #true) (constraint-assigned? csp constraint))) - constraint))) + constraint))) (define (remove-assigned-binary-constraints csp) (remove-assigned-constraints csp 2)) @@ -187,7 +187,7 @@ (define/contract (var-assigned? var) ($var? . -> . boolean?) - (= 1 (length ($var-vals var)))) + (= 1 (remaining-values var))) (define/contract (solution-complete? csp) ($csp? . -> . boolean?) @@ -205,13 +205,24 @@ (match-define-values (assigned unassigned) (assigned-helper csp)) assigned) +(define/contract (var-degree csp var) + ($csp? $var? . -> . exact-nonnegative-integer?) + (for/sum ([constraint (in-list ($csp-constraints csp))] + #:when (constraint-contains-name? constraint ($var-name var))) + 1)) + (define/contract (select-unassigned-var csp) ($csp? . -> . $var?) (define uvars (unassigned-vars csp)) (when (empty? uvars) (raise-argument-error 'select-unassigned-var "csp with unassigned vars" csp)) ;; minimum remaining values (MRV) rule - (argmin (λ (var) (length ($var-vals var))) uvars)) + (define uvars-by-rv (sort uvars < #:key remaining-values)) + (define minimum-remaining-values (remaining-values (first uvars-by-rv))) + (match (takef uvars-by-rv (λ (var) (= minimum-remaining-values (remaining-values var)))) + [(list sole-winner) sole-winner] + [(list mrv-vars ...) ;; use degree as tiebreaker + (first (sort mrv-vars > #:key (λ (var) (var-degree csp var))))])) (define/contract (order-domain-values vals) ((listof any/c) . -> . (listof any/c)) @@ -226,7 +237,7 @@ ($csp? . -> . $csp?) (for ([constraint (in-list ($csp-constraints csp))] #:when (constraint-assigned? csp constraint)) - (unless (constraint csp) (raise (inconsistency-error)))) + (unless (constraint csp) (raise (inconsistency-error)))) (reduce-constraint-arity (remove-assigned-constraints csp))) (define/contract (assign-val csp name val) @@ -270,19 +281,19 @@ (define assigned-names (map $var-name (assigned-vars csp))) ($csp ($csp-vars csp) (for/list ([constraint (in-list ($csp-constraints csp))]) - (match-define ($constraint cnames proc) constraint) - (cond - [(and (<= minimum-arity (length cnames)) - (for/or ([cname (in-list cnames)]) - (memq cname assigned-names))) - ($constraint (for/list ([cname (in-list cnames)] - #:unless (memq cname assigned-names)) - cname) - (reduce-arity proc (for/list ([cname (in-list cnames)]) - (if (memq cname assigned-names) - (car ($csp-vals csp cname)) - cname))))] - [else constraint])))) + (match-define ($constraint cnames proc) constraint) + (cond + [(and (<= minimum-arity (length cnames)) + (for/or ([cname (in-list cnames)]) + (memq cname assigned-names))) + ($constraint (for/list ([cname (in-list cnames)] + #:unless (memq cname assigned-names)) + cname) + (reduce-arity proc (for/list ([cname (in-list cnames)]) + (if (memq cname assigned-names) + (car ($csp-vals csp cname)) + cname))))] + [else constraint])))) (module+ test (define creduce (assign-val ($csp (list ($var 'a '(1 2 3)) ($var 'b '(2 3)) ($var 'c '(1 2 3 4 5))) (list ($constraint '(a b c) (procedure-rename (λ (a b c) (= (+ a b c) 4)) 'summer)))) 'a 1)) @@ -304,15 +315,15 @@ [else ;; we have at least 1 unassigned var (match-define ($var name vals) (select-unassigned-var csp)) (for ([val (in-list (order-domain-values vals))]) - (with-handlers ([inconsistency-error? void]) - (backtrack (infer (assign-val csp name val)))))])))) + (with-handlers ([inconsistency-error? void]) + (backtrack (infer (assign-val csp name val)))))])))) (define/contract (solve* csp [finish-proc values][solution-limit +inf.0]) (($csp?) (procedure? integer?) . ->* . (listof any/c)) (define solutions (for/list ([solution (in-producer (backtracking-solver csp) (void))] [idx (in-range solution-limit)]) - (finish-proc solution))) + (finish-proc solution))) (unless (pair? solutions) (raise (inconsistency-error))) solutions) @@ -330,7 +341,11 @@ (any/c any/c . -> . boolean?) (not (= x y))) +(define/contract (remaining-values var) + ($var? . -> . exact-nonnegative-integer?) + (length ($var-vals var))) + (define/contract (state-count csp) ($csp? . -> . exact-nonnegative-integer?) (for/product ([var (in-list ($csp-vars csp))]) - (length ($var-vals var)))) \ No newline at end of file + (remaining-values var))) \ No newline at end of file diff --git a/csp/test.rkt b/csp/test.rkt index f5ffe4de..230d46a3 100644 --- a/csp/test.rkt +++ b/csp/test.rkt @@ -131,9 +131,15 @@ A collection of 33 coins, consisting of nickels, dimes, and quarters, has a valu |# (define smm (make-csp)) -(add-vars! smm '(s e n d m o r y) (λ () (shuffle (range 10)))) +(add-vars! smm '(s e n d m o r y) (range 10)) (add-constraint! smm positive? '(s)) (add-constraint! smm positive? '(m)) +(add-constraint! smm (λ (d e y) (= (modulo (+ d e) 10) y)) '(d e y)) +(add-constraint! smm (λ (n d r e y) + (= (modulo (+ (word-value n d) (word-value r e)) 100) + (word-value e y))) '(n d r e y)) +(add-constraint! smm (λ (e n d o r y) + (= (modulo (+ (word-value e n d) (word-value o r e)) 1000) (word-value n e y))) '(e n d o r y)) (add-constraint! smm (λ (s e n d m o r y) (= (+ (word-value s e n d) (word-value m o r e)) (word-value m o n e y))) '(s e n d m o r y)) From 7ddc5810db7a9961138318668210bfda760fe66a Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Sat, 13 Oct 2018 09:36:10 -0700 Subject: [PATCH 105/246] winning --- csp/csp.rkt | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/csp/csp.rkt b/csp/csp.rkt index 49aa370d..c317cb21 100644 --- a/csp/csp.rkt +++ b/csp/csp.rkt @@ -220,9 +220,9 @@ (define uvars-by-rv (sort uvars < #:key remaining-values)) (define minimum-remaining-values (remaining-values (first uvars-by-rv))) (match (takef uvars-by-rv (λ (var) (= minimum-remaining-values (remaining-values var)))) - [(list sole-winner) sole-winner] - [(list mrv-vars ...) ;; use degree as tiebreaker - (first (sort mrv-vars > #:key (λ (var) (var-degree csp var))))])) + [(list winning-uvar) winning-uvar] + [(list mrv-uvars ...) ;; use degree as tiebreaker + (argmax (λ (var) (var-degree csp var)) mrv-uvars)])) (define/contract (order-domain-values vals) ((listof any/c) . -> . (listof any/c)) From 85a5db3782786b63c2c40589b0a9ba756feb197d Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Sat, 13 Oct 2018 10:57:07 -0700 Subject: [PATCH 106/246] clarity --- csp/csp.rkt | 60 +++++++++++++++++++++++++++++------------------------ 1 file changed, 33 insertions(+), 27 deletions(-) diff --git a/csp/csp.rkt b/csp/csp.rkt index c317cb21..a00922ff 100644 --- a/csp/csp.rkt +++ b/csp/csp.rkt @@ -30,7 +30,7 @@ (raise-argument-error caller (format "one of these existing csp var names: ~v" names) name))) (define (nary-constraint? constraint n) - (= n (length ($constraint-names constraint)))) + (= n (constraint-arity constraint))) (define/contract (unary-constraint? constraint) ($constraint? . -> . boolean?) @@ -80,14 +80,14 @@ (for/or ([var (in-list ($csp-vars csp))]) (zero? (remaining-values var)))) -(struct inconsistency-error () #:transparent) +(struct inconsistency-signal () #:transparent) (define/contract (apply-unary-constraint csp constraint) ($csp? unary-constraint? . -> . $csp?) - (match-define ($constraint (list constraint-name) proc) constraint) + (match-define ($constraint (list cname) proc) constraint) (define new-csp ($csp (for/list ([var (in-list ($csp-vars csp))]) (match-define ($var name vals) var) - (if (eq? name constraint-name) + (if (eq? name cname) ;; special rule: use promise for a constant value ;; to skip the filtering ($var name (if (promise? proc) @@ -98,7 +98,7 @@ ;; ps this is not the same as an "assigned" constraint ;; because the var may still have multiple values (remove constraint ($csp-constraints csp)))) - (when (no-solutions? new-csp) (raise (inconsistency-error))) + (when (no-solutions? new-csp) (raise (inconsistency-signal))) new-csp) (define/contract (make-nodes-consistent csp) @@ -122,7 +122,7 @@ (match-define ($arc name ($constraint names constraint-proc)) arc) (match-define (list other-name) (remove name names)) (define proc (if (eq? name (first names)) ; name is on left - constraint-proc ; so val goes on left + constraint-proc ; so val stays on left (λ (val other-val) (constraint-proc other-val val)))) ; otherwise reverse arg order (define (satisfies-arc? val) (for/or ([other-val (in-list ($csp-vals csp other-name))]) @@ -154,7 +154,7 @@ ($csp ($csp-vars csp) (for/list ([constraint (in-list ($csp-constraints csp))] - #:unless (and (if arity (= (length ($constraint-names constraint)) arity) #true) + #:unless (and (if arity (= arity (constraint-arity constraint)) #true) (constraint-assigned? csp constraint))) constraint))) @@ -205,6 +205,10 @@ (match-define-values (assigned unassigned) (assigned-helper csp)) assigned) +(define/contract (constraint-arity constraint) + ($constraint? . -> . exact-nonnegative-integer?) + (length ($constraint-names constraint))) + (define/contract (var-degree csp var) ($csp? $var? . -> . exact-nonnegative-integer?) (for/sum ([constraint (in-list ($csp-constraints csp))] @@ -235,15 +239,16 @@ (define/contract (validate-assignments csp) ($csp? . -> . $csp?) - (for ([constraint (in-list ($csp-constraints csp))] - #:when (constraint-assigned? csp constraint)) - (unless (constraint csp) (raise (inconsistency-error)))) + (define assigned-constraints (filter (λ (c) (constraint-assigned? csp c)) ($csp-constraints csp))) + (for ([constraint (in-list (sort assigned-constraints < #:key constraint-arity))] + #:unless (constraint csp)) + (raise (inconsistency-signal))) (reduce-constraint-arity (remove-assigned-constraints csp))) (define/contract (assign-val csp name val) ($csp? $var-name? any/c . -> . $csp?) - (define csp-with-assignment (apply-unary-constraint csp ($constraint (list name) (delay (list val))))) - (validate-assignments csp-with-assignment)) + (define assignment-constraint ($constraint (list name) (delay (list val)))) + (validate-assignments (apply-unary-constraint csp assignment-constraint))) (define (reduce-arity proc pattern) (unless (match (procedure-arity proc) @@ -278,21 +283,22 @@ (define/contract (reduce-constraint-arity csp [minimum-arity 3]) (($csp?) (exact-nonnegative-integer?) . ->* . $csp?) - (define assigned-names (map $var-name (assigned-vars csp))) + (define (assigned-name? cname) (memq cname (map $var-name (assigned-vars csp)))) + (define (partially-assigned? constraint) + (ormap assigned-name? ($constraint-names constraint))) ($csp ($csp-vars csp) (for/list ([constraint (in-list ($csp-constraints csp))]) - (match-define ($constraint cnames proc) constraint) (cond - [(and (<= minimum-arity (length cnames)) - (for/or ([cname (in-list cnames)]) - (memq cname assigned-names))) - ($constraint (for/list ([cname (in-list cnames)] - #:unless (memq cname assigned-names)) - cname) - (reduce-arity proc (for/list ([cname (in-list cnames)]) - (if (memq cname assigned-names) - (car ($csp-vals csp cname)) - cname))))] + [(and (<= minimum-arity (constraint-arity constraint)) + (partially-assigned? constraint)) + (match-define ($constraint cnames proc) constraint) + ($constraint (filter-not assigned-name? cnames) + ;; pattern is mix of values and symbols (indicating variables to persist) + (let ([reduce-arity-pattern (for/list ([cname (in-list cnames)]) + (if (assigned-name? cname) + ($csp-ref csp cname) + cname))]) + (reduce-arity proc reduce-arity-pattern)))] [else constraint])))) (module+ test @@ -315,7 +321,7 @@ [else ;; we have at least 1 unassigned var (match-define ($var name vals) (select-unassigned-var csp)) (for ([val (in-list (order-domain-values vals))]) - (with-handlers ([inconsistency-error? void]) + (with-handlers ([inconsistency-signal? void]) (backtrack (infer (assign-val csp name val)))))])))) (define/contract (solve* csp [finish-proc values][solution-limit +inf.0]) @@ -324,14 +330,14 @@ (for/list ([solution (in-producer (backtracking-solver csp) (void))] [idx (in-range solution-limit)]) (finish-proc solution))) - (unless (pair? solutions) (raise (inconsistency-error))) + (unless (pair? solutions) (raise (inconsistency-signal))) solutions) (define/contract (solve csp [finish-proc values]) (($csp?) (procedure?) . ->* . any/c) (first (solve* csp finish-proc 1))) -(define ($csp-ref csp name) (car ($csp-vals csp name))) +(define ($csp-ref csp name) (first ($csp-vals csp name))) (define/contract (alldiff x y) (any/c any/c . -> . boolean?) From 485c3b3d20d821e60ad98f7d42511763da42ec12 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Sat, 13 Oct 2018 12:18:12 -0700 Subject: [PATCH 107/246] cartesian --- csp/csp.rkt | 21 +++++++++++---------- csp/test.rkt | 43 ++++++++++++++++++++++--------------------- 2 files changed, 33 insertions(+), 31 deletions(-) diff --git a/csp/csp.rkt b/csp/csp.rkt index a00922ff..f248c881 100644 --- a/csp/csp.rkt +++ b/csp/csp.rkt @@ -7,6 +7,13 @@ (define (make-csp) ($csp null null)) (define debug (make-parameter #false)) +(define (in-cartesian xss) + (in-generator (let loop ([xss xss][args empty]) + (if (null? xss) + (yield (reverse args)) + (for ([x (in-list (car xss))]) + (loop (cdr xss) (cons x args))))))) + (struct $var (name vals) #:transparent) (define $var-name? symbol?) (struct $constraint (names proc) #:transparent @@ -14,14 +21,9 @@ (λ (constraint csp) (unless ($csp? csp) (raise-argument-error '$constraint-proc "$csp" csp)) - (match-define ($constraint names proc) constraint) - (cond - [(empty? names) (proc)] - [else - (match-define (cons name other-names) names) - (for/and ([val (in-list ($csp-vals csp name))]) - ;; todo: reconsider efficiency of currying every value - (($constraint other-names (curry proc val)) csp))]))) + ;; apply proc in many-to-many style + (for/and ([args (in-cartesian (map (λ (cname) ($csp-vals csp cname)) ($constraint-names constraint)))]) + (apply ($constraint-proc constraint) args)))) (define/contract (check-name-in-csp! caller csp name) (symbol? $csp? $var-name? . -> . void?) @@ -77,8 +79,7 @@ (define/contract (no-solutions? csp) ($csp? . -> . boolean?) - (for/or ([var (in-list ($csp-vars csp))]) - (zero? (remaining-values var)))) + (zero? (state-count csp))) (struct inconsistency-signal () #:transparent) diff --git a/csp/test.rkt b/csp/test.rkt index 230d46a3..c26b36d4 100644 --- a/csp/test.rkt +++ b/csp/test.rkt @@ -20,7 +20,7 @@ (define (word-value . xs) (let ([xs (reverse xs)]) (for/sum ([i (in-range (length xs))]) - (* (list-ref xs i) (expt 10 i))))) + (* (list-ref xs i) (expt 10 i))))) (add-pairwise-constraint! ttf alldiff= '(t w o f u r)) (add-constraint! ttf (λ (o r) (= (modulo (+ o o) 10) r)) '(o r)) @@ -136,13 +136,13 @@ A collection of 33 coins, consisting of nickels, dimes, and quarters, has a valu (add-constraint! smm positive? '(m)) (add-constraint! smm (λ (d e y) (= (modulo (+ d e) 10) y)) '(d e y)) (add-constraint! smm (λ (n d r e y) - (= (modulo (+ (word-value n d) (word-value r e)) 100) - (word-value e y))) '(n d r e y)) + (= (modulo (+ (word-value n d) (word-value r e)) 100) + (word-value e y))) '(n d r e y)) (add-constraint! smm (λ (e n d o r y) - (= (modulo (+ (word-value e n d) (word-value o r e)) 1000) (word-value n e y))) '(e n d o r y)) + (= (modulo (+ (word-value e n d) (word-value o r e)) 1000) (word-value n e y))) '(e n d o r y)) (add-constraint! smm (λ (s e n d m o r y) - (= (+ (word-value s e n d) (word-value m o r e)) - (word-value m o n e y))) '(s e n d m o r y)) + (= (+ (word-value s e n d) (word-value m o r e)) + (word-value m o n e y))) '(s e n d m o r y)) (add-pairwise-constraint! smm alldiff= '(s e n d m o r y)) ;; todo: too slow @@ -150,19 +150,20 @@ A collection of 33 coins, consisting of nickels, dimes, and quarters, has a valu ;; queens problem ;; place queens on chessboard so they do not intersect -(define queens-problem (make-csp)) -(define queens '(q0 q1 q2 q3 q4 q5 q6 q7)) -(define rows (range 8)) -(add-vars! queens-problem queens rows) -(for* ([(qa qa-col) (in-indexed queens)] - [(qb qb-col) (in-indexed queens)] - #:when (< qa-col qb-col)) - (add-constraint! queens-problem - (λ (qa-row qb-row) - (and - (not (= (abs (- qa-row qb-row)) (abs (- qa-col qb-col)))) ; same diagonal? - (not (= qa-row qb-row)))) ; same row? - (list qa qb))) - -(check-equal? 92 (length (time (solve* queens-problem)))) +(define queens (make-csp)) +(define qs (for/list ([q 8]) (string->symbol (format "q~a" q)))) +(define rows (range (length qs))) +(add-vars! queens qs rows) +(define (q-col q) (string->number (string-trim (symbol->string q) "q"))) +(for* ([qs (in-combinations qs 2)]) + (match-define (list qa qb) qs) + (match-define (list qa-col qb-col) (map q-col qs)) + (add-constraint! queens + (λ (qa-row qb-row) + (and + (not (= (abs (- qa-row qb-row)) (abs (- qa-col qb-col)))) ; same diagonal? + (not (= qa-row qb-row)))) ; same row? + (list qa qb))) + +(check-equal? 92 (length (time (solve* queens)))) From b5be07c005073ff9dc9a7951ea76fe985fef20f2 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Sat, 13 Oct 2018 16:33:13 -0700 Subject: [PATCH 108/246] adjust --- csp/csp.rkt | 122 +++++++++++++++++++++++++++------------------------ csp/test.rkt | 2 +- 2 files changed, 65 insertions(+), 59 deletions(-) diff --git a/csp/csp.rkt b/csp/csp.rkt index f248c881..c2914034 100644 --- a/csp/csp.rkt +++ b/csp/csp.rkt @@ -7,12 +7,12 @@ (define (make-csp) ($csp null null)) (define debug (make-parameter #false)) -(define (in-cartesian xss) - (in-generator (let loop ([xss xss][args empty]) - (if (null? xss) - (yield (reverse args)) - (for ([x (in-list (car xss))]) - (loop (cdr xss) (cons x args))))))) +(define (in-cartesian argss) + (in-generator (let loop ([argss argss][acc empty]) + (if (null? argss) + (yield (reverse acc)) + (for ([arg (in-list (car argss))]) + (loop (cdr argss) (cons arg acc))))))) (struct $var (name vals) #:transparent) (define $var-name? symbol?) @@ -48,12 +48,11 @@ #:result (set-$csp-vars! csp vars)) ([name (in-list names)]) (when (memq name (map $var-name vars)) - (raise-argument-error 'add-vars! "var that doesn't exist" name)) - (append vars - (let ([vals (if (procedure? vals-or-procedure) - (vals-or-procedure) - vals-or-procedure)]) - (list ($var name vals)))))) + (raise-argument-error 'add-vars! "var that doesn't already exist" name)) + (define vals (if (procedure? vals-or-procedure) + (vals-or-procedure) + vals-or-procedure)) + (append vars (list ($var name vals))))) (define/contract (add-var! csp name [vals-or-procedure empty]) (($csp? $var-name?) ((or/c (listof any/c) procedure?)) . ->* . void?) @@ -64,7 +63,7 @@ (set-$csp-constraints! csp (append ($csp-constraints csp) (for/list ([names (in-list namess)]) (for ([name (in-list names)]) - (check-name-in-csp! 'add-constraint! csp name)) + (check-name-in-csp! 'add-constraints! csp name)) ($constraint names (if proc-name (procedure-rename proc proc-name) proc)))))) @@ -88,19 +87,21 @@ (match-define ($constraint (list cname) proc) constraint) (define new-csp ($csp (for/list ([var (in-list ($csp-vars csp))]) (match-define ($var name vals) var) - (if (eq? name cname) - ;; special rule: use promise for a constant value - ;; to skip the filtering - ($var name (if (promise? proc) - (force proc) - (filter proc vals))) - var)) + (cond + [(eq? name cname) + ;; special rule: use promise for a constant value + ;; to skip the filtering + ($var name (if (promise? proc) + (force proc) + (filter proc vals)))] + [else var])) ;; once the constraint is applied, it can go away ;; ps this is not the same as an "assigned" constraint ;; because the var may still have multiple values (remove constraint ($csp-constraints csp)))) - (when (no-solutions? new-csp) (raise (inconsistency-signal))) - new-csp) + (if (assigned-name? new-csp cname) + (validate-assignments (make-arcs-consistent new-csp #:mac cname)) + new-csp)) (define/contract (make-nodes-consistent csp) ($csp? . -> . $csp?) @@ -162,13 +163,22 @@ (define (remove-assigned-binary-constraints csp) (remove-assigned-constraints csp 2)) -(define/contract (ac-3 csp) - ($csp? . -> . $csp?) - ;; as described by AIMA @ 265 - (define all-arcs (binary-constraints->arcs (filter binary-constraint? ($csp-constraints csp)))) +(define/contract (make-arcs-consistent csp #:mac [mac-name #f]) + (($csp?) (#:mac (or/c $var-name? #f)) . ->* . $csp?) + ;; csp is arc-consistent if every pair of variables (x y) + ;; has values in their domain that satisfy every binary constraint + ;; AC-3 as described by AIMA @ 265 + (define (mac-condition? arc) + (and + (constraint-contains-name? ($arc-constraint arc) mac-name) + (memq ($arc-name arc) (map $var-name (unassigned-vars csp))))) + (define starting-arcs + (for/list ([arc (in-list (binary-constraints->arcs (filter binary-constraint? ($csp-constraints csp))))] + #:when ((if mac-name mac-condition? values) arc)) + arc)) (for/fold ([csp csp] - [arcs all-arcs] - #:result (remove-assigned-binary-constraints csp)) + [arcs starting-arcs] + #:result csp) ([i (in-naturals)] #:break (empty? arcs)) (match-define (cons arc other-arcs) arcs) @@ -178,13 +188,7 @@ ;; revision did not reduce the domain, so keep going other-arcs ;; revision reduced the domain, so supplement the list of arcs - (remove-duplicates (append (all-arcs . terminating-at . name) other-arcs)))))) - -(define/contract (make-arcs-consistent csp) - ($csp? . -> . $csp?) - ;; csp is arc-consistent if every pair of variables (x y) - ;; has values in their domain that satisfy every binary constraint - (ac-3 csp)) + (remove-duplicates (append (starting-arcs . terminating-at . name) other-arcs)))))) (define/contract (var-assigned? var) ($var? . -> . boolean?) @@ -232,6 +236,7 @@ (define/contract (order-domain-values vals) ((listof any/c) . -> . (listof any/c)) ;; todo: least constraining value sort + vals) (define/contract (constraint-contains-name? constraint name) @@ -249,7 +254,7 @@ (define/contract (assign-val csp name val) ($csp? $var-name? any/c . -> . $csp?) (define assignment-constraint ($constraint (list name) (delay (list val)))) - (validate-assignments (apply-unary-constraint csp assignment-constraint))) + (apply-unary-constraint csp assignment-constraint)) (define (reduce-arity proc pattern) (unless (match (procedure-arity proc) @@ -282,25 +287,29 @@ (check-equal? 10 ((reduce-arity f '(1 b 3 d)) 2 4)) (check-equal? 10 ((reduce-arity f '(a b 3 d)) 1 2 4))) +(define/contract (assigned-name? csp name) + ($csp? $var-name? . -> . boolean?) + (and (memq name (map $var-name (assigned-vars csp))) #true)) + (define/contract (reduce-constraint-arity csp [minimum-arity 3]) (($csp?) (exact-nonnegative-integer?) . ->* . $csp?) - (define (assigned-name? cname) (memq cname (map $var-name (assigned-vars csp)))) - (define (partially-assigned? constraint) - (ormap assigned-name? ($constraint-names constraint))) - ($csp ($csp-vars csp) - (for/list ([constraint (in-list ($csp-constraints csp))]) - (cond - [(and (<= minimum-arity (constraint-arity constraint)) - (partially-assigned? constraint)) - (match-define ($constraint cnames proc) constraint) - ($constraint (filter-not assigned-name? cnames) - ;; pattern is mix of values and symbols (indicating variables to persist) - (let ([reduce-arity-pattern (for/list ([cname (in-list cnames)]) - (if (assigned-name? cname) - ($csp-ref csp cname) - cname))]) - (reduce-arity proc reduce-arity-pattern)))] - [else constraint])))) + (let ([assigned-name? (curry assigned-name? csp)]) + (define (partially-assigned? constraint) + (ormap assigned-name? ($constraint-names constraint))) + ($csp ($csp-vars csp) + (for/list ([constraint (in-list ($csp-constraints csp))]) + (cond + [(and (<= minimum-arity (constraint-arity constraint)) + (partially-assigned? constraint)) + (match-define ($constraint cnames proc) constraint) + ($constraint (filter-not assigned-name? cnames) + ;; pattern is mix of values and symbols (indicating variables to persist) + (let ([reduce-arity-pattern (for/list ([cname (in-list cnames)]) + (if (assigned-name? cname) + ($csp-ref csp cname) + cname))]) + (reduce-arity proc reduce-arity-pattern)))] + [else constraint]))))) (module+ test (define creduce (assign-val ($csp (list ($var 'a '(1 2 3)) ($var 'b '(2 3)) ($var 'c '(1 2 3 4 5))) (list ($constraint '(a b c) (procedure-rename (λ (a b c) (= (+ a b c) 4)) 'summer)))) 'a 1)) @@ -308,13 +317,10 @@ (make-arcs-consistent (reduce-constraint-arity creduce)) ($csp (list ($var 'a '(1)) ($var 'b '(2)) ($var 'c '(1))) '()))) -;; todo: inferences between assignments -(define/contract (infer csp) - ($csp? . -> . $csp?) - (validate-assignments (make-arcs-consistent csp))) (define/contract (backtracking-solver csp) ($csp? . -> . generator?) + ;; as described by AIMA @ 271 (generator () (let backtrack ([csp (make-arcs-consistent (make-nodes-consistent csp))]) (cond @@ -323,7 +329,7 @@ (match-define ($var name vals) (select-unassigned-var csp)) (for ([val (in-list (order-domain-values vals))]) (with-handlers ([inconsistency-signal? void]) - (backtrack (infer (assign-val csp name val)))))])))) + (backtrack (assign-val csp name val))))])))) (define/contract (solve* csp [finish-proc values][solution-limit +inf.0]) (($csp?) (procedure? integer?) . ->* . (listof any/c)) diff --git a/csp/test.rkt b/csp/test.rkt index c26b36d4..f3fa6b26 100644 --- a/csp/test.rkt +++ b/csp/test.rkt @@ -109,7 +109,7 @@ A collection of 33 coins, consisting of nickels, dimes, and quarters, has a valu |# (define xsum (make-csp)) -(add-vars! xsum '(l1 l2 l3 l4 r1 r2 r3 r4 x) (λ () (shuffle (range 1 10)))) +(add-vars! xsum '(l1 l2 l3 l4 r1 r2 r3 r4 x) (range 1 10)) (add-pairwise-constraint! xsum < '(l1 l2 l3 l4)) (add-pairwise-constraint! xsum < '(r1 r2 r3 r4)) (add-constraint! xsum (λ (l1 l2 l3 l4 x) (= 27 (+ l1 l2 l3 l4 x))) '(l1 l2 l3 l4 x)) From e61783961d861fc4fa9420439ab5a524568fab3f Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Sat, 13 Oct 2018 19:37:19 -0700 Subject: [PATCH 109/246] changes --- csp/csp.rkt | 136 +++++++++----------- csp/main.rkt | 13 +- csp/{ => port}/constraint.rkt | 0 csp/{ => port}/domain.rkt | 0 csp/{ => port}/helper.rkt | 0 csp/port/main.rkt | 13 ++ csp/{ => port}/problem.rkt | 0 csp/{ => port}/solver.rkt | 0 csp/{ => port}/test-classes.rkt | 0 csp/{ => port}/test-einstein.rkt | 0 csp/port/test-problems.rkt | 130 +++++++++++++++++++ csp/{ => port}/variable.rkt | 0 csp/test-problems.rkt | 214 +++++++++++++++++-------------- csp/test.rkt | 174 ++----------------------- 14 files changed, 338 insertions(+), 342 deletions(-) rename csp/{ => port}/constraint.rkt (100%) rename csp/{ => port}/domain.rkt (100%) rename csp/{ => port}/helper.rkt (100%) create mode 100644 csp/port/main.rkt rename csp/{ => port}/problem.rkt (100%) rename csp/{ => port}/solver.rkt (100%) rename csp/{ => port}/test-classes.rkt (100%) rename csp/{ => port}/test-einstein.rkt (100%) create mode 100644 csp/port/test-problems.rkt rename csp/{ => port}/variable.rkt (100%) diff --git a/csp/csp.rkt b/csp/csp.rkt index c2914034..4963429c 100644 --- a/csp/csp.rkt +++ b/csp/csp.rkt @@ -42,17 +42,18 @@ ($constraint? . -> . boolean?) (nary-constraint? constraint 2)) -(define/contract (add-vars! csp names [vals-or-procedure empty]) - (($csp? (listof $var-name?)) ((or/c (listof any/c) procedure?)) . ->* . void?) +(define/contract (add-vars! csp names-or-procedure [vals-or-procedure empty]) + (($csp? (or/c (listof $var-name?) procedure?)) ((or/c (listof any/c) procedure?)) . ->* . void?) (for/fold ([vars ($csp-vars csp)] #:result (set-$csp-vars! csp vars)) - ([name (in-list names)]) + ([name (in-list (if (procedure? names-or-procedure) + (names-or-procedure) + names-or-procedure))]) (when (memq name (map $var-name vars)) (raise-argument-error 'add-vars! "var that doesn't already exist" name)) - (define vals (if (procedure? vals-or-procedure) - (vals-or-procedure) - vals-or-procedure)) - (append vars (list ($var name vals))))) + (append vars (list ($var name (if (procedure? vals-or-procedure) + (vals-or-procedure) + vals-or-procedure)))))) (define/contract (add-var! csp name [vals-or-procedure empty]) (($csp? $var-name?) ((or/c (listof any/c) procedure?)) . ->* . void?) @@ -84,24 +85,29 @@ (define/contract (apply-unary-constraint csp constraint) ($csp? unary-constraint? . -> . $csp?) - (match-define ($constraint (list cname) proc) constraint) - (define new-csp ($csp (for/list ([var (in-list ($csp-vars csp))]) - (match-define ($var name vals) var) - (cond - [(eq? name cname) - ;; special rule: use promise for a constant value - ;; to skip the filtering - ($var name (if (promise? proc) - (force proc) - (filter proc vals)))] - [else var])) - ;; once the constraint is applied, it can go away - ;; ps this is not the same as an "assigned" constraint - ;; because the var may still have multiple values - (remove constraint ($csp-constraints csp)))) - (if (assigned-name? new-csp cname) - (validate-assignments (make-arcs-consistent new-csp #:mac cname)) - new-csp)) + (define (update-csp-vars name vals) + (for/list ([var (in-list ($csp-vars csp))]) + (if (eq? ($var-name var) name) + ($var name vals) + var))) + (match-define ($constraint (list name) proc) constraint) + (match (if (promise? proc) + (force proc) + (filter proc ($csp-vals csp name))) + [(list) (raise (inconsistency-signal))] + [(list assigned-val) (make-nodes-consistent + (remove-assigned-constraints + (reduce-constraint-arity + (validate-assignments + (make-arcs-consistent + ($csp + (update-csp-vars name (list assigned-val)) + ($csp-constraints csp)) #:mac name)))))] + [(list new-vals ...) ($csp (update-csp-vars name new-vals) + ;; once the constraint is applied, it can go away + ;; ps this is not the same as an "assigned" constraint + ;; because the var may still have multiple values + (remove constraint ($csp-constraints csp)))])) (define/contract (make-nodes-consistent csp) ($csp? . -> . $csp?) @@ -160,9 +166,6 @@ (constraint-assigned? csp constraint))) constraint))) -(define (remove-assigned-binary-constraints csp) - (remove-assigned-constraints csp 2)) - (define/contract (make-arcs-consistent csp #:mac [mac-name #f]) (($csp?) (#:mac (or/c $var-name? #f)) . ->* . $csp?) ;; csp is arc-consistent if every pair of variables (x y) @@ -221,22 +224,27 @@ 1)) (define/contract (select-unassigned-var csp) - ($csp? . -> . $var?) - (define uvars (unassigned-vars csp)) - (when (empty? uvars) - (raise-argument-error 'select-unassigned-var "csp with unassigned vars" csp)) - ;; minimum remaining values (MRV) rule - (define uvars-by-rv (sort uvars < #:key remaining-values)) - (define minimum-remaining-values (remaining-values (first uvars-by-rv))) - (match (takef uvars-by-rv (λ (var) (= minimum-remaining-values (remaining-values var)))) - [(list winning-uvar) winning-uvar] - [(list mrv-uvars ...) ;; use degree as tiebreaker - (argmax (λ (var) (var-degree csp var)) mrv-uvars)])) + ($csp? . -> . (or/c #f $var?)) + (match (unassigned-vars csp) + [(list) #f] + [(list uvars ...) + ;; minimum remaining values (MRV) rule + (define uvars-by-rv (sort uvars < #:key remaining-values)) + (define minimum-remaining-values (remaining-values (first uvars-by-rv))) + (match (takef uvars-by-rv (λ (var) (= minimum-remaining-values (remaining-values var)))) + [(list winning-uvar) winning-uvar] + [(list mrv-uvars ...) + ;; use degree as tiebreaker for mrv + (define uvars-by-degree (sort mrv-uvars > #:key (λ (var) (var-degree csp var)))) + (define max-degree (var-degree csp (first uvars-by-degree))) + ;; use random tiebreaker for degree + (match (takef uvars-by-degree (λ (var) (= max-degree (var-degree csp var)))) + [(list winning-uvar) winning-uvar] + [(list degree-uvars ...) (first (shuffle degree-uvars))])])])) (define/contract (order-domain-values vals) ((listof any/c) . -> . (listof any/c)) ;; todo: least constraining value sort - vals) (define/contract (constraint-contains-name? constraint name) @@ -249,7 +257,7 @@ (for ([constraint (in-list (sort assigned-constraints < #:key constraint-arity))] #:unless (constraint csp)) (raise (inconsistency-signal))) - (reduce-constraint-arity (remove-assigned-constraints csp))) + csp) (define/contract (assign-val csp name val) ($csp? $var-name? any/c . -> . $csp?) @@ -278,28 +286,19 @@ (values (cons (car vals) acc) xs (cdr vals)))))) reduced-arity-name)) -(module+ test - (require rackunit) - (define f (λ (a b c d) (+ a b c d))) - (check-equal? 10 ((reduce-arity f '(1 b c d)) 2 3 4)) - (check-equal? 10 ((reduce-arity f '(1 2 c d)) 3 4)) - (check-equal? 10 ((reduce-arity f '(1 2 3 d)) 4)) - (check-equal? 10 ((reduce-arity f '(1 b 3 d)) 2 4)) - (check-equal? 10 ((reduce-arity f '(a b 3 d)) 1 2 4))) - (define/contract (assigned-name? csp name) ($csp? $var-name? . -> . boolean?) (and (memq name (map $var-name (assigned-vars csp))) #true)) -(define/contract (reduce-constraint-arity csp [minimum-arity 3]) - (($csp?) (exact-nonnegative-integer?) . ->* . $csp?) +(define/contract (reduce-constraint-arity csp [minimum-arity #false]) + (($csp?) ((or/c #false exact-nonnegative-integer?)) . ->* . $csp?) (let ([assigned-name? (curry assigned-name? csp)]) (define (partially-assigned? constraint) (ormap assigned-name? ($constraint-names constraint))) ($csp ($csp-vars csp) (for/list ([constraint (in-list ($csp-constraints csp))]) (cond - [(and (<= minimum-arity (constraint-arity constraint)) + [(and (if minimum-arity (<= minimum-arity (constraint-arity constraint)) #true) (partially-assigned? constraint)) (match-define ($constraint cnames proc) constraint) ($constraint (filter-not assigned-name? cnames) @@ -311,30 +310,21 @@ (reduce-arity proc reduce-arity-pattern)))] [else constraint]))))) -(module+ test - (define creduce (assign-val ($csp (list ($var 'a '(1 2 3)) ($var 'b '(2 3)) ($var 'c '(1 2 3 4 5))) (list ($constraint '(a b c) (procedure-rename (λ (a b c) (= (+ a b c) 4)) 'summer)))) 'a 1)) - (check-equal? - (make-arcs-consistent (reduce-constraint-arity creduce)) - ($csp (list ($var 'a '(1)) ($var 'b '(2)) ($var 'c '(1))) '()))) - - -(define/contract (backtracking-solver csp) - ($csp? . -> . generator?) +(define/contract (in-solutions csp) + ($csp? . -> . sequence?) ;; as described by AIMA @ 271 - (generator () - (let backtrack ([csp (make-arcs-consistent (make-nodes-consistent csp))]) - (cond - [(solution-complete? csp) (yield csp)] - [else ;; we have at least 1 unassigned var - (match-define ($var name vals) (select-unassigned-var csp)) - (for ([val (in-list (order-domain-values vals))]) - (with-handlers ([inconsistency-signal? void]) - (backtrack (assign-val csp name val))))])))) + (in-generator (let backtrack ([csp (make-arcs-consistent (make-nodes-consistent csp))]) + (match (select-unassigned-var csp) + [#f (yield csp)] + [($var name vals) + (for ([val (in-list (order-domain-values vals))]) + (with-handlers ([inconsistency-signal? void]) + (backtrack (assign-val csp name val))))])))) (define/contract (solve* csp [finish-proc values][solution-limit +inf.0]) - (($csp?) (procedure? integer?) . ->* . (listof any/c)) + (($csp?) (procedure? integer?) . ->* . (non-empty-listof any/c)) (define solutions - (for/list ([solution (in-producer (backtracking-solver csp) (void))] + (for/list ([solution (in-solutions csp)] [idx (in-range solution-limit)]) (finish-proc solution))) (unless (pair? solutions) (raise (inconsistency-signal))) diff --git a/csp/main.rkt b/csp/main.rkt index 73d16dac..f4d54358 100644 --- a/csp/main.rkt +++ b/csp/main.rkt @@ -1,13 +1,4 @@ #lang racket/base -(require - "problem.rkt" - "constraint.rkt" - "solver.rkt" - "helper.rkt") - -(provide (all-from-out - "problem.rkt" - "constraint.rkt" - "solver.rkt" - "helper.rkt")) +(require "port/main.rkt") +(provide (all-from-out "port/main.rkt")) diff --git a/csp/constraint.rkt b/csp/port/constraint.rkt similarity index 100% rename from csp/constraint.rkt rename to csp/port/constraint.rkt diff --git a/csp/domain.rkt b/csp/port/domain.rkt similarity index 100% rename from csp/domain.rkt rename to csp/port/domain.rkt diff --git a/csp/helper.rkt b/csp/port/helper.rkt similarity index 100% rename from csp/helper.rkt rename to csp/port/helper.rkt diff --git a/csp/port/main.rkt b/csp/port/main.rkt new file mode 100644 index 00000000..73d16dac --- /dev/null +++ b/csp/port/main.rkt @@ -0,0 +1,13 @@ +#lang racket/base +(require + "problem.rkt" + "constraint.rkt" + "solver.rkt" + "helper.rkt") + +(provide (all-from-out + "problem.rkt" + "constraint.rkt" + "solver.rkt" + "helper.rkt")) + diff --git a/csp/problem.rkt b/csp/port/problem.rkt similarity index 100% rename from csp/problem.rkt rename to csp/port/problem.rkt diff --git a/csp/solver.rkt b/csp/port/solver.rkt similarity index 100% rename from csp/solver.rkt rename to csp/port/solver.rkt diff --git a/csp/test-classes.rkt b/csp/port/test-classes.rkt similarity index 100% rename from csp/test-classes.rkt rename to csp/port/test-classes.rkt diff --git a/csp/test-einstein.rkt b/csp/port/test-einstein.rkt similarity index 100% rename from csp/test-einstein.rkt rename to csp/port/test-einstein.rkt diff --git a/csp/port/test-problems.rkt b/csp/port/test-problems.rkt new file mode 100644 index 00000000..7913fb4e --- /dev/null +++ b/csp/port/test-problems.rkt @@ -0,0 +1,130 @@ +#lang racket +(require "main.rkt" "test-classes.rkt") +(require rackunit) + + +;; ABC problem: +;; what is the minimum value of + +;; ABC +;; ------- +;; A+B+C + + +(define abc-problem (new problem%)) +(send abc-problem add-variables '("a" "b" "c") (range 1 10)) +(define (test-solution s) (let ([a (hash-ref s "a")] + [b (hash-ref s "b")] + [c (hash-ref s "c")]) + (/ (+ (* 100 a) (* 10 b) c) (+ a b c)))) + +(check-hash-items (argmin test-solution (send abc-problem get-solutions)) + #hash(("c" . 9) ("b" . 9) ("a" . 1))) + + +;; quarter problem: +;; 26 coins, dollars and quarters +;; that add up to $17. + +(define quarter-problem (new problem%)) +(send quarter-problem add-variables '("dollars" "quarters") (range 1 27)) +(send quarter-problem add-constraint (λ(d q) (= 17 (+ d (* 0.25 q)))) '("dollars" "quarters")) +(send quarter-problem add-constraint (λ(d q) (= 26 (+ d q))) '("dollars" "quarters")) +(check-hash-items (send quarter-problem get-solution) '#hash(("dollars" . 14) ("quarters" . 12))) + +;; coin problem 2 +#| +A collection of 33 coins, consisting of nickels, dimes, and quarters, has a value of $3.30. If there are three times as many nickels as quarters, and one-half as many dimes as nickels, how many coins of each kind are there? +|# + +(define nickel-problem (new problem%)) +(send nickel-problem add-variables '(nickels dimes quarters) (range 1 34)) +(send nickel-problem add-constraint (λ(n d q) (= 33 (+ n d q))) '(nickels dimes quarters)) +(send nickel-problem add-constraint (λ(n d q) (= 3.30 (+ (* 0.05 n) (* 0.1 d) (* 0.25 q)))) '(nickels dimes quarters)) +(send nickel-problem add-constraint (λ(n q) (= n (* 3 q))) '(nickels quarters)) +(send nickel-problem add-constraint (λ(d n) (= n (* 2 d))) '(dimes nickels)) +(check-hash-items (send nickel-problem get-solution) #hash((nickels . 18) (quarters . 6) (dimes . 9))) + +;; word math +#| +# Assign equal values to equal letters, and different values to +# different letters, in a way that satisfies the following sum: +# +# TWO +# + TWO +# ----- +# FOUR +|# + + +(define two-four-problem (new problem%)) +(send two-four-problem add-variables '(t w o f u r) (range 10)) +(send two-four-problem add-constraint (new all-different-constraint%)) +(send two-four-problem add-constraint (λ(t w o) (> (word-value t w o) 99)) '(t w o)) +(send two-four-problem add-constraint (λ(f o u r) (> (word-value f o u r) 999)) '(f o u r)) +(send two-four-problem add-constraint + (λ (t w o f u r) + (let ([two (word-value t w o)] + [four (word-value f o u r)]) + ((two . + . two) . = . four))) '(t w o f u r)) +(check-equal? (length (send two-four-problem get-solutions)) 7) +(send two-four-problem add-constraint (λ(r) (= r 0)) '(r)) +(check-hash-items (send two-four-problem get-solution) #hash((o . 5) (w . 6) (u . 3) (f . 1) (r . 0) (t . 7))) + + +;; xsum +#| +# Reorganize the following numbers in a way that each line of +# 5 numbers sum to 27. +# +# 1 6 +# 2 7 +# 3 +# 8 4 +# 9 5 +# +|# + +(define xsum (new problem%)) +(send xsum add-variables '(l1 l2 l3 l4 r1 r2 r3 r4 x) (range 10)) +(send xsum add-constraint (λ (l1 l2 l3 l4 x) + (and (< l1 l2 l3 l4) + (= 27 (+ l1 l2 l3 l4 x)))) '(l1 l2 l3 l4 x)) +(send xsum add-constraint (λ (r1 r2 r3 r4 x) + (and (< r1 r2 r3 r4) + (= 27 (+ r1 r2 r3 r4 x)))) '(r1 r2 r3 r4 x)) +(send xsum add-constraint (new all-different-constraint%)) +(check-equal? (length (send xsum get-solutions)) 8) + + + +;; send more money problem +#| +# Assign equal values to equal letters, and different values to +# different letters, in a way that satisfies the following sum: +# +# SEND +# + MORE +# ------ +# MONEY +|# + + +;; queens problem +;; place queens on chessboard so they do not intersect + +(define queens-problem (new problem%)) +(define cols (range 8)) +(define rows (range 8)) +(send queens-problem add-variables cols rows) +(for* ([col1 (in-list cols)] [col2 (in-list cols)] #:when (< col1 col2)) + (send queens-problem add-constraint (λ(row1 row2 [col1 col1][col2 col2]) + (and + ;; test if two cells are on a diagonal + (not (= (abs (- row1 row2)) (abs (- col1 col2)))) + ;; test if two cells are in same row + (not (= row1 row2)))) (list col1 col2))) +(check-equal? (length (send queens-problem get-solutions)) 92) + +(module+ main + (displayln "Tests passed")) \ No newline at end of file diff --git a/csp/variable.rkt b/csp/port/variable.rkt similarity index 100% rename from csp/variable.rkt rename to csp/port/variable.rkt diff --git a/csp/test-problems.rkt b/csp/test-problems.rkt index 203e0cdb..b7c88e61 100644 --- a/csp/test-problems.rkt +++ b/csp/test-problems.rkt @@ -1,75 +1,98 @@ -#lang racket -(require "main.rkt" "test-classes.rkt") -(require rackunit) +#lang at-exp racket +(require "csp.rkt" rackunit) + +(define demo (make-csp)) +(add-vars! demo '(t w) (range 7)) +(add-var! demo 'o '(2 6 7)) + +(define (sum-three t w o) (= 3 (+ t w o))) +(add-constraint! demo sum-three '(t w o)) +(add-pairwise-constraint! demo alldiff= '(t w o)) +(add-pairwise-constraint! demo < '(t w o)) + +(check-equal? (time (solve demo)) ($csp (list ($var 't '(0)) ($var 'w '(1)) ($var 'o '(2))) '())) + + +;; TWO + TWO = FOUR +(define ttf (make-csp)) +(add-vars! ttf '(t w o f u r) (reverse (range 10))) + +(define (word-value . xs) + (let ([xs (reverse xs)]) + (for/sum ([i (in-range (length xs))]) + (* (list-ref xs i) (expt 10 i))))) + +(add-pairwise-constraint! ttf alldiff= '(t w o f u r)) +(add-constraint! ttf (λ (o r) (= (modulo (+ o o) 10) r)) '(o r)) +(add-constraint! ttf (λ (t w o f u r) (= (+ (word-value t w o) (word-value t w o)) + (word-value f o u r))) '(t w o f u r)) +(add-constraint! ttf positive? '(t)) +(add-constraint! ttf positive? '(f)) + +(define ttf-solution (time (solve ttf))) +(check-equal? ttf-solution + ($csp + (list + ($var 't '(7)) + ($var 'w '(3)) + ($var 'o '(4)) + ($var 'f '(1)) + ($var 'u '(6)) + ($var 'r '(8))) + '())) + +(define (ttf-print csp) + (format "~a~a~a + ~a~a~a = ~a~a~a~a" ($csp-ref csp 't) ($csp-ref csp 'w) ($csp-ref csp 'o) ($csp-ref csp 't) ($csp-ref csp 'w) ($csp-ref csp 'o) ($csp-ref csp 'f) ($csp-ref csp 'o) ($csp-ref csp 'u) ($csp-ref csp 'r))) + +(check-equal? (time (solve ttf-solution ttf-print)) "734 + 734 = 1468") ;; ABC problem: ;; what is the minimum value of - ;; ABC ;; ------- ;; A+B+C +(define abc (make-csp)) +(add-vars! abc '(a b c) (range 1 10)) +(define (solution-score sol) + (let ([a ($csp-ref sol 'a)] + [b ($csp-ref sol 'b)] + [c ($csp-ref sol 'c)]) + (/ (+ (* 100 a) (* 10 b) c) (+ a b c)))) -(define abc-problem (new problem%)) -(send abc-problem add-variables '("a" "b" "c") (range 1 10)) -(define (test-solution s) (let ([a (hash-ref s "a")] - [b (hash-ref s "b")] - [c (hash-ref s "c")]) - (/ (+ (* 100 a) (* 10 b) c) (+ a b c)))) -(check-hash-items (argmin test-solution (send abc-problem get-solutions)) - #hash(("c" . 9) ("b" . 9) ("a" . 1))) +(define abc-sols (time (solve* abc))) +(check-equal? (* 9 9 9) (length abc-sols)) +(check-equal? + (argmin solution-score abc-sols) + ($csp (list ($var 'a '(1)) ($var 'b '(9)) ($var 'c '(9))) '())) ;; quarter problem: -;; 26 coins, dollars and quarters +;; 26 dollars and quarters ;; that add up to $17. -(define quarter-problem (new problem%)) -(send quarter-problem add-variables '("dollars" "quarters") (range 1 27)) -(send quarter-problem add-constraint (λ(d q) (= 17 (+ d (* 0.25 q)))) '("dollars" "quarters")) -(send quarter-problem add-constraint (λ(d q) (= 26 (+ d q))) '("dollars" "quarters")) -(check-hash-items (send quarter-problem get-solution) '#hash(("dollars" . 14) ("quarters" . 12))) +(define quarters (make-csp)) +(add-vars! quarters '(dollars quarters) (range 26)) +(add-constraint! quarters (λ (d q) (= 26 (+ d q))) '(dollars quarters)) +(add-constraint! quarters (λ (d q) (= 17 (+ d (* 0.25 q)))) '(dollars quarters)) +(check-equal? (time (solve quarters)) + ($csp (list ($var 'dollars '(14)) ($var 'quarters '(12))) '())) -;; coin problem 2 -#| -A collection of 33 coins, consisting of nickels, dimes, and quarters, has a value of $3.30. If there are three times as many nickels as quarters, and one-half as many dimes as nickels, how many coins of each kind are there? -|# - -(define nickel-problem (new problem%)) -(send nickel-problem add-variables '(nickels dimes quarters) (range 1 34)) -(send nickel-problem add-constraint (λ(n d q) (= 33 (+ n d q))) '(nickels dimes quarters)) -(send nickel-problem add-constraint (λ(n d q) (= 3.30 (+ (* 0.05 n) (* 0.1 d) (* 0.25 q)))) '(nickels dimes quarters)) -(send nickel-problem add-constraint (λ(n q) (= n (* 3 q))) '(nickels quarters)) -(send nickel-problem add-constraint (λ(d n) (= n (* 2 d))) '(dimes nickels)) -(check-hash-items (send nickel-problem get-solution) #hash((nickels . 18) (quarters . 6) (dimes . 9))) -;; word math +;; nickel problem #| -# Assign equal values to equal letters, and different values to -# different letters, in a way that satisfies the following sum: -# -# TWO -# + TWO -# ----- -# FOUR +A collection of 33 coins, consisting of nickels, dimes, and quarters, has a value of $3.30. If there are three times as many nickels as quarters, and one-half as many dimes as nickels, how many coins of each kind are there? |# - - -(define two-four-problem (new problem%)) -(send two-four-problem add-variables '(t w o f u r) (range 10)) -(send two-four-problem add-constraint (new all-different-constraint%)) -(send two-four-problem add-constraint (λ(t w o) (> (word-value t w o) 99)) '(t w o)) -(send two-four-problem add-constraint (λ(f o u r) (> (word-value f o u r) 999)) '(f o u r)) -(send two-four-problem add-constraint - (λ (t w o f u r) - (let ([two (word-value t w o)] - [four (word-value f o u r)]) - ((two . + . two) . = . four))) '(t w o f u r)) -(check-equal? (length (send two-four-problem get-solutions)) 7) -(send two-four-problem add-constraint (λ(r) (= r 0)) '(r)) -(check-hash-items (send two-four-problem get-solution) #hash((o . 5) (w . 6) (u . 3) (f . 1) (r . 0) (t . 7))) +(define nickels (make-csp)) +(add-vars! nickels '(n d q) (range 33)) +(add-constraint! nickels (λ (n d q) (= 33 (+ n d q))) '(n d q) 'count-33) +(add-constraint! nickels (λ (n d q) (= 330 (+ (* n 5) (* d 10) (* q 25)))) '(n d q) 'total-3.30) +(add-constraint! nickels (λ (n q) (= (* 3 q) n)) '(n q) 'triple-nickel) +(add-constraint! nickels (λ (d n) (= (* 2 d) n)) '(d n) 'double-nickel) +(check-equal? (time (solve nickels)) + ($csp (list ($var 'n '(18)) ($var 'd '(9)) ($var 'q '(6))) '())) ;; xsum @@ -85,17 +108,15 @@ A collection of 33 coins, consisting of nickels, dimes, and quarters, has a valu # |# -(define xsum-problem (new problem%)) -(send xsum-problem add-variables '(l1 l2 l3 l4 r1 r2 r3 r4 x) (range 10)) -(send xsum-problem add-constraint (λ (l1 l2 l3 l4 x) - (and (< l1 l2 l3 l4) - (= 27 (+ l1 l2 l3 l4 x)))) '(l1 l2 l3 l4 x)) -(send xsum-problem add-constraint (λ (r1 r2 r3 r4 x) - (and (< r1 r2 r3 r4) - (= 27 (+ r1 r2 r3 r4 x)))) '(r1 r2 r3 r4 x)) -(send xsum-problem add-constraint (new all-different-constraint%)) -(check-equal? (length (send xsum-problem get-solutions)) 8) +(define xsum (make-csp)) +(add-vars! xsum '(l1 l2 l3 l4 r1 r2 r3 r4 x) (range 1 10)) +(add-pairwise-constraint! xsum < '(l1 l2 l3 l4)) +(add-pairwise-constraint! xsum < '(r1 r2 r3 r4)) +(add-constraint! xsum (λ (l1 l2 l3 l4 x) (= 27 (+ l1 l2 l3 l4 x))) '(l1 l2 l3 l4 x)) +(add-constraint! xsum (λ (r1 r2 r3 r4 x) (= 27 (+ r1 r2 r3 r4 x))) '(r1 r2 r3 r4 x)) +(add-pairwise-constraint! xsum alldiff= '(l1 l2 l3 l4 r1 r2 r3 r4 x)) +(check-equal? (length (time (solve* xsum))) 8) ;; send more money problem @@ -109,40 +130,39 @@ A collection of 33 coins, consisting of nickels, dimes, and quarters, has a valu # MONEY |# -(define sm-problem (new problem%)) -(send sm-problem add-variables '(s e n d m o r y) (range 10)) -(send sm-problem add-constraint (λ(x) (> x 0)) '(s)) -(send sm-problem add-constraint (λ(x) (> x 0)) '(m)) -(send sm-problem add-constraint (λ(d e y) (= (modulo (+ d e) 10) y)) '(d e y)) -(send sm-problem add-constraint (λ(n d r e y) - (= (modulo (+ (word-value n d) (word-value r e)) 100) - (word-value e y))) '(n d r e y)) -(send sm-problem add-constraint (λ(e n d o r y) - (= (modulo (+ (word-value e n d) (word-value o r e)) 1000) (word-value n e y))) '(e n d o r y)) -(send sm-problem add-constraint (λ(s e n d m o r y) (= - (+ (word-value s e n d) - (word-value m o r e)) - (word-value m o n e y))) '(s e n d m o r y)) -(send sm-problem add-constraint (new all-different-constraint%)) - -(check-hash-items (send sm-problem get-solution) '#hash((m . 1) (e . 5) (r . 8) (n . 6) (y . 2) (o . 0) (d . 7) (s . 9))) - +(define smm (make-csp)) +(add-vars! smm '(s e n d m o r y) (λ () (reverse (range 10)))) +(add-constraint! smm positive? '(s)) +(add-constraint! smm positive? '(m)) +(add-constraint! smm (λ (d e y) (= (modulo (+ d e) 10) y)) '(d e y)) +(add-constraint! smm (λ (n d r e y) + (= (modulo (+ (word-value n d) (word-value r e)) 100) + (word-value e y))) '(n d r e y)) +(add-constraint! smm (λ (e n d o r y) + (= (modulo (+ (word-value e n d) (word-value o r e)) 1000) (word-value n e y))) '(e n d o r y)) +(add-constraint! smm (λ (s e n d m o r y) + (= (+ (word-value s e n d) (word-value m o r e)) + (word-value m o n e y))) '(s e n d m o r y)) +(add-pairwise-constraint! smm alldiff= '(s e n d m o r y)) + +;; todo: too slow +;(solve smm) ;; queens problem ;; place queens on chessboard so they do not intersect - -(define queens-problem (new problem%)) -(define cols (range 8)) -(define rows (range 8)) -(send queens-problem add-variables cols rows) -(for* ([col1 (in-list cols)] [col2 (in-list cols)] #:when (< col1 col2)) - (send queens-problem add-constraint (λ(row1 row2 [col1 col1][col2 col2]) - (and - ;; test if two cells are on a diagonal - (not (= (abs (- row1 row2)) (abs (- col1 col2)))) - ;; test if two cells are in same row - (not (= row1 row2)))) (list col1 col2))) -(check-equal? (length (send queens-problem get-solutions)) 92) - -(module+ main - (displayln "Tests passed")) \ No newline at end of file +(define queens (make-csp)) +(define qs (for/list ([q 8]) (string->symbol (format "q~a" q)))) +(define rows (range (length qs))) +(add-vars! queens qs rows) +(define (q-col q) (string->number (string-trim (symbol->string q) "q"))) +(for* ([qs (in-combinations qs 2)]) + (match-define (list qa qb) qs) + (match-define (list qa-col qb-col) (map q-col qs)) + (add-constraint! queens + (λ (qa-row qb-row) + (and + (not (= (abs (- qa-row qb-row)) (abs (- qa-col qb-col)))) ; same diagonal? + (not (= qa-row qb-row)))) ; same row? + (list qa qb))) + +(check-equal? 92 (length (time (solve* queens)))) \ No newline at end of file diff --git a/csp/test.rkt b/csp/test.rkt index f3fa6b26..c287d30d 100644 --- a/csp/test.rkt +++ b/csp/test.rkt @@ -1,169 +1,21 @@ #lang at-exp racket (require "csp.rkt" rackunit) -(define demo (make-csp)) -(add-vars! demo '(t w) (range 7)) -(add-var! demo 'o '(2 6 7)) - -(define (sum-three t w o) (= 3 (+ t w o))) -(add-constraint! demo sum-three '(t w o)) -(add-pairwise-constraint! demo alldiff= '(t w o)) -(add-pairwise-constraint! demo < '(t w o)) - -(check-equal? (time (solve demo)) ($csp (list ($var 't '(0)) ($var 'w '(1)) ($var 'o '(2))) '())) - - -;; TWO + TWO = FOUR -(define ttf (make-csp)) -(add-vars! ttf '(t w o f u r) (reverse (range 10))) - -(define (word-value . xs) - (let ([xs (reverse xs)]) - (for/sum ([i (in-range (length xs))]) - (* (list-ref xs i) (expt 10 i))))) - -(add-pairwise-constraint! ttf alldiff= '(t w o f u r)) -(add-constraint! ttf (λ (o r) (= (modulo (+ o o) 10) r)) '(o r)) -(add-constraint! ttf (λ (t w o f u r) (= (+ (word-value t w o) (word-value t w o)) - (word-value f o u r))) '(t w o f u r)) -(add-constraint! ttf positive? '(t)) -(add-constraint! ttf positive? '(f)) - -(define ttf-solution (time (solve ttf))) -(check-equal? ttf-solution - ($csp - (list - ($var 't '(7)) - ($var 'w '(3)) - ($var 'o '(4)) - ($var 'f '(1)) - ($var 'u '(6)) - ($var 'r '(8))) - '())) - -(define (ttf-print csp) - (format "~a~a~a + ~a~a~a = ~a~a~a~a" ($csp-ref csp 't) ($csp-ref csp 'w) ($csp-ref csp 'o) ($csp-ref csp 't) ($csp-ref csp 'w) ($csp-ref csp 'o) ($csp-ref csp 'f) ($csp-ref csp 'o) ($csp-ref csp 'u) ($csp-ref csp 'r))) - -(check-equal? (time (solve ttf-solution ttf-print)) "734 + 734 = 1468") - - -;; ABC problem: -;; what is the minimum value of -;; ABC -;; ------- -;; A+B+C - -(define abc (make-csp)) -(add-vars! abc '(a b c) (range 1 10)) -(define (solution-score sol) - (let ([a ($csp-ref sol 'a)] - [b ($csp-ref sol 'b)] - [c ($csp-ref sol 'c)]) - (/ (+ (* 100 a) (* 10 b) c) (+ a b c)))) - - -(define abc-sols (time (solve* abc))) -(check-equal? (* 9 9 9) (length abc-sols)) -(check-equal? - (argmin solution-score abc-sols) - ($csp (list ($var 'a '(1)) ($var 'b '(9)) ($var 'c '(9))) '())) - - -;; quarter problem: -;; 26 dollars and quarters -;; that add up to $17. - -(define quarters (make-csp)) -(add-vars! quarters '(dollars quarters) (range 26)) -(add-constraint! quarters (λ (d q) (= 26 (+ d q))) '(dollars quarters)) -(add-constraint! quarters (λ (d q) (= 17 (+ d (* 0.25 q)))) '(dollars quarters)) -(check-equal? (time (solve quarters)) - ($csp (list ($var 'dollars '(14)) ($var 'quarters '(12))) '())) - - -;; nickel problem -#| -A collection of 33 coins, consisting of nickels, dimes, and quarters, has a value of $3.30. If there are three times as many nickels as quarters, and one-half as many dimes as nickels, how many coins of each kind are there? -|# -(define nickels (make-csp)) -(add-vars! nickels '(n d q) (range 33)) -(add-constraint! nickels (λ (n d q) (= 33 (+ n d q))) '(n d q) 'count-33) -(add-constraint! nickels (λ (n d q) (= 330 (+ (* n 5) (* d 10) (* q 25)))) '(n d q) 'total-3.30) -(add-constraint! nickels (λ (n q) (= (* 3 q) n)) '(n q) 'triple-nickel) -(add-constraint! nickels (λ (d n) (= (* 2 d) n)) '(d n) 'double-nickel) -(check-equal? (time (solve nickels)) - ($csp (list ($var 'n '(18)) ($var 'd '(9)) ($var 'q '(6))) '())) - - -;; xsum #| -# Reorganize the following numbers in a way that each line of -# 5 numbers sum to 27. -# -# 1 6 -# 2 7 -# 3 -# 8 4 -# 9 5 -# +(define creduce (assign-val ($csp (list ($var 'a '(1 2 3)) ($var 'b '(2 3)) ($var 'c '(1 2 3 4 5))) (list ($constraint '(a b c) (procedure-rename (λ (a b c) (= (+ a b c) 4)) 'summer)))) 'a 1)) +(check-equal? + (make-arcs-consistent (reduce-constraint-arity creduce)) + ($csp (list ($var 'a '(1)) ($var 'b '(2)) ($var 'c '(1))) '())) + +(define f (λ (a b c d) (+ a b c d))) +(check-equal? 10 ((reduce-arity f '(1 b c d)) 2 3 4)) +(check-equal? 10 ((reduce-arity f '(1 2 c d)) 3 4)) +(check-equal? 10 ((reduce-arity f '(1 2 3 d)) 4)) +(check-equal? 10 ((reduce-arity f '(1 b 3 d)) 2 4)) +(check-equal? 10 ((reduce-arity f '(a b 3 d)) 1 2 4)) |# -(define xsum (make-csp)) -(add-vars! xsum '(l1 l2 l3 l4 r1 r2 r3 r4 x) (range 1 10)) -(add-pairwise-constraint! xsum < '(l1 l2 l3 l4)) -(add-pairwise-constraint! xsum < '(r1 r2 r3 r4)) -(add-constraint! xsum (λ (l1 l2 l3 l4 x) (= 27 (+ l1 l2 l3 l4 x))) '(l1 l2 l3 l4 x)) -(add-constraint! xsum (λ (r1 r2 r3 r4 x) (= 27 (+ r1 r2 r3 r4 x))) '(r1 r2 r3 r4 x)) -(add-pairwise-constraint! xsum alldiff= '(l1 l2 l3 l4 r1 r2 r3 r4 x)) - -(check-equal? (length (time (solve* xsum))) 8) - - -;; send more money problem -#| -# Assign equal values to equal letters, and different values to -# different letters, in a way that satisfies the following sum: -# -# SEND -# + MORE -# ------ -# MONEY -|# - -(define smm (make-csp)) -(add-vars! smm '(s e n d m o r y) (range 10)) -(add-constraint! smm positive? '(s)) -(add-constraint! smm positive? '(m)) -(add-constraint! smm (λ (d e y) (= (modulo (+ d e) 10) y)) '(d e y)) -(add-constraint! smm (λ (n d r e y) - (= (modulo (+ (word-value n d) (word-value r e)) 100) - (word-value e y))) '(n d r e y)) -(add-constraint! smm (λ (e n d o r y) - (= (modulo (+ (word-value e n d) (word-value o r e)) 1000) (word-value n e y))) '(e n d o r y)) -(add-constraint! smm (λ (s e n d m o r y) - (= (+ (word-value s e n d) (word-value m o r e)) - (word-value m o n e y))) '(s e n d m o r y)) -(add-pairwise-constraint! smm alldiff= '(s e n d m o r y)) - -;; todo: too slow -;(solve smm) - -;; queens problem -;; place queens on chessboard so they do not intersect -(define queens (make-csp)) -(define qs (for/list ([q 8]) (string->symbol (format "q~a" q)))) -(define rows (range (length qs))) -(add-vars! queens qs rows) -(define (q-col q) (string->number (string-trim (symbol->string q) "q"))) -(for* ([qs (in-combinations qs 2)]) - (match-define (list qa qb) qs) - (match-define (list qa-col qb-col) (map q-col qs)) - (add-constraint! queens - (λ (qa-row qb-row) - (and - (not (= (abs (- qa-row qb-row)) (abs (- qa-col qb-col)))) ; same diagonal? - (not (= qa-row qb-row)))) ; same row? - (list qa qb))) +(make-nodes-consistent ($csp (list ($var 'a '(1)) ($var 'b '(0 1))) (list ($constraint '(b) zero?)))) -(check-equal? 92 (length (time (solve* queens)))) +(remove-assigned-constraints ($csp (list ($var 'a '(1)) ($var 'b '(0 1))) (list ($constraint '(b) zero?)))) From a2bef6dbf6fa3ad1f50bd84c504376558609f1e1 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Sat, 13 Oct 2018 23:10:42 -0700 Subject: [PATCH 110/246] more --- csp/csp.rkt | 32 +++++++++++++++----------------- csp/port/test-problems.rkt | 22 ++++++++++++++++++++++ csp/test.rkt | 8 ++++++-- 3 files changed, 43 insertions(+), 19 deletions(-) diff --git a/csp/csp.rkt b/csp/csp.rkt index 4963429c..a683c0f7 100644 --- a/csp/csp.rkt +++ b/csp/csp.rkt @@ -229,18 +229,14 @@ [(list) #f] [(list uvars ...) ;; minimum remaining values (MRV) rule - (define uvars-by-rv (sort uvars < #:key remaining-values)) - (define minimum-remaining-values (remaining-values (first uvars-by-rv))) - (match (takef uvars-by-rv (λ (var) (= minimum-remaining-values (remaining-values var)))) + (define mrv-arg (argmin remaining-values uvars)) + (match (filter (λ (var) (= (remaining-values mrv-arg) (remaining-values var))) uvars) [(list winning-uvar) winning-uvar] [(list mrv-uvars ...) ;; use degree as tiebreaker for mrv - (define uvars-by-degree (sort mrv-uvars > #:key (λ (var) (var-degree csp var)))) - (define max-degree (var-degree csp (first uvars-by-degree))) + (define max-degree-arg (argmax (λ (var) (var-degree csp var)) mrv-uvars)) ;; use random tiebreaker for degree - (match (takef uvars-by-degree (λ (var) (= max-degree (var-degree csp var)))) - [(list winning-uvar) winning-uvar] - [(list degree-uvars ...) (first (shuffle degree-uvars))])])])) + (first (shuffle (filter (λ (var) (= (var-degree csp max-degree-arg) (var-degree csp var))) mrv-uvars)))])])) (define/contract (order-domain-values vals) ((listof any/c) . -> . (listof any/c)) @@ -268,6 +264,7 @@ (unless (match (procedure-arity proc) [(arity-at-least val) (<= val (length pattern))] [(? number? val) (= val (length pattern))]) + #R proc (raise-argument-error 'reduce-arity (format "list of length ~a, same as procedure arity" (procedure-arity proc)) pattern)) (define reduced-arity-name (string->symbol (format "reduced-arity-~a" (object-name proc)))) (define-values (id-names vals) (partition symbol? pattern)) @@ -313,13 +310,14 @@ (define/contract (in-solutions csp) ($csp? . -> . sequence?) ;; as described by AIMA @ 271 - (in-generator (let backtrack ([csp (make-arcs-consistent (make-nodes-consistent csp))]) - (match (select-unassigned-var csp) - [#f (yield csp)] - [($var name vals) - (for ([val (in-list (order-domain-values vals))]) - (with-handlers ([inconsistency-signal? void]) - (backtrack (assign-val csp name val))))])))) + (in-generator (let ((max-places (processor-count))) + (let backtrack ([csp (make-arcs-consistent (make-nodes-consistent csp))]) + (match (select-unassigned-var csp) + [#f (yield csp)] + [($var name vals) + (for ([val (in-list (order-domain-values vals))]) + (with-handlers ([inconsistency-signal? void]) + (backtrack (assign-val csp name val))))]))))) (define/contract (solve* csp [finish-proc values][solution-limit +inf.0]) (($csp?) (procedure? integer?) . ->* . (non-empty-listof any/c)) @@ -336,9 +334,9 @@ (define ($csp-ref csp name) (first ($csp-vals csp name))) -(define/contract (alldiff x y) +(define/contract (alldiff . xs) (any/c any/c . -> . boolean?) - (not (equal? x y))) + (= (length (remove-duplicates xs)) (length xs))) (define/contract (alldiff= x y) (any/c any/c . -> . boolean?) diff --git a/csp/port/test-problems.rkt b/csp/port/test-problems.rkt index 7913fb4e..aec12564 100644 --- a/csp/port/test-problems.rkt +++ b/csp/port/test-problems.rkt @@ -110,6 +110,28 @@ A collection of 33 coins, consisting of nickels, dimes, and quarters, has a valu |# +(define smm (new problem%)) +(send smm add-variables '(s e n d m o r y) (range 10)) +(send smm add-constraint (λ(x) (> x 0)) '(s)) +(send smm add-constraint (λ(x) (> x 0)) '(m)) +(send smm add-constraint (λ(d e y) (= (modulo (+ d e) 10) y)) '(d e y)) +(send smm add-constraint (λ(n d r e y) + (= (modulo (+ (word-value n d) (word-value r e)) 100) + (word-value e y))) '(n d r e y)) +(send smm add-constraint (λ(e n d o r y) + (= (modulo (+ (word-value e n d) (word-value o r e)) 1000) (word-value n e y))) '(e n d o r y)) +(send smm add-constraint (λ(s e n d m o r y) (= + (+ (word-value s e n d) + (word-value m o r e)) + (word-value m o n e y))) '(s e n d m o r y)) +#;(send smm add-constraint (new all-different-constraint%)) +(send smm add-constraint (λ xs (= (length (remove-duplicates xs)) (length xs))) '(s e n d m o r y)) + +(check-hash-items (send smm get-solution) '#hash((m . 1) (e . 5) (r . 8) (n . 6) (y . 2) (o . 0) (d . 7) (s . 9))) + + + + ;; queens problem ;; place queens on chessboard so they do not intersect diff --git a/csp/test.rkt b/csp/test.rkt index c287d30d..41978d41 100644 --- a/csp/test.rkt +++ b/csp/test.rkt @@ -15,7 +15,11 @@ (check-equal? 10 ((reduce-arity f '(a b 3 d)) 1 2 4)) |# -(make-nodes-consistent ($csp (list ($var 'a '(1)) ($var 'b '(0 1))) (list ($constraint '(b) zero?)))) +(define c1 ($csp (list ($var 'a '(1 2)) ($var 'b '(1 2 3)) ($var 'c '(1 3 4 5))) (list ($constraint '(a b c) alldiff)))) +(assign-val c1 'b 3) + +(define c2 ($csp (list ($var 'a '(1 2)) ($var 'b '(1 2 3)) ($var 'c '(1 3 4 5))) null)) +(add-pairwise-constraint! c2 alldiff '(a b c)) +(assign-val c2 'b 3) -(remove-assigned-constraints ($csp (list ($var 'a '(1)) ($var 'b '(0 1))) (list ($constraint '(b) zero?)))) From 5137e83ffce33258654f69131e0b4c39c6cb133f Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Sun, 14 Oct 2018 12:10:58 -0700 Subject: [PATCH 111/246] boulder --- csp/csp.rkt | 111 ++++++++++++++++++++++++++++-------------- csp/test-problems.rkt | 4 +- 2 files changed, 77 insertions(+), 38 deletions(-) diff --git a/csp/csp.rkt b/csp/csp.rkt index a683c0f7..a2b4641f 100644 --- a/csp/csp.rkt +++ b/csp/csp.rkt @@ -1,20 +1,27 @@ #lang debug racket -(require racket/generator sugar/debug) +(require racket/generator racket/control sugar/debug) (provide (all-defined-out)) (struct $csp ([vars #:mutable] [constraints #:mutable]) #:transparent) -(define (make-csp) ($csp null null)) +(define (make-csp [vars null] [constraints null]) ($csp (for/list ([var (in-list vars)]) + (let loop ([var var]) + (match var + [(list (? symbol? name) vals) (loop ($var name vals))] + [($var name vals) ($varc name vals null)]))) + constraints)) (define debug (make-parameter #false)) -(define (in-cartesian argss) - (in-generator (let loop ([argss argss][acc empty]) - (if (null? argss) - (yield (reverse acc)) - (for ([arg (in-list (car argss))]) - (loop (cdr argss) (cons arg acc))))))) +(define-syntax-rule (in-cartesian x) + (in-generator (let ([argss x]) + (let loop ([argss argss][acc empty]) + (if (null? argss) + (yield (reverse acc)) + (for ([arg (in-list (car argss))]) + (loop (cdr argss) (cons arg acc)))))))) (struct $var (name vals) #:transparent) +(struct $varc $var (culprits) #:transparent) (define $var-name? symbol?) (struct $constraint (names proc) #:transparent #:property prop:procedure @@ -51,9 +58,11 @@ names-or-procedure))]) (when (memq name (map $var-name vars)) (raise-argument-error 'add-vars! "var that doesn't already exist" name)) - (append vars (list ($var name (if (procedure? vals-or-procedure) - (vals-or-procedure) - vals-or-procedure)))))) + (append vars (list ($varc name + (if (procedure? vals-or-procedure) + (vals-or-procedure) + vals-or-procedure) + null))))) (define/contract (add-var! csp name [vals-or-procedure empty]) (($csp? $var-name?) ((or/c (listof any/c) procedure?)) . ->* . void?) @@ -81,20 +90,23 @@ ($csp? . -> . boolean?) (zero? (state-count csp))) -(struct inconsistency-signal () #:transparent) +(struct inconsistency-signal (names) #:transparent) -(define/contract (apply-unary-constraint csp constraint) - ($csp? unary-constraint? . -> . $csp?) +(define/contract (apply-unary-constraint csp constraint #:culprit [culprit #f]) + (($csp? unary-constraint?) (#:culprit (or/c #f $var-name?)) . ->* . $csp?) (define (update-csp-vars name vals) (for/list ([var (in-list ($csp-vars csp))]) + (define new-culprits (if (and culprit (< (length vals) (length ($var-vals var)))) + (remove-duplicates (cons culprit ($varc-culprits var)) eq?) + ($varc-culprits var))) (if (eq? ($var-name var) name) - ($var name vals) + ($varc name vals new-culprits) var))) (match-define ($constraint (list name) proc) constraint) (match (if (promise? proc) (force proc) (filter proc ($csp-vals csp name))) - [(list) (raise (inconsistency-signal))] + [(list) (raise (inconsistency-signal ($varc-culprits ($csp-var csp name))))] [(list assigned-val) (make-nodes-consistent (remove-assigned-constraints (reduce-constraint-arity @@ -116,12 +128,17 @@ #:when (unary-constraint? constraint)) (apply-unary-constraint csp constraint))) +(define/contract ($csp-var csp name) + ($csp? $var-name? . -> . $var?) + (check-name-in-csp! '$csp-var csp name) + (for/first ([var (in-list ($csp-vars csp))] + #:when (eq? name ($var-name var))) + var)) + (define/contract ($csp-vals csp name) ($csp? $var-name? . -> . (listof any/c)) (check-name-in-csp! '$csp-vals csp name) - (for/first ([var (in-list ($csp-vars csp))] - #:when (eq? name ($var-name var))) - ($var-vals var))) + ($var-vals ($csp-var csp name))) (struct $arc (name constraint) #:transparent) @@ -138,7 +155,8 @@ (apply-unary-constraint csp ($constraint (list name) (procedure-rename satisfies-arc? - (string->symbol (format "~a-arc-to-~a" (object-name proc) other-name)))))) + (string->symbol (format "~a-arc-to-~a" (object-name proc) other-name)))) + #:culprit other-name)) (define/contract (binary-constraints->arcs constraints) ((listof binary-constraint?) . -> . (listof $arc?)) @@ -184,9 +202,8 @@ #:result csp) ([i (in-naturals)] #:break (empty? arcs)) - (match-define (cons arc other-arcs) arcs) - (match-define ($arc name _) arc) - (define reduced-csp (reduce-domains-by-arc csp arc)) + (match-define (cons ($arc name proc) other-arcs) arcs) + (define reduced-csp (reduce-domains-by-arc csp ($arc name proc))) (values reduced-csp (if (= (length ($csp-vals csp name)) (length ($csp-vals reduced-csp name))) ;; revision did not reduce the domain, so keep going other-arcs @@ -252,7 +269,9 @@ (define assigned-constraints (filter (λ (c) (constraint-assigned? csp c)) ($csp-constraints csp))) (for ([constraint (in-list (sort assigned-constraints < #:key constraint-arity))] #:unless (constraint csp)) - (raise (inconsistency-signal))) + (raise (inconsistency-signal (for*/list ([name (in-list ($constraint-names constraint))] + [culprit (in-list ($varc-culprits ($csp-var csp name)))]) + culprit)))) csp) (define/contract (assign-val csp name val) @@ -264,7 +283,6 @@ (unless (match (procedure-arity proc) [(arity-at-least val) (<= val (length pattern))] [(? number? val) (= val (length pattern))]) - #R proc (raise-argument-error 'reduce-arity (format "list of length ~a, same as procedure arity" (procedure-arity proc)) pattern)) (define reduced-arity-name (string->symbol (format "reduced-arity-~a" (object-name proc)))) (define-values (id-names vals) (partition symbol? pattern)) @@ -307,25 +325,46 @@ (reduce-arity proc reduce-arity-pattern)))] [else constraint]))))) -(define/contract (in-solutions csp) - ($csp? . -> . sequence?) +(define/contract (select-k names krecs) + ((listof $var-name?) (listof (cons/c $var-name? continuation?)) . -> . continuation?) + ;; select the most recent (ie topmost) k that is in the signal + (cdr (or #;(for/first ([krec (in-list krecs)] + #:when (let ([name (car krec)]) + (memq name names))) + krec) + (first krecs)))) + +(define/contract (backtrack-solution-generator csp) + ($csp? . -> . generator?) ;; as described by AIMA @ 271 - (in-generator (let ((max-places (processor-count))) - (let backtrack ([csp (make-arcs-consistent (make-nodes-consistent csp))]) + (generator () (let ((max-places (processor-count))) + (let backtrack ([csp (make-arcs-consistent (make-nodes-consistent csp))] + [backjump-krecs null]) (match (select-unassigned-var csp) - [#f (yield csp)] + [#f (yield ($csp (for/list ([v (in-list ($csp-vars csp))]) + (match v + [($varc name vals _) ($var name vals)] + [(? $var? v) v])) + ($csp-constraints csp)))] [($var name vals) - (for ([val (in-list (order-domain-values vals))]) - (with-handlers ([inconsistency-signal? void]) - (backtrack (assign-val csp name val))))]))))) + (call/prompt + (λ () + (for ([val (in-list (order-domain-values vals))]) + (let/cc backjump-k + (let ([backjump-krecs (cons (cons name backjump-k) backjump-krecs)]) + (with-handlers ([inconsistency-signal? + (λ (sig) + (define backjump-k (select-k (inconsistency-signal-names sig) backjump-krecs)) + (backjump-k))]) + (backtrack (assign-val csp name val) backjump-krecs)))))))]))))) (define/contract (solve* csp [finish-proc values][solution-limit +inf.0]) (($csp?) (procedure? integer?) . ->* . (non-empty-listof any/c)) (define solutions - (for/list ([solution (in-solutions csp)] + (for/list ([solution (in-producer (backtrack-solution-generator csp) (void))] [idx (in-range solution-limit)]) (finish-proc solution))) - (unless (pair? solutions) (raise (inconsistency-signal))) + (unless (pair? solutions) (raise (inconsistency-signal null))) solutions) (define/contract (solve csp [finish-proc values]) @@ -335,7 +374,7 @@ (define ($csp-ref csp name) (first ($csp-vals csp name))) (define/contract (alldiff . xs) - (any/c any/c . -> . boolean?) + (() #:rest (listof any/c) . ->* . boolean?) (= (length (remove-duplicates xs)) (length xs))) (define/contract (alldiff= x y) diff --git a/csp/test-problems.rkt b/csp/test-problems.rkt index b7c88e61..58200dfa 100644 --- a/csp/test-problems.rkt +++ b/csp/test-problems.rkt @@ -14,14 +14,14 @@ ;; TWO + TWO = FOUR -(define ttf (make-csp)) -(add-vars! ttf '(t w o f u r) (reverse (range 10))) (define (word-value . xs) (let ([xs (reverse xs)]) (for/sum ([i (in-range (length xs))]) (* (list-ref xs i) (expt 10 i))))) +(define ttf (make-csp)) +(add-vars! ttf '(t w o f u r) (reverse (range 10))) (add-pairwise-constraint! ttf alldiff= '(t w o f u r)) (add-constraint! ttf (λ (o r) (= (modulo (+ o o) 10) r)) '(o r)) (add-constraint! ttf (λ (t w o f u r) (= (+ (word-value t w o) (word-value t w o)) From 321406103422dbb927755c42503caa266f10930a Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Sun, 14 Oct 2018 12:23:40 -0700 Subject: [PATCH 112/246] werk --- csp/csp.rkt | 46 +++++++++++++++++++++++----------------------- csp/test.rkt | 24 ++++-------------------- 2 files changed, 27 insertions(+), 43 deletions(-) diff --git a/csp/csp.rkt b/csp/csp.rkt index a2b4641f..9411be3a 100644 --- a/csp/csp.rkt +++ b/csp/csp.rkt @@ -328,35 +328,35 @@ (define/contract (select-k names krecs) ((listof $var-name?) (listof (cons/c $var-name? continuation?)) . -> . continuation?) ;; select the most recent (ie topmost) k that is in the signal + ;; todo: repair backjumping (cdr (or #;(for/first ([krec (in-list krecs)] - #:when (let ([name (car krec)]) - (memq name names))) - krec) + #:when (let ([name (car krec)]) + (memq name names))) + krec) (first krecs)))) (define/contract (backtrack-solution-generator csp) ($csp? . -> . generator?) ;; as described by AIMA @ 271 - (generator () (let ((max-places (processor-count))) - (let backtrack ([csp (make-arcs-consistent (make-nodes-consistent csp))] - [backjump-krecs null]) - (match (select-unassigned-var csp) - [#f (yield ($csp (for/list ([v (in-list ($csp-vars csp))]) - (match v - [($varc name vals _) ($var name vals)] - [(? $var? v) v])) - ($csp-constraints csp)))] - [($var name vals) - (call/prompt - (λ () - (for ([val (in-list (order-domain-values vals))]) - (let/cc backjump-k - (let ([backjump-krecs (cons (cons name backjump-k) backjump-krecs)]) - (with-handlers ([inconsistency-signal? - (λ (sig) - (define backjump-k (select-k (inconsistency-signal-names sig) backjump-krecs)) - (backjump-k))]) - (backtrack (assign-val csp name val) backjump-krecs)))))))]))))) + (generator () (let backtrack ([csp (make-arcs-consistent (make-nodes-consistent csp))] + [backjump-krecs null]) + (match (select-unassigned-var csp) + [#f (yield ($csp (for/list ([v (in-list ($csp-vars csp))]) + (match v + [($varc name vals _) ($var name vals)] + [(? $var? v) v])) + ($csp-constraints csp)))] + [($var name vals) + (call/prompt + (thunk + (for ([val (in-list (order-domain-values vals))]) + (let/cc backjump-k + (let ([backjump-krecs (cons (cons name backjump-k) backjump-krecs)]) + (with-handlers ([inconsistency-signal? + (λ (sig) + (define backjump-k (select-k (inconsistency-signal-names sig) backjump-krecs)) + (backjump-k))]) + (backtrack (assign-val csp name val) backjump-krecs)))))))])))) (define/contract (solve* csp [finish-proc values][solution-limit +inf.0]) (($csp?) (procedure? integer?) . ->* . (non-empty-listof any/c)) diff --git a/csp/test.rkt b/csp/test.rkt index 41978d41..02a7f014 100644 --- a/csp/test.rkt +++ b/csp/test.rkt @@ -1,25 +1,9 @@ #lang at-exp racket (require "csp.rkt" rackunit) -#| -(define creduce (assign-val ($csp (list ($var 'a '(1 2 3)) ($var 'b '(2 3)) ($var 'c '(1 2 3 4 5))) (list ($constraint '(a b c) (procedure-rename (λ (a b c) (= (+ a b c) 4)) 'summer)))) 'a 1)) -(check-equal? - (make-arcs-consistent (reduce-constraint-arity creduce)) - ($csp (list ($var 'a '(1)) ($var 'b '(2)) ($var 'c '(1))) '())) - -(define f (λ (a b c d) (+ a b c d))) -(check-equal? 10 ((reduce-arity f '(1 b c d)) 2 3 4)) -(check-equal? 10 ((reduce-arity f '(1 2 c d)) 3 4)) -(check-equal? 10 ((reduce-arity f '(1 2 3 d)) 4)) -(check-equal? 10 ((reduce-arity f '(1 b 3 d)) 2 4)) -(check-equal? 10 ((reduce-arity f '(a b 3 d)) 1 2 4)) -|# - -(define c1 ($csp (list ($var 'a '(1 2)) ($var 'b '(1 2 3)) ($var 'c '(1 3 4 5))) (list ($constraint '(a b c) alldiff)))) -(assign-val c1 'b 3) - -(define c2 ($csp (list ($var 'a '(1 2)) ($var 'b '(1 2 3)) ($var 'c '(1 3 4 5))) null)) -(add-pairwise-constraint! c2 alldiff '(a b c)) -(assign-val c2 'b 3) +(define c (make-csp '((a (2 3)) (b (12 14 16)) (c (2 5))) + (list ($constraint '(a c) alldiff=) + ($constraint '(b c) (λ (b c) (zero? (modulo b c))))))) +(solve c) \ No newline at end of file From a7c79798c415d9dfc41fc9b25817c9a692594878 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Sun, 14 Oct 2018 19:24:43 -0700 Subject: [PATCH 113/246] no exit --- csp/csp.rkt | 110 +++++++++++++++++++++++++++++------------- csp/test-etc.rkt | 24 +++++++++ csp/test-problems.rkt | 15 ++++-- csp/test.rkt | 15 ++++-- 4 files changed, 121 insertions(+), 43 deletions(-) create mode 100644 csp/test-etc.rkt diff --git a/csp/csp.rkt b/csp/csp.rkt index 9411be3a..2f222df9 100644 --- a/csp/csp.rkt +++ b/csp/csp.rkt @@ -1,6 +1,7 @@ #lang debug racket (require racket/generator racket/control sugar/debug) (provide (all-defined-out)) + (struct $csp ([vars #:mutable] [constraints #:mutable]) #:transparent) @@ -90,7 +91,12 @@ ($csp? . -> . boolean?) (zero? (state-count csp))) -(struct inconsistency-signal (names) #:transparent) +(struct inconsistency-signal (csp) #:transparent) + +(define use-reduce-arity? (make-parameter #t)) +(define use-mac? (make-parameter #t)) +(define use-remove-constraints? (make-parameter #t)) +(define use-validate-assignments? (make-parameter #t)) (define/contract (apply-unary-constraint csp constraint #:culprit [culprit #f]) (($csp? unary-constraint?) (#:culprit (or/c #f $var-name?)) . ->* . $csp?) @@ -106,20 +112,24 @@ (match (if (promise? proc) (force proc) (filter proc ($csp-vals csp name))) - [(list) (raise (inconsistency-signal ($varc-culprits ($csp-var csp name))))] - [(list assigned-val) (make-nodes-consistent - (remove-assigned-constraints - (reduce-constraint-arity - (validate-assignments - (make-arcs-consistent - ($csp - (update-csp-vars name (list assigned-val)) - ($csp-constraints csp)) #:mac name)))))] + [(list) (raise (inconsistency-signal csp))] + [(list assigned-val) ((if (use-validate-assignments?) make-nodes-consistent values) + ((if (use-remove-constraints?) remove-assigned-constraints values) + ((if (use-reduce-arity?) reduce-constraint-arity values) + ((if (use-validate-assignments?) validate-assignments values) + (let ([csp ($csp + (update-csp-vars name (list assigned-val)) + ($csp-constraints csp))]) + (if (use-mac?) + (make-arcs-consistent csp #:mac name) + csp))))))] [(list new-vals ...) ($csp (update-csp-vars name new-vals) ;; once the constraint is applied, it can go away ;; ps this is not the same as an "assigned" constraint ;; because the var may still have multiple values - (remove constraint ($csp-constraints csp)))])) + (if (use-remove-constraints?) + (remove constraint ($csp-constraints csp)) + ($csp-constraints csp)))])) (define/contract (make-nodes-consistent csp) ($csp? . -> . $csp?) @@ -215,7 +225,7 @@ (= 1 (remaining-values var))) (define/contract (solution-complete? csp) - ($csp? . -> . boolean?) + ($csp? . -> . 'lean?) (and (andmap var-assigned? ($csp-vars csp)) (empty? ($csp-constraints csp)))) (define (assigned-helper csp) (partition var-assigned? ($csp-vars csp))) @@ -240,20 +250,24 @@ #:when (constraint-contains-name? constraint ($var-name var))) 1)) +(define use-mrv? (make-parameter #t)) (define/contract (select-unassigned-var csp) ($csp? . -> . (or/c #f $var?)) (match (unassigned-vars csp) [(list) #f] [(list uvars ...) - ;; minimum remaining values (MRV) rule - (define mrv-arg (argmin remaining-values uvars)) - (match (filter (λ (var) (= (remaining-values mrv-arg) (remaining-values var))) uvars) - [(list winning-uvar) winning-uvar] - [(list mrv-uvars ...) - ;; use degree as tiebreaker for mrv - (define max-degree-arg (argmax (λ (var) (var-degree csp var)) mrv-uvars)) - ;; use random tiebreaker for degree - (first (shuffle (filter (λ (var) (= (var-degree csp max-degree-arg) (var-degree csp var))) mrv-uvars)))])])) + (cond + [(use-mrv?) + ;; minimum remaining values (MRV) rule + (define mrv-arg (argmin remaining-values uvars)) + (match (filter (λ (var) (= (remaining-values mrv-arg) (remaining-values var))) uvars) + [(list winning-uvar) winning-uvar] + [(list mrv-uvars ...) + ;; use degree as tiebreaker for mrv + (define max-degree-arg (argmax (λ (var) (var-degree csp var)) mrv-uvars)) + ;; use random tiebreaker for degree + (first (shuffle (filter (λ (var) (= (var-degree csp max-degree-arg) (var-degree csp var))) mrv-uvars)))])] + [else (first uvars)])])) (define/contract (order-domain-values vals) ((listof any/c) . -> . (listof any/c)) @@ -269,16 +283,22 @@ (define assigned-constraints (filter (λ (c) (constraint-assigned? csp c)) ($csp-constraints csp))) (for ([constraint (in-list (sort assigned-constraints < #:key constraint-arity))] #:unless (constraint csp)) - (raise (inconsistency-signal (for*/list ([name (in-list ($constraint-names constraint))] - [culprit (in-list ($varc-culprits ($csp-var csp name)))]) - culprit)))) + (raise (inconsistency-signal csp))) csp) (define/contract (assign-val csp name val) ($csp? $var-name? any/c . -> . $csp?) + (check-name-in-csp! 'assign-val csp name) (define assignment-constraint ($constraint (list name) (delay (list val)))) (apply-unary-constraint csp assignment-constraint)) +(define/contract (assign-val! csp name val) + ($csp? $var-name? any/c . -> . void?) + (check-name-in-csp! 'assign-val! csp name) + (define new-csp (assign-val csp name val)) + (set-$csp-vars! csp ($csp-vars new-csp)) + (set-$csp-constraints! csp ($csp-constraints new-csp))) + (define (reduce-arity proc pattern) (unless (match (procedure-arity proc) [(arity-at-least val) (<= val (length pattern))] @@ -325,15 +345,39 @@ (reduce-arity proc reduce-arity-pattern)))] [else constraint]))))) -(define/contract (select-k names krecs) - ((listof $var-name?) (listof (cons/c $var-name? continuation?)) . -> . continuation?) +(define/contract (conflict-set csp name) + ($csp? $var-name? . -> . (listof $var-name?)) + ;; earlier assigned variables that participate in constraints with name + (define assigned-names (reverse (map $var-name (assigned-vars csp)))) + (define earlier-assigned-names (memq name assigned-names)) + (for*/list ([constraint (in-list ($csp-constraints csp))] + [cnames (in-value ($constraint-names constraint))] + #:when (and (andmap (λ (cname) (memq cname earlier-assigned-names)) cnames) + (constraint-contains-name? constraint name)) + [cname (in-list cnames)] + #:unless (eq? cname name)) + cname)) + +(define use-cdj? (make-parameter #f)) +(define/contract (select-k sig name krecs) + (inconsistency-signal? $var-name? (listof (cons/c $var-name? continuation?)) . -> . continuation?) ;; select the most recent (ie topmost) k that is in the signal ;; todo: repair backjumping - (cdr (or #;(for/first ([krec (in-list krecs)] - #:when (let ([name (car krec)]) - (memq name names))) - krec) - (first krecs)))) + (cond + [(use-cdj?) + (define assigned-names (map car krecs)) ; already in reverse chron order + (define csp (inconsistency-signal-csp sig)) + (define backjump-dest + (let loop ([name name][cset (conflict-set csp name)]) + (define next-name (for/first ([previously-assigned-name (in-list (memq name assigned-names))] + #:when (memq previously-assigned-name cset)) + previously-assigned-name)) + (define next-cset (conflict-set csp next-name)) + (if (empty? next-cset) + next-name + (loop next-name (remq next-name (remove-duplicates (append next-cset cset) eq?)))))) + (cdr (assq backjump-dest krecs))] + [else (cdr (first krecs))])) (define/contract (backtrack-solution-generator csp) ($csp? . -> . generator?) @@ -354,7 +398,7 @@ (let ([backjump-krecs (cons (cons name backjump-k) backjump-krecs)]) (with-handlers ([inconsistency-signal? (λ (sig) - (define backjump-k (select-k (inconsistency-signal-names sig) backjump-krecs)) + (define backjump-k (select-k sig name backjump-krecs)) (backjump-k))]) (backtrack (assign-val csp name val) backjump-krecs)))))))])))) @@ -364,7 +408,7 @@ (for/list ([solution (in-producer (backtrack-solution-generator csp) (void))] [idx (in-range solution-limit)]) (finish-proc solution))) - (unless (pair? solutions) (raise (inconsistency-signal null))) + (unless (pair? solutions) (raise (inconsistency-signal csp))) solutions) (define/contract (solve csp [finish-proc values]) diff --git a/csp/test-etc.rkt b/csp/test-etc.rkt new file mode 100644 index 00000000..327985c3 --- /dev/null +++ b/csp/test-etc.rkt @@ -0,0 +1,24 @@ +#lang at-exp racket +(require "csp.rkt" racket/port rackunit) + +(use-mrv? #f) +(use-reduce-arity? #f) +(use-mac? #f) +(use-remove-constraints? #f) +(use-validate-assignments? #t) + +(define (neq? x y) (not (eq? x y))) + +(define c (make-csp)) +(add-vars! c '(wa nsw t q nt v sa) '(red green blue)) +(add-constraint! c neq? '(wa nt)) +(add-constraint! c neq? '(nt q)) +(add-constraint! c neq? '(q nsw)) +(add-constraint! c neq? '(nsw v)) +(add-constraint! c neq? '(sa wa)) +(add-constraint! c neq? '(sa nt)) +(add-constraint! c neq? '(sa q)) +(add-constraint! c neq? '(sa nsw)) +(add-constraint! c neq? '(sa v)) + +(solve c) \ No newline at end of file diff --git a/csp/test-problems.rkt b/csp/test-problems.rkt index 58200dfa..5e88893c 100644 --- a/csp/test-problems.rkt +++ b/csp/test-problems.rkt @@ -1,6 +1,12 @@ #lang at-exp racket (require "csp.rkt" rackunit) +(use-mrv? #t) +(use-reduce-arity? #t) +(use-mac? #t) +(use-remove-constraints? #t) +(use-validate-assignments? #t) + (define demo (make-csp)) (add-vars! demo '(t w) (range 7)) (add-var! demo 'o '(2 6 7)) @@ -16,9 +22,8 @@ ;; TWO + TWO = FOUR (define (word-value . xs) - (let ([xs (reverse xs)]) - (for/sum ([i (in-range (length xs))]) - (* (list-ref xs i) (expt 10 i))))) + (for/sum ([(x idx) (in-indexed (reverse xs))]) + (* x (expt 10 idx)))) (define ttf (make-csp)) (add-vars! ttf '(t w o f u r) (reverse (range 10))) @@ -131,9 +136,9 @@ A collection of 33 coins, consisting of nickels, dimes, and quarters, has a valu |# (define smm (make-csp)) -(add-vars! smm '(s e n d m o r y) (λ () (reverse (range 10)))) +(add-vars! smm '(s e n d m o r y) (λ () (range 10))) (add-constraint! smm positive? '(s)) -(add-constraint! smm positive? '(m)) +(add-constraint! smm (curry = 1) '(m)) (add-constraint! smm (λ (d e y) (= (modulo (+ d e) 10) y)) '(d e y)) (add-constraint! smm (λ (n d r e y) (= (modulo (+ (word-value n d) (word-value r e)) 100) diff --git a/csp/test.rkt b/csp/test.rkt index 02a7f014..65345627 100644 --- a/csp/test.rkt +++ b/csp/test.rkt @@ -1,9 +1,14 @@ #lang at-exp racket (require "csp.rkt" rackunit) +(define creduce (assign-val ($csp (list ($var 'a '(1 2 3)) ($var 'b '(2 3)) ($var 'c '(1 2 3 4 5))) (list ($constraint '(a b c) (procedure-rename (λ (a b c) (= (+ a b c) 4)) 'summer)))) 'a 1)) +(check-equal? + (make-arcs-consistent (reduce-constraint-arity creduce)) + ($csp (list ($var 'a '(1)) ($var 'b '(2)) ($var 'c '(1))) '())) -(define c (make-csp '((a (2 3)) (b (12 14 16)) (c (2 5))) - (list ($constraint '(a c) alldiff=) - ($constraint '(b c) (λ (b c) (zero? (modulo b c))))))) - -(solve c) \ No newline at end of file +(define f (λ (a b c d) (+ a b c d))) +(check-equal? 10 ((reduce-arity f '(1 b c d)) 2 3 4)) +(check-equal? 10 ((reduce-arity f '(1 2 c d)) 3 4)) +(check-equal? 10 ((reduce-arity f '(1 2 3 d)) 4)) +(check-equal? 10 ((reduce-arity f '(1 b 3 d)) 2 4)) +(check-equal? 10 ((reduce-arity f '(a b 3 d)) 1 2 4)) \ No newline at end of file From a82a8c1a1ddf6c96b50a4113d5e03d69d540f4bc Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Sun, 14 Oct 2018 21:43:06 -0700 Subject: [PATCH 114/246] some --- csp/aima.rkt | 171 +++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 171 insertions(+) create mode 100644 csp/aima.rkt diff --git a/csp/aima.rkt b/csp/aima.rkt new file mode 100644 index 00000000..ced9d838 --- /dev/null +++ b/csp/aima.rkt @@ -0,0 +1,171 @@ +#lang debug racket + +(struct $csp (variables domains neighbors constraints initial curr_domains nassigns) #:transparent #:mutable) + +(define/contract (make-csp variables domains neighbors constraints) + ((listof symbol?) hash? hash? procedure? . -> . $csp?) + ($csp + variables + domains + neighbors + constraints + null + #f + 0)) + +(define/contract (assign csp var val assignment) + ($csp? symbol? any/c hash? . -> . void?) + ;; Add {var: val} to assignment; Discard the old value if any. + (hash-set! assignment var val) + (set-$csp-nassigns! csp (add1 ($csp-nassigns csp)))) + +(define/contract (unassign csp var assignment) + ($csp? symbol? hash? . -> . void?) + ;; Remove {var: val} from assignment. + ;; DO NOT call this if you are changing a variable to a new value; + ;; just call assign for that. + (hash-remove! assignment var)) + +(define/contract (nconflicts csp var val assignment) + ($csp? symbol? any/c hash? . -> . number?) + ;; Return the number of conflicts var=val has with other variables.""" + ;; Subclasses may implement this more efficiently + (define (conflict var2) + (and (hash-has-key? assignment var2) + (not (($csp-constraints csp) var val var2 (hash-ref assignment var2))))) + (for/sum ([v (hash-ref ($csp-neighbors csp) var)] + #:when (conflict v)) + 1)) + +(define (display csp assignment) + (displayln "todo")) + +(define/contract (support_pruning csp) + ($csp? . -> . void?) + ;; Make sure we can prune values from domains. (We want to pay + ;; for this only if we use it.) + (when (false? ($csp-curr_domains csp)) + (set-$csp-curr_domains! + csp + (let ([h (make-hash)]) + (for ([v ($csp-variables csp)]) + (hash-set! h v (hash-ref ($csp-domains csp) v))) + h)))) + +(define/contract (suppose csp var value) + ($csp? symbol? any/c . -> . (listof (cons/c symbol? any/c))) + ;; Start accumulating inferences from assuming var=value + (support_pruning csp) + (define removals + (for/list ([a (hash-ref ($csp-curr_domains csp) var)] + #:when (not (equal? a value))) + (cons var a))) + (hash-set! ($csp-curr_domains csp) var (list value)) + removals) + + +(define/contract (prune csp var value removals) + ($csp? symbol? any/c (or/c #f (listof (cons/c symbol? any/c))) . -> . (listof (cons/c symbol? any/c))) + ;; Rule out var=value + (hash-update! ($csp-curr_domains csp) var + (λ (vals) (remove value vals))) + (and removals + (append removals (list (cons var value))))) + +(define/contract (choices csp var) + ($csp? symbol? . -> . (listof any/c)) + ;; Return all values for var that aren't currently ruled out. + (hash-ref (or ($csp-curr_domains csp) ($csp-domains csp)) var)) + +(define/contract (infer_assignment csp) + ($csp? . -> . hash?) + ;; Return the partial assignment implied by the current inferences. + (support_pruning csp) + (let ([a (make-hash)]) + (for ([v ($csp-variables csp)] + #:when (= 1 (length (hash-ref ($csp-curr_domains csp) v)))) + (hash-set! a v (first (hash-ref ($csp-curr_domains csp) v)))) + a)) + +(define/contract (restore csp removals) + ($csp? (listof (cons/c symbol? any/c)) . -> . void?) + ;; Undo a supposition and all inferences from it. + (for ([removal removals]) + (match-define (cons B b) removal) + (hash-update! ($csp-curr_domains csp) B + (λ (vals) (append vals (list b)))))) + + +;; ______________________________________________________________________________ +;; CSP Backtracking Search + +;; Variable ordering + +(define/contract (first_unassigned_variable assignment csp) + (hash? $csp? . -> . symbol?) + ;; The default variable order. + (for/first ([var ($csp-variables csp)] + #:when (not (hash-has-key? assignment var))) + var)) + +;; Value ordering + +(define/contract (unordered_domain_values var assignment csp) + (symbol? hash? $csp? . -> . (listof any/c)) + ;; The default value order. + (choices csp var)) + +;; Inference + +(define/contract (no_inference csp var value assignment removals) + ($csp? symbol? any/c hash? (listof (cons/c symbol? any/c)) . -> . boolean?) + #true) + +(define/contract (backtracking_search csp + [select_unassigned_variable first_unassigned_variable] + [order_domain_values unordered_domain_values] + [inference no_inference]) + (($csp?) (procedure? procedure? procedure?) . ->* . (or/c #f hash?)) + #f) + +(require rackunit) +(define vs '(wa nsw t q nt v sa)) +(define ds (for/hash ([k vs]) + (values k '(red green blue)))) +(define ns (for*/hash ([k vs] + [k2 (cdr vs)]) + (values k (list k2)))) +(define csp (make-csp vs ds ns void)) +(check-true ($csp? csp)) +(define a (make-hash)) +(assign csp 'key 42 a) +(check-equal? (hash-ref a 'key) 42) +(unassign csp 'key a) +(check-exn exn:fail? (λ () (hash-ref a 'key))) +(check-equal? 0 (nconflicts csp 'wa 'red (hasheq 'wa 42))) +(support_pruning csp) +(check-true (hash? ($csp-curr_domains csp))) + +(check-equal? + (suppose csp 'wa 'red) + '((wa . green) (wa . blue))) +(check-equal? + (hash-ref ($csp-curr_domains csp) 'wa) '(red)) + +(check-equal? (prune csp 'v 'red empty) '((v . red))) + +(check-equal? (choices csp 'v) '(green blue)) +(check-equal? (choices csp 'wa) '(red)) +(check-equal? (infer_assignment csp) + (make-hash '((wa . red)))) +(check-equal? (suppose csp 'v 'blue) '((v . green))) +(check-equal? (infer_assignment csp) + (make-hash '((v . blue) (wa . red)))) +(restore csp '((wa . green))) +(check-equal? (infer_assignment csp) + (make-hash '((v . blue)))) + +(check-equal? (first_unassigned_variable (hash) csp) 'wa) +(check-equal? (unordered_domain_values 'wa (hash) csp) '(red green)) + +(backtracking_search csp) \ No newline at end of file From 9ce8bc01eadceab48e322037ea4cdb1451b25341 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Sun, 14 Oct 2018 23:29:29 -0700 Subject: [PATCH 115/246] generations --- csp/aima.rkt | 172 ++++++++++++++++++++++++++++++++------------------- 1 file changed, 108 insertions(+), 64 deletions(-) diff --git a/csp/aima.rkt b/csp/aima.rkt index ced9d838..1b59c2a0 100644 --- a/csp/aima.rkt +++ b/csp/aima.rkt @@ -1,59 +1,65 @@ #lang debug racket +(require racket/generator sugar/debug) (struct $csp (variables domains neighbors constraints initial curr_domains nassigns) #:transparent #:mutable) +(define assignment? hash?) +(define variable? symbol?) +(define removal? (cons/c variable? any/c)) (define/contract (make-csp variables domains neighbors constraints) - ((listof symbol?) hash? hash? procedure? . -> . $csp?) - ($csp - variables - domains - neighbors - constraints - null - #f - 0)) + ((listof variable?) hash? hash? procedure? . -> . $csp?) + ($csp variables domains neighbors constraints null #f 0)) (define/contract (assign csp var val assignment) - ($csp? symbol? any/c hash? . -> . void?) + ($csp? variable? any/c assignment? . -> . void?) ;; Add {var: val} to assignment; Discard the old value if any. (hash-set! assignment var val) (set-$csp-nassigns! csp (add1 ($csp-nassigns csp)))) (define/contract (unassign csp var assignment) - ($csp? symbol? hash? . -> . void?) + ($csp? variable? assignment? . -> . void?) ;; Remove {var: val} from assignment. ;; DO NOT call this if you are changing a variable to a new value; ;; just call assign for that. (hash-remove! assignment var)) (define/contract (nconflicts csp var val assignment) - ($csp? symbol? any/c hash? . -> . number?) + ($csp? variable? any/c assignment? . -> . number?) ;; Return the number of conflicts var=val has with other variables.""" ;; Subclasses may implement this more efficiently - (define (conflict var2) - (and (hash-has-key? assignment var2) - (not (($csp-constraints csp) var val var2 (hash-ref assignment var2))))) - (for/sum ([v (hash-ref ($csp-neighbors csp) var)] - #:when (conflict v)) - 1)) + (for/sum ([v (in-list (hash-ref ($csp-neighbors csp) var))] + #:when (hash-has-key? assignment v)) + (if (($csp-constraints csp) var val v (hash-ref assignment v)) 0 1))) (define (display csp assignment) - (displayln "todo")) + (displayln csp)) + +(define/contract (all-variables-assigned? csp assignment) + ($csp? assignment? . -> . boolean?) + (= (length (hash-keys assignment)) (length ($csp-variables csp)))) + +(define/contract (goal_test csp state) + ($csp? assignment? . -> . boolean?) + ;; The goal is to assign all variables, with all constraints satisfied. + (define assignment state) + (and (all-variables-assigned? csp assignment) + (for/and ([variable ($csp-variables csp)]) + (zero? (nconflicts csp variable (hash-ref assignment variable) assignment))))) + +;; These are for constraint propagation (define/contract (support_pruning csp) ($csp? . -> . void?) ;; Make sure we can prune values from domains. (We want to pay ;; for this only if we use it.) - (when (false? ($csp-curr_domains csp)) - (set-$csp-curr_domains! - csp - (let ([h (make-hash)]) - (for ([v ($csp-variables csp)]) - (hash-set! h v (hash-ref ($csp-domains csp) v))) - h)))) + (unless ($csp-curr_domains csp) + (define h (make-hasheq)) + (for ([v ($csp-variables csp)]) + (hash-set! h v (hash-ref ($csp-domains csp) v))) + (set-$csp-curr_domains! csp h))) (define/contract (suppose csp var value) - ($csp? symbol? any/c . -> . (listof (cons/c symbol? any/c))) + ($csp? variable? any/c . -> . (listof removal?)) ;; Start accumulating inferences from assuming var=value (support_pruning csp) (define removals @@ -63,37 +69,36 @@ (hash-set! ($csp-curr_domains csp) var (list value)) removals) - +;; todo: update uses of `prune` to be functional on removals (define/contract (prune csp var value removals) - ($csp? symbol? any/c (or/c #f (listof (cons/c symbol? any/c))) . -> . (listof (cons/c symbol? any/c))) + ($csp? variable? any/c (or/c #f (listof removal?)) . -> . (listof removal?)) ;; Rule out var=value - (hash-update! ($csp-curr_domains csp) var - (λ (vals) (remove value vals))) - (and removals - (append removals (list (cons var value))))) + (hash-update! ($csp-curr_domains csp) var (λ (vals) (remove value vals))) + (and removals (append removals (list (cons var value))))) (define/contract (choices csp var) - ($csp? symbol? . -> . (listof any/c)) + ($csp? variable? . -> . (listof any/c)) ;; Return all values for var that aren't currently ruled out. (hash-ref (or ($csp-curr_domains csp) ($csp-domains csp)) var)) (define/contract (infer_assignment csp) - ($csp? . -> . hash?) + ($csp? . -> . assignment?) ;; Return the partial assignment implied by the current inferences. (support_pruning csp) - (let ([a (make-hash)]) - (for ([v ($csp-variables csp)] - #:when (= 1 (length (hash-ref ($csp-curr_domains csp) v)))) - (hash-set! a v (first (hash-ref ($csp-curr_domains csp) v)))) - a)) + (define assignment (make-hasheq)) + (for ([v (in-list ($csp-variables csp))]) + (match (hash-ref ($csp-curr_domains csp) v) + [(list one-value) (hash-set! assignment v one-value)] + [else #f])) + assignment) (define/contract (restore csp removals) - ($csp? (listof (cons/c symbol? any/c)) . -> . void?) + ($csp? (listof removal?) . -> . void?) ;; Undo a supposition and all inferences from it. - (for ([removal removals]) - (match-define (cons B b) removal) - (hash-update! ($csp-curr_domains csp) B - (λ (vals) (append vals (list b)))))) + (for ([removal (in-list removals)]) + (match removal + [(cons B b) (hash-update! ($csp-curr_domains csp) B + (λ (vals) (append vals (list b))))]))) ;; ______________________________________________________________________________ @@ -102,42 +107,73 @@ ;; Variable ordering (define/contract (first_unassigned_variable assignment csp) - (hash? $csp? . -> . symbol?) + (assignment? $csp? . -> . (or/c #false variable?)) ;; The default variable order. - (for/first ([var ($csp-variables csp)] - #:when (not (hash-has-key? assignment var))) + (for/first ([var (in-list ($csp-variables csp))] + #:unless (hash-has-key? assignment var)) var)) ;; Value ordering (define/contract (unordered_domain_values var assignment csp) - (symbol? hash? $csp? . -> . (listof any/c)) + (variable? assignment? $csp? . -> . (listof any/c)) ;; The default value order. (choices csp var)) ;; Inference (define/contract (no_inference csp var value assignment removals) - ($csp? symbol? any/c hash? (listof (cons/c symbol? any/c)) . -> . boolean?) + ($csp? variable? any/c assignment? (listof removal?) . -> . boolean?) #true) (define/contract (backtracking_search csp [select_unassigned_variable first_unassigned_variable] [order_domain_values unordered_domain_values] [inference no_inference]) - (($csp?) (procedure? procedure? procedure?) . ->* . (or/c #f hash?)) - #f) + (($csp?) (procedure? procedure? procedure?) . ->* . generator?) + (generator () + (let backtrack ([assignment (make-hasheq)]) + (match (select_unassigned_variable assignment csp) + [#false (and (goal_test csp assignment) assignment)] + [var + (cond + [(for/or ([val (in-list (order_domain_values var assignment csp))] + #:when (zero? (nconflicts csp var val assignment))) + (assign csp var val assignment) + (define removals (suppose csp var val)) + (cond + [(and (inference csp var val assignment removals) (backtrack assignment))] + [else (restore csp removals) #false]))] + [else (unassign csp var assignment) #false])])))) + +(define/contract (solve* csp [solver backtracking_search] [finish-proc values][solution-limit +inf.0]) + (($csp?) (procedure? procedure? integer?) . ->* . (non-empty-listof any/c)) + (match (for/list ([solution (in-producer (solver csp) (void))] + [idx (in-range solution-limit)]) + (finish-proc solution)) + [(? pair? solutions) solutions] + [else #f])) + +(define/contract (solve csp [solver backtracking_search] [finish-proc values]) + (($csp?) (procedure? procedure?) . ->* . any/c) + (first (solve* csp solver finish-proc 1))) (require rackunit) (define vs '(wa nsw t q nt v sa)) (define ds (for/hash ([k vs]) (values k '(red green blue)))) -(define ns (for*/hash ([k vs] - [k2 (cdr vs)]) - (values k (list k2)))) -(define csp (make-csp vs ds ns void)) +(define ns (for*/hash ([(i ns) (in-dict + '((wa nt sa) + (nt wa sa q) + (q nt sa nsw) + (nsw q sa v) + (v sa nsw) + (sa wa nt q nsw v) + (t)))]) + (values i ns))) +(define csp (make-csp vs ds ns (λ (A a B b) (not (equal? a b))))) (check-true ($csp? csp)) -(define a (make-hash)) +(define a (make-hasheq)) (assign csp 'key 42 a) (check-equal? (hash-ref a 'key) 42) (unassign csp 'key a) @@ -146,9 +182,7 @@ (support_pruning csp) (check-true (hash? ($csp-curr_domains csp))) -(check-equal? - (suppose csp 'wa 'red) - '((wa . green) (wa . blue))) +(check-equal? (suppose csp 'wa 'red) '((wa . green) (wa . blue))) (check-equal? (hash-ref ($csp-curr_domains csp) 'wa) '(red)) @@ -157,15 +191,25 @@ (check-equal? (choices csp 'v) '(green blue)) (check-equal? (choices csp 'wa) '(red)) (check-equal? (infer_assignment csp) - (make-hash '((wa . red)))) + (make-hasheq '((wa . red)))) (check-equal? (suppose csp 'v 'blue) '((v . green))) (check-equal? (infer_assignment csp) - (make-hash '((v . blue) (wa . red)))) + (make-hasheq '((v . blue) (wa . red)))) (restore csp '((wa . green))) (check-equal? (infer_assignment csp) - (make-hash '((v . blue)))) + (make-hasheq '((v . blue)))) +(restore csp '((v . blue))) +(check-equal? (infer_assignment csp) (make-hasheq)) (check-equal? (first_unassigned_variable (hash) csp) 'wa) (check-equal? (unordered_domain_values 'wa (hash) csp) '(red green)) -(backtracking_search csp) \ No newline at end of file +(set-$csp-curr_domains! csp #f) ; reset current domains + +(check-equal? (solve csp) + (make-hasheq '((nsw . green) (nt . green) (q . red) (sa . blue) (t . blue) (v . red) (wa . red)))) + +(set-$csp-curr_domains! csp #f) +(check-equal? (suppose csp 'nsw 'red) '((nsw . green) (nsw . blue))) +(check-equal? (solve csp) + (make-hasheq '((nsw . red) (nt . red) (q . green) (sa . blue) (t . blue) (v . green) (wa . green)))) From 279f17c53176da1cd6577506ca3d3e6ebf1fc840 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Mon, 15 Oct 2018 00:11:17 -0700 Subject: [PATCH 116/246] touch --- csp/aima.rkt | 10 +++++++--- 1 file changed, 7 insertions(+), 3 deletions(-) diff --git a/csp/aima.rkt b/csp/aima.rkt index 1b59c2a0..135d2319 100644 --- a/csp/aima.rkt +++ b/csp/aima.rkt @@ -132,6 +132,7 @@ [inference no_inference]) (($csp?) (procedure? procedure? procedure?) . ->* . generator?) (generator () + ;; todo: incorporate `yield` (let backtrack ([assignment (make-hasheq)]) (match (select_unassigned_variable assignment csp) [#false (and (goal_test csp assignment) assignment)] @@ -146,8 +147,9 @@ [else (restore csp removals) #false]))] [else (unassign csp var assignment) #false])])))) -(define/contract (solve* csp [solver backtracking_search] [finish-proc values][solution-limit +inf.0]) - (($csp?) (procedure? procedure? integer?) . ->* . (non-empty-listof any/c)) +(define/contract (solve* csp [solver backtracking_search] [finish-proc values] + #:count [solution-limit +inf.0]) + (($csp?) (procedure? procedure? #:count integer?) . ->* . (or/c #f (non-empty-listof any/c))) (match (for/list ([solution (in-producer (solver csp) (void))] [idx (in-range solution-limit)]) (finish-proc solution)) @@ -156,7 +158,9 @@ (define/contract (solve csp [solver backtracking_search] [finish-proc values]) (($csp?) (procedure? procedure?) . ->* . any/c) - (first (solve* csp solver finish-proc 1))) + (match (solve* csp solver finish-proc #:count 1) + [(list solution) solution] + [else #f])) (require rackunit) (define vs '(wa nsw t q nt v sa)) From eee5f208121dc0fa46e4cd2b73103abccb72a14c Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Mon, 15 Oct 2018 00:15:02 -0700 Subject: [PATCH 117/246] note --- csp/aima.rkt | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/csp/aima.rkt b/csp/aima.rkt index 135d2319..703a41b4 100644 --- a/csp/aima.rkt +++ b/csp/aima.rkt @@ -135,7 +135,7 @@ ;; todo: incorporate `yield` (let backtrack ([assignment (make-hasheq)]) (match (select_unassigned_variable assignment csp) - [#false (and (goal_test csp assignment) assignment)] + [#false (and (goal_test csp assignment) (yield assignment))] [var (cond [(for/or ([val (in-list (order_domain_values var assignment csp))] @@ -147,6 +147,7 @@ [else (restore csp removals) #false]))] [else (unassign csp var assignment) #false])])))) +;; todo: make multiple results work (define/contract (solve* csp [solver backtracking_search] [finish-proc values] #:count [solution-limit +inf.0]) (($csp?) (procedure? procedure? #:count integer?) . ->* . (or/c #f (non-empty-listof any/c))) From b7ed47677ac0a646771676fb2c63ca37d061db85 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Mon, 15 Oct 2018 10:39:12 -0700 Subject: [PATCH 118/246] oh well --- csp/aima.rkt | 41 ++++++++++++++++++++++++----------------- 1 file changed, 24 insertions(+), 17 deletions(-) diff --git a/csp/aima.rkt b/csp/aima.rkt index 703a41b4..13d2f8da 100644 --- a/csp/aima.rkt +++ b/csp/aima.rkt @@ -130,28 +130,35 @@ [select_unassigned_variable first_unassigned_variable] [order_domain_values unordered_domain_values] [inference no_inference]) - (($csp?) (procedure? procedure? procedure?) . ->* . generator?) - (generator () - ;; todo: incorporate `yield` - (let backtrack ([assignment (make-hasheq)]) - (match (select_unassigned_variable assignment csp) - [#false (and (goal_test csp assignment) (yield assignment))] - [var - (cond - [(for/or ([val (in-list (order_domain_values var assignment csp))] - #:when (zero? (nconflicts csp var val assignment))) - (assign csp var val assignment) - (define removals (suppose csp var val)) - (cond - [(and (inference csp var val assignment removals) (backtrack assignment))] - [else (restore csp removals) #false]))] - [else (unassign csp var assignment) #false])])))) + (($csp?) (procedure? procedure? procedure?) . ->* . (or/c #f assignment?)) + (define (backtrack [assignment (make-hasheq)]) + ;; todo: convert to generator with `yield` + (let/ec return + (when (all-variables-assigned? csp assignment) + (return assignment)) + (define var (select_unassigned_variable assignment csp)) + (for ([val (in-list (order_domain_values var assignment csp))] + #:when (zero? (nconflicts csp var val assignment))) + (assign csp var val assignment) + (define removals (suppose csp var val)) + (when (inference csp var val assignment removals) + (define result (backtrack assignment)) + (when result + (return result)) + (restore csp removals))) + (unassign csp var assignment) + (return #false))) + + (define result (backtrack)) + (unless (or (false? result) (goal_test csp result)) + (error 'whut)) + result) ;; todo: make multiple results work (define/contract (solve* csp [solver backtracking_search] [finish-proc values] #:count [solution-limit +inf.0]) (($csp?) (procedure? procedure? #:count integer?) . ->* . (or/c #f (non-empty-listof any/c))) - (match (for/list ([solution (in-producer (solver csp) (void))] + (match (for/list ([solution (in-value (solver csp))] ; needs generator here [idx (in-range solution-limit)]) (finish-proc solution)) [(? pair? solutions) solutions] From eb0c99b9ba1ab7d880a882c292e8073e92a3127a Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Mon, 15 Oct 2018 13:37:51 -0700 Subject: [PATCH 119/246] fc --- csp/aima.rkt | 133 +++++++++++++++++++++++++++++++++++++-------------- 1 file changed, 97 insertions(+), 36 deletions(-) diff --git a/csp/aima.rkt b/csp/aima.rkt index 13d2f8da..8dde7680 100644 --- a/csp/aima.rkt +++ b/csp/aima.rkt @@ -113,6 +113,28 @@ #:unless (hash-has-key? assignment var)) var)) +(define current-shuffle (make-parameter #t)) + +(define/contract (mrv assignment csp) + (assignment? $csp? . -> . any/c) + ;; Minimum-remaining-values heuristic. + ;; with random tiebreaker. + (define (num_legal_values var) + (if ($csp-curr_domains csp) + (length (hash-ref ($csp-curr_domains csp) var)) + ;; todo: is this the same as python `count`? + (for/sum ([val (in-list (hash-ref ($csp-domains csp) var))] + #:when (zero? (nconflicts csp var val assignment))) + 1))) + (struct $mrv-rec (var num) #:transparent) + (define recs (sort + (for/list ([var (in-list ($csp-variables csp))] + #:unless (hash-has-key? assignment var)) + ($mrv-rec var (num_legal_values var))) + < #:key $mrv-rec-num)) + (first ((if (current-shuffle) shuffle values) (map $mrv-rec-var (takef recs (λ (rec) (= ($mrv-rec-num (first recs)) + ($mrv-rec-num rec)))))))) + ;; Value ordering (define/contract (unordered_domain_values var assignment csp) @@ -120,55 +142,71 @@ ;; The default value order. (choices csp var)) +(define/contract (lcv var assignment csp) + (variable? assignment? $csp? . -> . (listof any/c)) + ;; Least-constraining-values heuristic. + (sort (choices csp var) < #:key (λ (val) (nconflicts csp var val assignment)))) + ;; Inference (define/contract (no_inference csp var value assignment removals) ($csp? variable? any/c assignment? (listof removal?) . -> . boolean?) #true) +(define/contract (forward_checking csp var value assignment removals) + ($csp? variable? any/c assignment? (listof removal?) . -> . boolean?) + ;; Prune neighbor values inconsistent with var=value. + (support_pruning csp) ;; necessary to set up curr_domains + (for/and ([B (in-list (hash-ref ($csp-neighbors csp) var))] + #:unless (hash-has-key? assignment B)) + (for/fold ([removals removals]) + ([b (in-list (hash-ref ($csp-curr_domains csp) B))] + #:unless (($csp-constraints csp) var value B b)) + (prune csp B b removals)) + (not (empty? (hash-ref ($csp-curr_domains csp) B))))) + +(define current-select-variable (make-parameter first_unassigned_variable)) +(define current-order-values (make-parameter unordered_domain_values)) +(define current-inference (make-parameter no_inference)) + (define/contract (backtracking_search csp - [select_unassigned_variable first_unassigned_variable] - [order_domain_values unordered_domain_values] - [inference no_inference]) - (($csp?) (procedure? procedure? procedure?) . ->* . (or/c #f assignment?)) - (define (backtrack [assignment (make-hasheq)]) - ;; todo: convert to generator with `yield` - (let/ec return - (when (all-variables-assigned? csp assignment) - (return assignment)) - (define var (select_unassigned_variable assignment csp)) - (for ([val (in-list (order_domain_values var assignment csp))] - #:when (zero? (nconflicts csp var val assignment))) - (assign csp var val assignment) - (define removals (suppose csp var val)) - (when (inference csp var val assignment removals) - (define result (backtrack assignment)) - (when result - (return result)) - (restore csp removals))) - (unassign csp var assignment) - (return #false))) - - (define result (backtrack)) - (unless (or (false? result) (goal_test csp result)) - (error 'whut)) - result) - -;; todo: make multiple results work + [select_unassigned_variable (current-select-variable)] + [order_domain_values (current-order-values)] + [inference (current-inference)]) + (($csp?) (procedure? procedure? procedure?) . ->* . generator?) + (generator () + (let backtrack ([assignment (make-hasheq)]) + (cond + [(all-variables-assigned? csp assignment) + (unless (goal_test csp assignment) (error 'whut)) + (yield (hash-copy assignment))] + [else + (define var (select_unassigned_variable assignment csp)) + (for ([val (in-list (order_domain_values var assignment csp))] + #:when (zero? (nconflicts csp var val assignment))) + (assign csp var val assignment) + (define removals (suppose csp var val)) + (when (inference csp var val assignment removals) + (backtrack assignment)) + (restore csp removals)) + (unassign csp var assignment)])))) + (define/contract (solve* csp [solver backtracking_search] [finish-proc values] #:count [solution-limit +inf.0]) (($csp?) (procedure? procedure? #:count integer?) . ->* . (or/c #f (non-empty-listof any/c))) - (match (for/list ([solution (in-value (solver csp))] ; needs generator here - [idx (in-range solution-limit)]) - (finish-proc solution)) - [(? pair? solutions) solutions] - [else #f])) + (begin0 + (match (for/list ([solution (in-producer (solver csp) (void))] + [idx (in-range solution-limit)]) + (finish-proc solution)) + [(? pair? solutions) solutions] + [else #false]) + (set-$csp-curr_domains! csp #f))) (define/contract (solve csp [solver backtracking_search] [finish-proc values]) (($csp?) (procedure? procedure?) . ->* . any/c) (match (solve* csp solver finish-proc #:count 1) [(list solution) solution] - [else #f])) + [else #false])) (require rackunit) (define vs '(wa nsw t q nt v sa)) @@ -217,11 +255,34 @@ (check-equal? (unordered_domain_values 'wa (hash) csp) '(red green)) (set-$csp-curr_domains! csp #f) ; reset current domains - (check-equal? (solve csp) (make-hasheq '((nsw . green) (nt . green) (q . red) (sa . blue) (t . blue) (v . red) (wa . red)))) +(check-equal? (length (solve* csp)) 18) -(set-$csp-curr_domains! csp #f) (check-equal? (suppose csp 'nsw 'red) '((nsw . green) (nsw . blue))) (check-equal? (solve csp) (make-hasheq '((nsw . red) (nt . red) (q . green) (sa . blue) (t . blue) (v . green) (wa . green)))) + +(check-equal? (suppose csp 'nsw 'red) '((nsw . green) (nsw . blue))) +(check-equal? (length (solve* csp)) 6) + +(parameterize ([current-select-variable mrv] + [current-shuffle #f]) + (check-equal? + (solve csp) + (make-hasheq '((nsw . green) (nt . green) (q . red) (sa . blue) (t . blue) (v . red) (wa . red))))) + +(parameterize ([current-order-values lcv]) + (check-equal? + (solve csp) + (make-hasheq '((nsw . green) (nt . green) (q . red) (sa . blue) (t . blue) (v . red) (wa . red))))) + +(parameterize ([current-inference forward_checking]) + (forward_checking csp 'sa 'blue (make-hasheq) null) + (check-equal? ($csp-curr_domains csp) + (make-hasheq '((nsw . (red green)) (nt . (red green)) (q . (red green)) (sa . (red green blue)) (t . (red green blue)) (v . (red green)) (wa . (red green)))))) + +(parameterize ([current-inference forward_checking]) + (support_pruning csp) + (solve csp)) + From 9a6ac0ab26f9265396520b65e6f332a40a9c0057 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Mon, 15 Oct 2018 14:56:23 -0700 Subject: [PATCH 120/246] removals --- csp/aima.rkt | 22 +++++++++++++++------- 1 file changed, 15 insertions(+), 7 deletions(-) diff --git a/csp/aima.rkt b/csp/aima.rkt index 8dde7680..54b65714 100644 --- a/csp/aima.rkt +++ b/csp/aima.rkt @@ -157,13 +157,16 @@ ($csp? variable? any/c assignment? (listof removal?) . -> . boolean?) ;; Prune neighbor values inconsistent with var=value. (support_pruning csp) ;; necessary to set up curr_domains + #R var #R value (for/and ([B (in-list (hash-ref ($csp-neighbors csp) var))] #:unless (hash-has-key? assignment B)) + (report B 'pruning-var) (for/fold ([removals removals]) ([b (in-list (hash-ref ($csp-curr_domains csp) B))] #:unless (($csp-constraints csp) var value B b)) + (report b 'pruning-val) (prune csp B b removals)) - (not (empty? (hash-ref ($csp-curr_domains csp) B))))) + (not (empty? #R (hash-ref ($csp-curr_domains csp) B))))) (define current-select-variable (make-parameter first_unassigned_variable)) (define current-order-values (make-parameter unordered_domain_values)) @@ -191,6 +194,8 @@ (restore csp removals)) (unassign csp var assignment)])))) +(define current-reset (make-parameter #t)) + (define/contract (solve* csp [solver backtracking_search] [finish-proc values] #:count [solution-limit +inf.0]) (($csp?) (procedure? procedure? #:count integer?) . ->* . (or/c #f (non-empty-listof any/c))) @@ -200,7 +205,8 @@ (finish-proc solution)) [(? pair? solutions) solutions] [else #false]) - (set-$csp-curr_domains! csp #f))) + (when (current-reset) + (set-$csp-curr_domains! csp #f)))) (define/contract (solve csp [solver backtracking_search] [finish-proc values]) (($csp?) (procedure? procedure?) . ->* . any/c) @@ -277,12 +283,14 @@ (solve csp) (make-hasheq '((nsw . green) (nt . green) (q . red) (sa . blue) (t . blue) (v . red) (wa . red))))) -(parameterize ([current-inference forward_checking]) - (forward_checking csp 'sa 'blue (make-hasheq) null) - (check-equal? ($csp-curr_domains csp) - (make-hasheq '((nsw . (red green)) (nt . (red green)) (q . (red green)) (sa . (red green blue)) (t . (red green blue)) (v . (red green)) (wa . (red green)))))) +#;(parameterize ([current-inference forward_checking]) + (forward_checking csp 'sa 'blue (make-hasheq) null) + (check-equal? ($csp-curr_domains csp) + (make-hasheq '((nsw . (red green)) (nt . (red green)) (q . (red green)) (sa . (red green blue)) (t . (red green blue)) (v . (red green)) (wa . (red green)))))) -(parameterize ([current-inference forward_checking]) +(set-$csp-curr_domains! csp #f) +(parameterize ([current-inference forward_checking] + [current-reset #f]) (support_pruning csp) (solve csp)) From a631ee4547e1bc0ae8ae3953de07c59d5ca1770b Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Mon, 15 Oct 2018 15:27:36 -0700 Subject: [PATCH 121/246] param style --- csp/aima.rkt | 51 ++++++++++++++++++++++++++------------------------- 1 file changed, 26 insertions(+), 25 deletions(-) diff --git a/csp/aima.rkt b/csp/aima.rkt index 54b65714..c9922a93 100644 --- a/csp/aima.rkt +++ b/csp/aima.rkt @@ -5,6 +5,7 @@ (define assignment? hash?) (define variable? symbol?) (define removal? (cons/c variable? any/c)) +(define current-removals (make-parameter empty)) (define/contract (make-csp variables domains neighbors constraints) ((listof variable?) hash? hash? procedure? . -> . $csp?) @@ -70,11 +71,11 @@ removals) ;; todo: update uses of `prune` to be functional on removals -(define/contract (prune csp var value removals) - ($csp? variable? any/c (or/c #f (listof removal?)) . -> . (listof removal?)) +(define/contract (prune csp var value) + ($csp? variable? any/c . -> . void?) ;; Rule out var=value (hash-update! ($csp-curr_domains csp) var (λ (vals) (remove value vals))) - (and removals (append removals (list (cons var value))))) + (current-removals (append (current-removals) (list (cons var value))))) (define/contract (choices csp var) ($csp? variable? . -> . (listof any/c)) @@ -92,10 +93,10 @@ [else #f])) assignment) -(define/contract (restore csp removals) - ($csp? (listof removal?) . -> . void?) +(define/contract (restore csp) + ($csp? . -> . void?) ;; Undo a supposition and all inferences from it. - (for ([removal (in-list removals)]) + (for ([removal (in-list (current-removals))]) (match removal [(cons B b) (hash-update! ($csp-curr_domains csp) B (λ (vals) (append vals (list b))))]))) @@ -149,23 +150,22 @@ ;; Inference -(define/contract (no_inference csp var value assignment removals) - ($csp? variable? any/c assignment? (listof removal?) . -> . boolean?) +(define/contract (no_inference csp var value assignment) + ($csp? variable? any/c assignment? . -> . boolean?) #true) -(define/contract (forward_checking csp var value assignment removals) - ($csp? variable? any/c assignment? (listof removal?) . -> . boolean?) +(define/contract (forward_checking csp var value assignment) + ($csp? variable? any/c assignment? . -> . boolean?) ;; Prune neighbor values inconsistent with var=value. (support_pruning csp) ;; necessary to set up curr_domains #R var #R value (for/and ([B (in-list (hash-ref ($csp-neighbors csp) var))] #:unless (hash-has-key? assignment B)) (report B 'pruning-var) - (for/fold ([removals removals]) - ([b (in-list (hash-ref ($csp-curr_domains csp) B))] - #:unless (($csp-constraints csp) var value B b)) + (for ([b (in-list (hash-ref ($csp-curr_domains csp) B))] + #:unless (($csp-constraints csp) var value B b)) (report b 'pruning-val) - (prune csp B b removals)) + (prune csp B b)) (not (empty? #R (hash-ref ($csp-curr_domains csp) B))))) (define current-select-variable (make-parameter first_unassigned_variable)) @@ -188,10 +188,10 @@ (for ([val (in-list (order_domain_values var assignment csp))] #:when (zero? (nconflicts csp var val assignment))) (assign csp var val assignment) - (define removals (suppose csp var val)) - (when (inference csp var val assignment removals) - (backtrack assignment)) - (restore csp removals)) + (parameterize ([current-removals (suppose csp var val)]) + (when (inference csp var val assignment) + (backtrack assignment)) + (restore csp))) (unassign csp var assignment)])))) (define current-reset (make-parameter #t)) @@ -206,7 +206,7 @@ [(? pair? solutions) solutions] [else #false]) (when (current-reset) - (set-$csp-curr_domains! csp #f)))) + (set-$csp-curr_domains! csp #f)))) (define/contract (solve csp [solver backtracking_search] [finish-proc values]) (($csp?) (procedure? procedure?) . ->* . any/c) @@ -242,23 +242,24 @@ (check-equal? (hash-ref ($csp-curr_domains csp) 'wa) '(red)) -(check-equal? (prune csp 'v 'red empty) '((v . red))) +#;(check-equal? (prune csp 'v 'red) '((v . red))) -(check-equal? (choices csp 'v) '(green blue)) +#;(check-equal? (choices csp 'v) '(green blue)) (check-equal? (choices csp 'wa) '(red)) (check-equal? (infer_assignment csp) (make-hasheq '((wa . red)))) -(check-equal? (suppose csp 'v 'blue) '((v . green))) -(check-equal? (infer_assignment csp) +#;(check-equal? (suppose csp 'v 'blue) '((v . green))) +#;(check-equal? (infer_assignment csp) (make-hasheq '((v . blue) (wa . red)))) +#| (restore csp '((wa . green))) (check-equal? (infer_assignment csp) (make-hasheq '((v . blue)))) (restore csp '((v . blue))) (check-equal? (infer_assignment csp) (make-hasheq)) - +|# (check-equal? (first_unassigned_variable (hash) csp) 'wa) -(check-equal? (unordered_domain_values 'wa (hash) csp) '(red green)) +#;(check-equal? (unordered_domain_values 'wa (hash) csp) '(red green)) (set-$csp-curr_domains! csp #f) ; reset current domains (check-equal? (solve csp) From 0f8cca3ceceff730a83b55a2a2cd68410b2cdd2f Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Mon, 15 Oct 2018 15:27:50 -0700 Subject: [PATCH 122/246] Revert "param style" This reverts commit a631ee4547e1bc0ae8ae3953de07c59d5ca1770b. --- csp/aima.rkt | 51 +++++++++++++++++++++++++-------------------------- 1 file changed, 25 insertions(+), 26 deletions(-) diff --git a/csp/aima.rkt b/csp/aima.rkt index c9922a93..54b65714 100644 --- a/csp/aima.rkt +++ b/csp/aima.rkt @@ -5,7 +5,6 @@ (define assignment? hash?) (define variable? symbol?) (define removal? (cons/c variable? any/c)) -(define current-removals (make-parameter empty)) (define/contract (make-csp variables domains neighbors constraints) ((listof variable?) hash? hash? procedure? . -> . $csp?) @@ -71,11 +70,11 @@ removals) ;; todo: update uses of `prune` to be functional on removals -(define/contract (prune csp var value) - ($csp? variable? any/c . -> . void?) +(define/contract (prune csp var value removals) + ($csp? variable? any/c (or/c #f (listof removal?)) . -> . (listof removal?)) ;; Rule out var=value (hash-update! ($csp-curr_domains csp) var (λ (vals) (remove value vals))) - (current-removals (append (current-removals) (list (cons var value))))) + (and removals (append removals (list (cons var value))))) (define/contract (choices csp var) ($csp? variable? . -> . (listof any/c)) @@ -93,10 +92,10 @@ [else #f])) assignment) -(define/contract (restore csp) - ($csp? . -> . void?) +(define/contract (restore csp removals) + ($csp? (listof removal?) . -> . void?) ;; Undo a supposition and all inferences from it. - (for ([removal (in-list (current-removals))]) + (for ([removal (in-list removals)]) (match removal [(cons B b) (hash-update! ($csp-curr_domains csp) B (λ (vals) (append vals (list b))))]))) @@ -150,22 +149,23 @@ ;; Inference -(define/contract (no_inference csp var value assignment) - ($csp? variable? any/c assignment? . -> . boolean?) +(define/contract (no_inference csp var value assignment removals) + ($csp? variable? any/c assignment? (listof removal?) . -> . boolean?) #true) -(define/contract (forward_checking csp var value assignment) - ($csp? variable? any/c assignment? . -> . boolean?) +(define/contract (forward_checking csp var value assignment removals) + ($csp? variable? any/c assignment? (listof removal?) . -> . boolean?) ;; Prune neighbor values inconsistent with var=value. (support_pruning csp) ;; necessary to set up curr_domains #R var #R value (for/and ([B (in-list (hash-ref ($csp-neighbors csp) var))] #:unless (hash-has-key? assignment B)) (report B 'pruning-var) - (for ([b (in-list (hash-ref ($csp-curr_domains csp) B))] - #:unless (($csp-constraints csp) var value B b)) + (for/fold ([removals removals]) + ([b (in-list (hash-ref ($csp-curr_domains csp) B))] + #:unless (($csp-constraints csp) var value B b)) (report b 'pruning-val) - (prune csp B b)) + (prune csp B b removals)) (not (empty? #R (hash-ref ($csp-curr_domains csp) B))))) (define current-select-variable (make-parameter first_unassigned_variable)) @@ -188,10 +188,10 @@ (for ([val (in-list (order_domain_values var assignment csp))] #:when (zero? (nconflicts csp var val assignment))) (assign csp var val assignment) - (parameterize ([current-removals (suppose csp var val)]) - (when (inference csp var val assignment) - (backtrack assignment)) - (restore csp))) + (define removals (suppose csp var val)) + (when (inference csp var val assignment removals) + (backtrack assignment)) + (restore csp removals)) (unassign csp var assignment)])))) (define current-reset (make-parameter #t)) @@ -206,7 +206,7 @@ [(? pair? solutions) solutions] [else #false]) (when (current-reset) - (set-$csp-curr_domains! csp #f)))) + (set-$csp-curr_domains! csp #f)))) (define/contract (solve csp [solver backtracking_search] [finish-proc values]) (($csp?) (procedure? procedure?) . ->* . any/c) @@ -242,24 +242,23 @@ (check-equal? (hash-ref ($csp-curr_domains csp) 'wa) '(red)) -#;(check-equal? (prune csp 'v 'red) '((v . red))) +(check-equal? (prune csp 'v 'red empty) '((v . red))) -#;(check-equal? (choices csp 'v) '(green blue)) +(check-equal? (choices csp 'v) '(green blue)) (check-equal? (choices csp 'wa) '(red)) (check-equal? (infer_assignment csp) (make-hasheq '((wa . red)))) -#;(check-equal? (suppose csp 'v 'blue) '((v . green))) -#;(check-equal? (infer_assignment csp) +(check-equal? (suppose csp 'v 'blue) '((v . green))) +(check-equal? (infer_assignment csp) (make-hasheq '((v . blue) (wa . red)))) -#| (restore csp '((wa . green))) (check-equal? (infer_assignment csp) (make-hasheq '((v . blue)))) (restore csp '((v . blue))) (check-equal? (infer_assignment csp) (make-hasheq)) -|# + (check-equal? (first_unassigned_variable (hash) csp) 'wa) -#;(check-equal? (unordered_domain_values 'wa (hash) csp) '(red green)) +(check-equal? (unordered_domain_values 'wa (hash) csp) '(red green)) (set-$csp-curr_domains! csp #f) ; reset current domains (check-equal? (solve csp) From e4614a0957e68fcf6b385fca8f98fb008c0c1c3c Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Mon, 15 Oct 2018 15:36:03 -0700 Subject: [PATCH 123/246] box style --- csp/aima.rkt | 61 ++++++++++++++++++++++++++-------------------------- 1 file changed, 30 insertions(+), 31 deletions(-) diff --git a/csp/aima.rkt b/csp/aima.rkt index 54b65714..5692d8e9 100644 --- a/csp/aima.rkt +++ b/csp/aima.rkt @@ -59,22 +59,23 @@ (set-$csp-curr_domains! csp h))) (define/contract (suppose csp var value) - ($csp? variable? any/c . -> . (listof removal?)) + ($csp? variable? any/c . -> . (box/c (listof removal?))) ;; Start accumulating inferences from assuming var=value (support_pruning csp) - (define removals - (for/list ([a (hash-ref ($csp-curr_domains csp) var)] - #:when (not (equal? a value))) - (cons var a))) - (hash-set! ($csp-curr_domains csp) var (list value)) - removals) + (begin0 + (box (for/list ([a (hash-ref ($csp-curr_domains csp) var)] + #:when (not (equal? a value))) + (cons var a))) + (hash-set! ($csp-curr_domains csp) var (list value)))) ;; todo: update uses of `prune` to be functional on removals (define/contract (prune csp var value removals) - ($csp? variable? any/c (or/c #f (listof removal?)) . -> . (listof removal?)) + ($csp? variable? any/c (or/c #f (box/c (listof removal?))) . -> . (box/c (listof removal?))) ;; Rule out var=value (hash-update! ($csp-curr_domains csp) var (λ (vals) (remove value vals))) - (and removals (append removals (list (cons var value))))) + (and removals + (set-box! removals (append (unbox removals) (list (cons var value)))) + removals)) (define/contract (choices csp var) ($csp? variable? . -> . (listof any/c)) @@ -93,9 +94,9 @@ assignment) (define/contract (restore csp removals) - ($csp? (listof removal?) . -> . void?) + ($csp? (box/c (listof removal?)) . -> . void?) ;; Undo a supposition and all inferences from it. - (for ([removal (in-list removals)]) + (for ([removal (in-list (unbox removals))]) (match removal [(cons B b) (hash-update! ($csp-curr_domains csp) B (λ (vals) (append vals (list b))))]))) @@ -150,23 +151,19 @@ ;; Inference (define/contract (no_inference csp var value assignment removals) - ($csp? variable? any/c assignment? (listof removal?) . -> . boolean?) + ($csp? variable? any/c assignment? (box/c (listof removal?)) . -> . boolean?) #true) (define/contract (forward_checking csp var value assignment removals) - ($csp? variable? any/c assignment? (listof removal?) . -> . boolean?) + ($csp? variable? any/c assignment? (box/c (listof removal?)) . -> . boolean?) ;; Prune neighbor values inconsistent with var=value. (support_pruning csp) ;; necessary to set up curr_domains - #R var #R value (for/and ([B (in-list (hash-ref ($csp-neighbors csp) var))] #:unless (hash-has-key? assignment B)) - (report B 'pruning-var) - (for/fold ([removals removals]) - ([b (in-list (hash-ref ($csp-curr_domains csp) B))] - #:unless (($csp-constraints csp) var value B b)) - (report b 'pruning-val) + (for ([b (in-list (hash-ref ($csp-curr_domains csp) B))] + #:unless (($csp-constraints csp) var value B b)) (prune csp B b removals)) - (not (empty? #R (hash-ref ($csp-curr_domains csp) B))))) + (not (empty? (hash-ref ($csp-curr_domains csp) B))))) (define current-select-variable (make-parameter first_unassigned_variable)) (define current-order-values (make-parameter unordered_domain_values)) @@ -206,7 +203,7 @@ [(? pair? solutions) solutions] [else #false]) (when (current-reset) - (set-$csp-curr_domains! csp #f)))) + (set-$csp-curr_domains! csp #f)))) (define/contract (solve csp [solver backtracking_search] [finish-proc values]) (($csp?) (procedure? procedure?) . ->* . any/c) @@ -238,23 +235,23 @@ (support_pruning csp) (check-true (hash? ($csp-curr_domains csp))) -(check-equal? (suppose csp 'wa 'red) '((wa . green) (wa . blue))) +(check-equal? (suppose csp 'wa 'red) '#&((wa . green) (wa . blue))) (check-equal? (hash-ref ($csp-curr_domains csp) 'wa) '(red)) -(check-equal? (prune csp 'v 'red empty) '((v . red))) +(check-equal? (prune csp 'v 'red (box empty)) '#&((v . red))) (check-equal? (choices csp 'v) '(green blue)) (check-equal? (choices csp 'wa) '(red)) (check-equal? (infer_assignment csp) (make-hasheq '((wa . red)))) -(check-equal? (suppose csp 'v 'blue) '((v . green))) +(check-equal? (suppose csp 'v 'blue) '#&((v . green))) (check-equal? (infer_assignment csp) (make-hasheq '((v . blue) (wa . red)))) -(restore csp '((wa . green))) +(restore csp '#&((wa . green))) (check-equal? (infer_assignment csp) (make-hasheq '((v . blue)))) -(restore csp '((v . blue))) +(restore csp '#&((v . blue))) (check-equal? (infer_assignment csp) (make-hasheq)) (check-equal? (first_unassigned_variable (hash) csp) 'wa) @@ -265,11 +262,11 @@ (make-hasheq '((nsw . green) (nt . green) (q . red) (sa . blue) (t . blue) (v . red) (wa . red)))) (check-equal? (length (solve* csp)) 18) -(check-equal? (suppose csp 'nsw 'red) '((nsw . green) (nsw . blue))) +(check-equal? (suppose csp 'nsw 'red) '#&((nsw . green) (nsw . blue))) (check-equal? (solve csp) (make-hasheq '((nsw . red) (nt . red) (q . green) (sa . blue) (t . blue) (v . green) (wa . green)))) -(check-equal? (suppose csp 'nsw 'red) '((nsw . green) (nsw . blue))) +(check-equal? (suppose csp 'nsw 'red) '#&((nsw . green) (nsw . blue))) (check-equal? (length (solve* csp)) 6) (parameterize ([current-select-variable mrv] @@ -283,8 +280,8 @@ (solve csp) (make-hasheq '((nsw . green) (nt . green) (q . red) (sa . blue) (t . blue) (v . red) (wa . red))))) -#;(parameterize ([current-inference forward_checking]) - (forward_checking csp 'sa 'blue (make-hasheq) null) +(parameterize ([current-inference forward_checking]) + (forward_checking csp 'sa 'blue (make-hasheq) (box null)) (check-equal? ($csp-curr_domains csp) (make-hasheq '((nsw . (red green)) (nt . (red green)) (q . (red green)) (sa . (red green blue)) (t . (red green blue)) (v . (red green)) (wa . (red green)))))) @@ -292,5 +289,7 @@ (parameterize ([current-inference forward_checking] [current-reset #f]) (support_pruning csp) - (solve csp)) + (check-equal? + (solve csp) + (make-hasheq '((nsw . green) (nt . green) (q . red) (sa . blue) (t . blue) (v . red) (wa . red))))) From 1fad1e6bc546e33582d1936902f904706520ff39 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Mon, 15 Oct 2018 15:45:59 -0700 Subject: [PATCH 124/246] test counts --- csp/aima.rkt | 22 ++++++++++++++++------ 1 file changed, 16 insertions(+), 6 deletions(-) diff --git a/csp/aima.rkt b/csp/aima.rkt index 5692d8e9..9c262675 100644 --- a/csp/aima.rkt +++ b/csp/aima.rkt @@ -10,6 +10,10 @@ ((listof variable?) hash? hash? procedure? . -> . $csp?) ($csp variables domains neighbors constraints null #f 0)) +(define/contract (reset-nassigns! csp) + ($csp? . -> . void?) + (set-$csp-nassigns! csp 0)) + (define/contract (assign csp var val assignment) ($csp? variable? any/c assignment? . -> . void?) ;; Add {var: val} to assignment; Discard the old value if any. @@ -260,30 +264,35 @@ (set-$csp-curr_domains! csp #f) ; reset current domains (check-equal? (solve csp) (make-hasheq '((nsw . green) (nt . green) (q . red) (sa . blue) (t . blue) (v . red) (wa . red)))) +(check-equal? (begin0 ($csp-nassigns csp) (reset-nassigns! csp)) 40) (check-equal? (length (solve* csp)) 18) (check-equal? (suppose csp 'nsw 'red) '#&((nsw . green) (nsw . blue))) (check-equal? (solve csp) (make-hasheq '((nsw . red) (nt . red) (q . green) (sa . blue) (t . blue) (v . green) (wa . green)))) +(check-equal? ($csp-nassigns csp) 368) (check-equal? (suppose csp 'nsw 'red) '#&((nsw . green) (nsw . blue))) (check-equal? (length (solve* csp)) 6) +(check-equal? (begin0 ($csp-nassigns csp) (reset-nassigns! csp)) 479) (parameterize ([current-select-variable mrv] [current-shuffle #f]) (check-equal? (solve csp) - (make-hasheq '((nsw . green) (nt . green) (q . red) (sa . blue) (t . blue) (v . red) (wa . red))))) + (make-hasheq '((nsw . green) (nt . green) (q . red) (sa . blue) (t . blue) (v . red) (wa . red)))) + (check-equal? (begin0 ($csp-nassigns csp) (reset-nassigns! csp)) 39)) (parameterize ([current-order-values lcv]) (check-equal? (solve csp) - (make-hasheq '((nsw . green) (nt . green) (q . red) (sa . blue) (t . blue) (v . red) (wa . red))))) + (make-hasheq '((nsw . green) (nt . green) (q . red) (sa . blue) (t . blue) (v . red) (wa . red)))) + (check-equal? (begin0 ($csp-nassigns csp) (reset-nassigns! csp)) 39)) (parameterize ([current-inference forward_checking]) - (forward_checking csp 'sa 'blue (make-hasheq) (box null)) - (check-equal? ($csp-curr_domains csp) - (make-hasheq '((nsw . (red green)) (nt . (red green)) (q . (red green)) (sa . (red green blue)) (t . (red green blue)) (v . (red green)) (wa . (red green)))))) + (forward_checking csp 'sa 'blue (make-hasheq) (box null)) + (check-equal? ($csp-curr_domains csp) + (make-hasheq '((nsw . (red green)) (nt . (red green)) (q . (red green)) (sa . (red green blue)) (t . (red green blue)) (v . (red green)) (wa . (red green)))))) (set-$csp-curr_domains! csp #f) (parameterize ([current-inference forward_checking] @@ -291,5 +300,6 @@ (support_pruning csp) (check-equal? (solve csp) - (make-hasheq '((nsw . green) (nt . green) (q . red) (sa . blue) (t . blue) (v . red) (wa . red))))) + (make-hasheq '((nsw . green) (nt . green) (q . red) (sa . blue) (t . blue) (v . red) (wa . red)))) + (check-equal? (begin0 ($csp-nassigns csp) (reset-nassigns! csp)) 25)) From e8abc6e7ab6e3cc73dc3f2549a2e3c58899de03c Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Mon, 15 Oct 2018 15:55:50 -0700 Subject: [PATCH 125/246] nits --- csp/aima.rkt | 42 ++++++++++++++++++++++++++---------------- 1 file changed, 26 insertions(+), 16 deletions(-) diff --git a/csp/aima.rkt b/csp/aima.rkt index 9c262675..8e515cf2 100644 --- a/csp/aima.rkt +++ b/csp/aima.rkt @@ -10,6 +10,18 @@ ((listof variable?) hash? hash? procedure? . -> . $csp?) ($csp variables domains neighbors constraints null #f 0)) +(define/contract (curr_domain csp var) + ($csp? variable? . -> . (listof any/c)) + (hash-ref ($csp-curr_domains csp) var)) + +(define/contract (neighbors csp var) + ($csp? variable? . -> . (listof variable?)) + (hash-ref ($csp-neighbors csp) var)) + +(define/contract (assigns? assignment var) + (assignment? variable? . -> . boolean?) + (hash-has-key? assignment var)) + (define/contract (reset-nassigns! csp) ($csp? . -> . void?) (set-$csp-nassigns! csp 0)) @@ -31,8 +43,8 @@ ($csp? variable? any/c assignment? . -> . number?) ;; Return the number of conflicts var=val has with other variables.""" ;; Subclasses may implement this more efficiently - (for/sum ([v (in-list (hash-ref ($csp-neighbors csp) var))] - #:when (hash-has-key? assignment v)) + (for/sum ([v (in-list (neighbors csp var))] + #:when (assignment . assigns? . v)) (if (($csp-constraints csp) var val v (hash-ref assignment v)) 0 1))) (define (display csp assignment) @@ -67,9 +79,9 @@ ;; Start accumulating inferences from assuming var=value (support_pruning csp) (begin0 - (box (for/list ([a (hash-ref ($csp-curr_domains csp) var)] - #:when (not (equal? a value))) - (cons var a))) + (box (for/list ([val (in-list (curr_domain csp var))] + #:when (not (equal? val value))) + (cons var val))) (hash-set! ($csp-curr_domains csp) var (list value)))) ;; todo: update uses of `prune` to be functional on removals @@ -92,7 +104,7 @@ (support_pruning csp) (define assignment (make-hasheq)) (for ([v (in-list ($csp-variables csp))]) - (match (hash-ref ($csp-curr_domains csp) v) + (match (curr_domain csp v) [(list one-value) (hash-set! assignment v one-value)] [else #f])) assignment) @@ -115,7 +127,7 @@ (assignment? $csp? . -> . (or/c #false variable?)) ;; The default variable order. (for/first ([var (in-list ($csp-variables csp))] - #:unless (hash-has-key? assignment var)) + #:unless (assignment . assigns? . var)) var)) (define current-shuffle (make-parameter #t)) @@ -126,7 +138,7 @@ ;; with random tiebreaker. (define (num_legal_values var) (if ($csp-curr_domains csp) - (length (hash-ref ($csp-curr_domains csp) var)) + (length (curr_domain csp var)) ;; todo: is this the same as python `count`? (for/sum ([val (in-list (hash-ref ($csp-domains csp) var))] #:when (zero? (nconflicts csp var val assignment))) @@ -134,7 +146,7 @@ (struct $mrv-rec (var num) #:transparent) (define recs (sort (for/list ([var (in-list ($csp-variables csp))] - #:unless (hash-has-key? assignment var)) + #:unless (assignment . assigns? . var)) ($mrv-rec var (num_legal_values var))) < #:key $mrv-rec-num)) (first ((if (current-shuffle) shuffle values) (map $mrv-rec-var (takef recs (λ (rec) (= ($mrv-rec-num (first recs)) @@ -162,12 +174,12 @@ ($csp? variable? any/c assignment? (box/c (listof removal?)) . -> . boolean?) ;; Prune neighbor values inconsistent with var=value. (support_pruning csp) ;; necessary to set up curr_domains - (for/and ([B (in-list (hash-ref ($csp-neighbors csp) var))] - #:unless (hash-has-key? assignment B)) - (for ([b (in-list (hash-ref ($csp-curr_domains csp) B))] + (for/and ([B (in-list (neighbors csp var))] + #:unless (assignment . assigns? . B)) + (for ([b (in-list (curr_domain csp B))] #:unless (($csp-constraints csp) var value B b)) (prune csp B b removals)) - (not (empty? (hash-ref ($csp-curr_domains csp) B))))) + (not (empty? (curr_domain csp B))))) (define current-select-variable (make-parameter first_unassigned_variable)) (define current-order-values (make-parameter unordered_domain_values)) @@ -240,8 +252,7 @@ (check-true (hash? ($csp-curr_domains csp))) (check-equal? (suppose csp 'wa 'red) '#&((wa . green) (wa . blue))) -(check-equal? - (hash-ref ($csp-curr_domains csp) 'wa) '(red)) +(check-equal? (curr_domain csp 'wa) '(red)) (check-equal? (prune csp 'v 'red (box empty)) '#&((v . red))) @@ -297,7 +308,6 @@ (set-$csp-curr_domains! csp #f) (parameterize ([current-inference forward_checking] [current-reset #f]) - (support_pruning csp) (check-equal? (solve csp) (make-hasheq '((nsw . green) (nt . green) (q . red) (sa . blue) (t . blue) (v . red) (wa . red)))) From 86baa7969915875057de419cad9621ac009aa57e Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Mon, 15 Oct 2018 17:27:33 -0700 Subject: [PATCH 126/246] tor --- csp/aima-smm.rkt | 30 ++++++++++++ csp/aima-sum.rkt | 12 +++++ csp/aima.rkt | 116 +++++++++++++++++++++++++++++++++++++---------- 3 files changed, 135 insertions(+), 23 deletions(-) create mode 100644 csp/aima-smm.rkt create mode 100644 csp/aima-sum.rkt diff --git a/csp/aima-smm.rkt b/csp/aima-smm.rkt new file mode 100644 index 00000000..949f30f7 --- /dev/null +++ b/csp/aima-smm.rkt @@ -0,0 +1,30 @@ +#lang br +(require "aima.rkt") + +; SEND +;+ MORE +;------ +; MONEY +(define (word-value . xs) + (for/sum ([(x idx) (in-indexed (reverse xs))]) + (* x (expt 10 idx)))) + +(define vs '(s e n d m o r y)) +(define ds (for/hash ([k vs]) + (values k (range 10)))) +(define ns (for*/hash ([v (in-list vs)]) + (values v (remove v vs)))) + +(define (smm-constraint A a B b) + (and + (not (eq? a b)) + (when (eq? A 's) (= 1 a)))) + +(define csp (make-csp vs ds ns smm-constraint)) +(parameterize ([current-select-variable mrv] + [current-order-values lcv] + [current-inference mac] + [current-reset #f]) + (solve csp)) +(nassigns csp) +(nchecks csp) \ No newline at end of file diff --git a/csp/aima-sum.rkt b/csp/aima-sum.rkt new file mode 100644 index 00000000..68617087 --- /dev/null +++ b/csp/aima-sum.rkt @@ -0,0 +1,12 @@ +#lang br +(require "aima.rkt") +(define vs '(a b c)) + +(define ds (for/hash ([k vs]) + (values k (range 10)))) +(define ns (for*/hash ([v (in-list vs)]) + (values v (remove v vs)))) +(define csp (make-csp vs ds ns (λ (A a B b) (not (eq? a b))))) +(solve csp) +(nassigns csp) +(nchecks csp) \ No newline at end of file diff --git a/csp/aima.rkt b/csp/aima.rkt index 8e515cf2..65983000 100644 --- a/csp/aima.rkt +++ b/csp/aima.rkt @@ -1,14 +1,15 @@ #lang debug racket -(require racket/generator sugar/debug) +(require racket/generator sugar) +(provide (all-defined-out)) -(struct $csp (variables domains neighbors constraints initial curr_domains nassigns) #:transparent #:mutable) +(struct $csp (variables domains neighbors constraints initial curr_domains nassigns nchecks) #:transparent #:mutable) (define assignment? hash?) (define variable? symbol?) (define removal? (cons/c variable? any/c)) (define/contract (make-csp variables domains neighbors constraints) ((listof variable?) hash? hash? procedure? . -> . $csp?) - ($csp variables domains neighbors constraints null #f 0)) + ($csp variables domains neighbors constraints null #f 0 0)) (define/contract (curr_domain csp var) ($csp? variable? . -> . (listof any/c)) @@ -22,9 +23,19 @@ (assignment? variable? . -> . boolean?) (hash-has-key? assignment var)) -(define/contract (reset-nassigns! csp) +(define nassigns $csp-nassigns) +(define nchecks $csp-nchecks) + +(define/contract (check-constraint csp A a B b) + ($csp? variable? any/c variable? any/c . -> . any/c) + (begin0 + (($csp-constraints csp) A a B b) + (set-$csp-nchecks! csp (add1 ($csp-nchecks csp))))) + +(define/contract (reset-counters! csp) ($csp? . -> . void?) - (set-$csp-nassigns! csp 0)) + (set-$csp-nassigns! csp 0) + (set-$csp-nchecks! csp 0)) (define/contract (assign csp var val assignment) ($csp? variable? any/c assignment? . -> . void?) @@ -45,7 +56,9 @@ ;; Subclasses may implement this more efficiently (for/sum ([v (in-list (neighbors csp var))] #:when (assignment . assigns? . v)) - (if (($csp-constraints csp) var val v (hash-ref assignment v)) 0 1))) + (if (check-constraint csp var val v (hash-ref assignment v)) + 0 + 1))) (define (display csp assignment) (displayln csp)) @@ -117,7 +130,44 @@ [(cons B b) (hash-update! ($csp-curr_domains csp) B (λ (vals) (append vals (list b))))]))) +;; ______________________________________________________________________________ +;; Constraint Propagation with AC-3 +(struct $arc (start end) #:transparent) +(define/contract (AC3 csp [queue #f][removals #f]) + (($csp?) ((or/c #f (listof any/c)) (box/c (listof removal?))) . ->* . boolean?) + (support_pruning csp) + (with-handlers ([boolean? values]) + (for/fold ([queue (or queue + (for*/list ([Xi (in-list ($csp-variables csp))] + [Xk (in-list (neighbors csp Xi))]) + ($arc Xi Xk)))] + #:result #true) + ([i (in-naturals)] + #:break (empty? queue)) + (match-define (cons ($arc Xi Xj) other-arcs) queue) + (cond + [(revise csp Xi Xj removals) + (when (empty? (curr_domain csp Xi)) + (raise #false)) + (append other-arcs + (for/list ([Xk (in-list (neighbors csp Xi))] + #:unless (eq? Xk Xj)) + ($arc Xk Xi)))] + [else other-arcs])))) + +(define/contract (revise csp Xi Xj removals) + ($csp? variable? variable? (box/c (listof removal?)) . -> . boolean?) + ;; Return true if we remove a value. + (for/fold ([revised #false]) + ([x (in-list (curr_domain csp Xi))]) + ;; If Xi=x conflicts with Xj=y for every possible y, eliminate Xi=x + (cond + [(for/and ([y (in-list (curr_domain csp Xj))]) + (not (check-constraint csp Xi x Xj y))) + (prune csp Xi x removals) + #true] + [else revised]))) ;; ______________________________________________________________________________ ;; CSP Backtracking Search @@ -139,7 +189,6 @@ (define (num_legal_values var) (if ($csp-curr_domains csp) (length (curr_domain csp var)) - ;; todo: is this the same as python `count`? (for/sum ([val (in-list (hash-ref ($csp-domains csp) var))] #:when (zero? (nconflicts csp var val assignment))) 1))) @@ -177,18 +226,25 @@ (for/and ([B (in-list (neighbors csp var))] #:unless (assignment . assigns? . B)) (for ([b (in-list (curr_domain csp B))] - #:unless (($csp-constraints csp) var value B b)) + #:unless (check-constraint csp var value B b)) (prune csp B b removals)) (not (empty? (curr_domain csp B))))) -(define current-select-variable (make-parameter first_unassigned_variable)) -(define current-order-values (make-parameter unordered_domain_values)) -(define current-inference (make-parameter no_inference)) +(define/contract (mac csp var value assignment removals) + ($csp? variable? any/c assignment? (box/c (listof removal?)) . -> . boolean?) + ;; Maintain arc consistency. + (AC3 csp (for/list ([X (in-list (neighbors csp var))]) + ($arc X var)) removals)) + + +(define current-select-variable (make-parameter #f)) +(define current-order-values (make-parameter #f)) +(define current-inference (make-parameter #f)) (define/contract (backtracking_search csp - [select_unassigned_variable (current-select-variable)] - [order_domain_values (current-order-values)] - [inference (current-inference)]) + [select_unassigned_variable (or (current-select-variable) first_unassigned_variable)] + [order_domain_values (or (current-order-values) unordered_domain_values)] + [inference (or (current-inference) no_inference)]) (($csp?) (procedure? procedure? procedure?) . ->* . generator?) (generator () (let backtrack ([assignment (make-hasheq)]) @@ -216,7 +272,7 @@ (match (for/list ([solution (in-producer (solver csp) (void))] [idx (in-range solution-limit)]) (finish-proc solution)) - [(? pair? solutions) solutions] + [(list solutions ...) solutions] [else #false]) (when (current-reset) (set-$csp-curr_domains! csp #f)))) @@ -240,7 +296,7 @@ (sa wa nt q nsw v) (t)))]) (values i ns))) -(define csp (make-csp vs ds ns (λ (A a B b) (not (equal? a b))))) +(define csp (make-csp vs ds ns (λ (A a B b) (not (eq? a b))))) (check-true ($csp? csp)) (define a (make-hasheq)) (assign csp 'key 42 a) @@ -275,7 +331,7 @@ (set-$csp-curr_domains! csp #f) ; reset current domains (check-equal? (solve csp) (make-hasheq '((nsw . green) (nt . green) (q . red) (sa . blue) (t . blue) (v . red) (wa . red)))) -(check-equal? (begin0 ($csp-nassigns csp) (reset-nassigns! csp)) 40) +(check-equal? (begin0 (list ($csp-nassigns csp) ($csp-nchecks csp)) (reset-counters! csp)) '(40 321)) (check-equal? (length (solve* csp)) 18) (check-equal? (suppose csp 'nsw 'red) '#&((nsw . green) (nsw . blue))) @@ -283,22 +339,23 @@ (make-hasheq '((nsw . red) (nt . red) (q . green) (sa . blue) (t . blue) (v . green) (wa . green)))) (check-equal? ($csp-nassigns csp) 368) +(reset-counters! csp) (check-equal? (suppose csp 'nsw 'red) '#&((nsw . green) (nsw . blue))) (check-equal? (length (solve* csp)) 6) -(check-equal? (begin0 ($csp-nassigns csp) (reset-nassigns! csp)) 479) +(check-equal? (begin0 (list ($csp-nassigns csp) ($csp-nchecks csp)) (reset-counters! csp)) '(111 1035)) (parameterize ([current-select-variable mrv] [current-shuffle #f]) (check-equal? (solve csp) (make-hasheq '((nsw . green) (nt . green) (q . red) (sa . blue) (t . blue) (v . red) (wa . red)))) - (check-equal? (begin0 ($csp-nassigns csp) (reset-nassigns! csp)) 39)) + (check-equal? (begin0 (list ($csp-nassigns csp) ($csp-nchecks csp)) (reset-counters! csp)) '(39 321))) (parameterize ([current-order-values lcv]) (check-equal? (solve csp) (make-hasheq '((nsw . green) (nt . green) (q . red) (sa . blue) (t . blue) (v . red) (wa . red)))) - (check-equal? (begin0 ($csp-nassigns csp) (reset-nassigns! csp)) 39)) + (check-equal? (begin0 (list ($csp-nassigns csp) ($csp-nchecks csp)) (reset-counters! csp)) '(39 1040))) (parameterize ([current-inference forward_checking]) (forward_checking csp 'sa 'blue (make-hasheq) (box null)) @@ -306,10 +363,23 @@ (make-hasheq '((nsw . (red green)) (nt . (red green)) (q . (red green)) (sa . (red green blue)) (t . (red green blue)) (v . (red green)) (wa . (red green)))))) (set-$csp-curr_domains! csp #f) -(parameterize ([current-inference forward_checking] - [current-reset #f]) +(parameterize ([current-inference forward_checking]) (check-equal? (solve csp) (make-hasheq '((nsw . green) (nt . green) (q . red) (sa . blue) (t . blue) (v . red) (wa . red)))) - (check-equal? (begin0 ($csp-nassigns csp) (reset-nassigns! csp)) 25)) + (check-equal? (begin0 (list ($csp-nassigns csp) ($csp-nchecks csp)) (reset-counters! csp)) '(25 123))) +(set-$csp-curr_domains! csp #f) +(parameterize ([current-inference mac] + [current-reset #f]) + (check-equal? (solve csp) + (make-hasheq '((nsw . green) (nt . green) (q . red) (sa . blue) (t . blue) (v . red) (wa . red)))) + (check-equal? (begin0 (list ($csp-nassigns csp) ($csp-nchecks csp)) (reset-counters! csp)) '(17 159))) + +(parameterize ([current-select-variable mrv] + [current-order-values lcv] + [current-inference mac] + [current-reset #f]) + (check-equal? (solve csp) + (make-hasheq '((nsw . green) (nt . green) (q . red) (sa . blue) (t . blue) (v . red) (wa . red)))) + (check-equal? (begin0 (list ($csp-nassigns csp) ($csp-nchecks csp)) (reset-counters! csp)) '(7 45))) From 22f7255700a56eb468009ebf8be76754b059efde Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Mon, 15 Oct 2018 21:30:35 -0700 Subject: [PATCH 127/246] minc --- csp/aima.rkt | 126 +++++++++++++++++++++++++++++++++++++++++---------- 1 file changed, 103 insertions(+), 23 deletions(-) diff --git a/csp/aima.rkt b/csp/aima.rkt index 65983000..11826390 100644 --- a/csp/aima.rkt +++ b/csp/aima.rkt @@ -2,14 +2,14 @@ (require racket/generator sugar) (provide (all-defined-out)) -(struct $csp (variables domains neighbors constraints initial curr_domains nassigns nchecks) #:transparent #:mutable) +(struct $csp (variables domains neighbors constraints initial curr_domains nassigns nchecks current) #:transparent #:mutable) (define assignment? hash?) (define variable? symbol?) (define removal? (cons/c variable? any/c)) (define/contract (make-csp variables domains neighbors constraints) ((listof variable?) hash? hash? procedure? . -> . $csp?) - ($csp variables domains neighbors constraints null #f 0 0)) + ($csp variables domains neighbors constraints null #f 0 0 #f)) (define/contract (curr_domain csp var) ($csp? variable? . -> . (listof any/c)) @@ -50,6 +50,10 @@ ;; just call assign for that. (hash-remove! assignment var)) +(define/contract (all-variables-assigned? csp assignment) + ($csp? assignment? . -> . boolean?) + (= (length (hash-keys assignment)) (length ($csp-variables csp)))) + (define/contract (nconflicts csp var val assignment) ($csp? variable? any/c assignment? . -> . number?) ;; Return the number of conflicts var=val has with other variables.""" @@ -63,14 +67,43 @@ (define (display csp assignment) (displayln csp)) -(define/contract (all-variables-assigned? csp assignment) - ($csp? assignment? . -> . boolean?) - (= (length (hash-keys assignment)) (length ($csp-variables csp)))) - +;; These methods are for the tree and graph-search interface: + +(struct $action (var val) #:transparent #:mutable) +(define/contract (state->assignment state) + ((listof $action?) . -> . assignment?) + (for/hasheq ([action (in-list state)]) + (match action + [($action var val) (values var val)]))) + +;; todo: test that this works +(define/contract (actions csp state) + ($csp? (listof $action?) . -> . any/c) + ;; Return a list of applicable actions: nonconflicting + ;; assignments to an unassigned variable. + (cond + [(all-variables-assigned? csp state) empty] + [else + (define assignment (state->assignment state)) + (define var (for/first ([v (in-list ($csp-variables csp))] + #:unless (assignment . assigns? . v)) + v)) + (for/list ([val (in-list (hash-ref ($csp-domains csp) var))] + #:when (zero? (nconflicts csp var val assignment))) + ($action var val))])) + +;; todo: test that this works +(define/contract (result csp state action) + ($csp? (listof $action?) $action? . -> . assignment?) + ;; Perform an action and return the new state. + (match-define ($action var val) action) + (append state (list action))) + +;; todo: test that this works (define/contract (goal_test csp state) - ($csp? assignment? . -> . boolean?) + ($csp? (or/c assignment? (listof $action?)) . -> . boolean?) ;; The goal is to assign all variables, with all constraints satisfied. - (define assignment state) + (define assignment (if (assignment? state) state (state->assignment state))) (and (all-variables-assigned? csp assignment) (for/and ([variable ($csp-variables csp)]) (zero? (nconflicts csp variable (hash-ref assignment variable) assignment))))) @@ -97,14 +130,13 @@ (cons var val))) (hash-set! ($csp-curr_domains csp) var (list value)))) -;; todo: update uses of `prune` to be functional on removals (define/contract (prune csp var value removals) ($csp? variable? any/c (or/c #f (box/c (listof removal?))) . -> . (box/c (listof removal?))) ;; Rule out var=value (hash-update! ($csp-curr_domains csp) var (λ (vals) (remove value vals))) - (and removals - (set-box! removals (append (unbox removals) (list (cons var value)))) - removals)) + (when removals + (set-box! removals (append (unbox removals) (list (cons var value))))) + removals) (define/contract (choices csp var) ($csp? variable? . -> . (listof any/c)) @@ -130,6 +162,14 @@ [(cons B b) (hash-update! ($csp-curr_domains csp) B (λ (vals) (append vals (list b))))]))) +;; This is for min_conflicts search +(define/contract (conflicted_vars csp current) + ($csp? hash? . -> . (listof variable?)) + ;; Return a list of variables in current assignment that are in conflict + (for/list ([var (in-list ($csp-variables csp))] + #:when (positive? (nconflicts csp var (hash-ref current var) current))) + var)) + ;; ______________________________________________________________________________ ;; Constraint Propagation with AC-3 @@ -182,6 +222,12 @@ (define current-shuffle (make-parameter #t)) +(define/contract (argmin_random_tie proc xs) + (procedure? (listof any/c) . -> . any/c) + (define ordered-xs (sort xs < #:key proc)) + (first ((if (current-shuffle) shuffle values) + (takef ordered-xs (λ (x) (= (proc (car ordered-xs)) (proc x))))))) + (define/contract (mrv assignment csp) (assignment? $csp? . -> . any/c) ;; Minimum-remaining-values heuristic. @@ -193,13 +239,11 @@ #:when (zero? (nconflicts csp var val assignment))) 1))) (struct $mrv-rec (var num) #:transparent) - (define recs (sort - (for/list ([var (in-list ($csp-variables csp))] - #:unless (assignment . assigns? . var)) - ($mrv-rec var (num_legal_values var))) - < #:key $mrv-rec-num)) - (first ((if (current-shuffle) shuffle values) (map $mrv-rec-var (takef recs (λ (rec) (= ($mrv-rec-num (first recs)) - ($mrv-rec-num rec)))))))) + (argmin_random_tie + (λ (var) (num_legal_values var)) + (for/list ([var (in-list ($csp-variables csp))] + #:unless (assignment . assigns? . var)) + var))) ;; Value ordering @@ -241,10 +285,11 @@ (define current-order-values (make-parameter #f)) (define current-inference (make-parameter #f)) -(define/contract (backtracking_search csp - [select_unassigned_variable (or (current-select-variable) first_unassigned_variable)] - [order_domain_values (or (current-order-values) unordered_domain_values)] - [inference (or (current-inference) no_inference)]) +(define/contract (backtracking_search + csp + [select_unassigned_variable (or (current-select-variable) first_unassigned_variable)] + [order_domain_values (or (current-order-values) unordered_domain_values)] + [inference (or (current-inference) no_inference)]) (($csp?) (procedure? procedure? procedure?) . ->* . generator?) (generator () (let backtrack ([assignment (make-hasheq)]) @@ -262,6 +307,35 @@ (backtrack assignment)) (restore csp removals)) (unassign csp var assignment)])))) +;; ______________________________________________________________________________ +;; Min-conflicts hillclimbing search for CSPs + +(define (min_conflicts csp [max_steps (expt 10 5)]) + (($csp?) (integer?) . ->* . (or/c #f assignment?)) + ;; Solve a CSP by stochastic hillclimbing on the number of conflicts. + ;; Generate a complete assignment for all variables (probably with conflicts) + (define current (make-hasheq)) + (set-$csp-current! csp current) + (for ([var (in-list ($csp-variables csp))]) + (define val (min_conflicts_value csp var current)) + (assign csp var val current)) + ;; Now repeatedly choose a random conflicted variable and change it + (with-handlers ([hash? values]) + (for ([i (in-range max_steps)]) + (define conflicted (conflicted_vars csp current)) + (unless (pair? conflicted) + (raise current)) + (define var (first ((if (current-shuffle) shuffle values) conflicted))) + (define val (min_conflicts_value csp var current)) + (assign csp var val current)) + #false)) + +(define/contract (min_conflicts_value csp var current) + ($csp? variable? hash? . -> . any/c) + ;; Return the value that will give var the least number of conflicts. + ;; If there is a tie, choose at random. + (argmin_random_tie (λ (val) (nconflicts csp var val current)) (hash-ref ($csp-domains csp) var))) + (define current-reset (make-parameter #t)) @@ -383,3 +457,9 @@ (check-equal? (solve csp) (make-hasheq '((nsw . green) (nt . green) (q . red) (sa . blue) (t . blue) (v . red) (wa . red)))) (check-equal? (begin0 (list ($csp-nassigns csp) ($csp-nchecks csp)) (reset-counters! csp)) '(7 45))) + +(set-$csp-curr_domains! csp #f) +(parameterize ([current-shuffle #f]) + (check-equal? + (min_conflicts csp) + (make-hasheq '((nsw . red) (nt . red) (q . green) (sa . blue) (t . red) (v . green) (wa . green))))) From 586378b7e019ba1eef0eb9ffca8d65f38679a96a Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Mon, 15 Oct 2018 21:44:25 -0700 Subject: [PATCH 128/246] mincer --- csp/aima.rkt | 55 ++++++++++++++++++++++++++-------------------------- 1 file changed, 28 insertions(+), 27 deletions(-) diff --git a/csp/aima.rkt b/csp/aima.rkt index 11826390..20caa24c 100644 --- a/csp/aima.rkt +++ b/csp/aima.rkt @@ -311,24 +311,23 @@ ;; Min-conflicts hillclimbing search for CSPs (define (min_conflicts csp [max_steps (expt 10 5)]) - (($csp?) (integer?) . ->* . (or/c #f assignment?)) + (($csp?) (integer?) . ->* . generator?) ;; Solve a CSP by stochastic hillclimbing on the number of conflicts. ;; Generate a complete assignment for all variables (probably with conflicts) - (define current (make-hasheq)) - (set-$csp-current! csp current) - (for ([var (in-list ($csp-variables csp))]) - (define val (min_conflicts_value csp var current)) - (assign csp var val current)) - ;; Now repeatedly choose a random conflicted variable and change it - (with-handlers ([hash? values]) - (for ([i (in-range max_steps)]) - (define conflicted (conflicted_vars csp current)) - (unless (pair? conflicted) - (raise current)) - (define var (first ((if (current-shuffle) shuffle values) conflicted))) - (define val (min_conflicts_value csp var current)) - (assign csp var val current)) - #false)) + (generator () + (define current (make-hasheq)) + (set-$csp-current! csp current) + (for ([var (in-list ($csp-variables csp))]) + (define val (min_conflicts_value csp var current)) + (assign csp var val current)) + ;; Now repeatedly choose a random conflicted variable and change it + (for ([i (in-range max_steps)]) + (define conflicted (conflicted_vars csp current)) + (when (empty? conflicted) + (yield current)) + (define var (first ((if (current-shuffle) shuffle values) conflicted))) + (define val (min_conflicts_value csp var current)) + (assign csp var val current)))) (define/contract (min_conflicts_value csp var current) ($csp? variable? hash? . -> . any/c) @@ -338,22 +337,22 @@ (define current-reset (make-parameter #t)) +(define current-solver (make-parameter backtracking_search)) -(define/contract (solve* csp [solver backtracking_search] [finish-proc values] - #:count [solution-limit +inf.0]) - (($csp?) (procedure? procedure? #:count integer?) . ->* . (or/c #f (non-empty-listof any/c))) +(define/contract (solve* csp [solution-limit +inf.0]) + (($csp?) (integer?) . ->* . (or/c #f (non-empty-listof any/c))) (begin0 - (match (for/list ([solution (in-producer (solver csp) (void))] + (match (for/list ([solution (in-producer ((current-solver) csp) (void))] [idx (in-range solution-limit)]) - (finish-proc solution)) + solution) [(list solutions ...) solutions] [else #false]) (when (current-reset) (set-$csp-curr_domains! csp #f)))) -(define/contract (solve csp [solver backtracking_search] [finish-proc values]) - (($csp?) (procedure? procedure?) . ->* . any/c) - (match (solve* csp solver finish-proc #:count 1) +(define/contract (solve csp) + ($csp? . -> . any/c) + (match (solve* csp 1) [(list solution) solution] [else #false])) @@ -459,7 +458,9 @@ (check-equal? (begin0 (list ($csp-nassigns csp) ($csp-nchecks csp)) (reset-counters! csp)) '(7 45))) (set-$csp-curr_domains! csp #f) -(parameterize ([current-shuffle #f]) +(parameterize ([current-shuffle #f] + [current-solver min_conflicts]) (check-equal? - (min_conflicts csp) - (make-hasheq '((nsw . red) (nt . red) (q . green) (sa . blue) (t . red) (v . green) (wa . green))))) + (solve csp) + (make-hasheq '((nsw . red) (nt . red) (q . green) (sa . blue) (t . red) (v . green) (wa . green)))) + (check-equal? (begin0 (list ($csp-nassigns csp) ($csp-nchecks csp)) (reset-counters! csp)) '(9 220))) From 6f983f5709c97c8f9712d8f27052881e6ab9bdac Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Mon, 15 Oct 2018 22:15:21 -0700 Subject: [PATCH 129/246] nits --- csp/aima.rkt | 34 +++++++++++++++++++--------------- 1 file changed, 19 insertions(+), 15 deletions(-) diff --git a/csp/aima.rkt b/csp/aima.rkt index 20caa24c..e26dca69 100644 --- a/csp/aima.rkt +++ b/csp/aima.rkt @@ -11,6 +11,10 @@ ((listof variable?) hash? hash? procedure? . -> . $csp?) ($csp variables domains neighbors constraints null #f 0 0 #f)) +(define/contract (domain csp var) + ($csp? variable? . -> . (listof any/c)) + (hash-ref ($csp-domains csp) var)) + (define/contract (curr_domain csp var) ($csp? variable? . -> . (listof any/c)) (hash-ref ($csp-curr_domains csp) var)) @@ -85,10 +89,10 @@ [(all-variables-assigned? csp state) empty] [else (define assignment (state->assignment state)) - (define var (for/first ([v (in-list ($csp-variables csp))] - #:unless (assignment . assigns? . v)) - v)) - (for/list ([val (in-list (hash-ref ($csp-domains csp) var))] + (define var (for/first ([var (in-list ($csp-variables csp))] + #:unless (assignment . assigns? . var)) + var)) + (for/list ([val (in-list (domain csp var))] #:when (zero? (nconflicts csp var val assignment))) ($action var val))])) @@ -201,10 +205,11 @@ ;; Return true if we remove a value. (for/fold ([revised #false]) ([x (in-list (curr_domain csp Xi))]) - ;; If Xi=x conflicts with Xj=y for every possible y, eliminate Xi=x + ;; If Xi=x is consistent with Xj=y for any y, keep Xi=x, otherwise prune (cond - [(for/and ([y (in-list (curr_domain csp Xj))]) - (not (check-constraint csp Xi x Xj y))) + [(not + (for/or ([y (in-list (curr_domain csp Xj))]) + (check-constraint csp Xi x Xj y))) (prune csp Xi x removals) #true] [else revised]))) @@ -235,7 +240,7 @@ (define (num_legal_values var) (if ($csp-curr_domains csp) (length (curr_domain csp var)) - (for/sum ([val (in-list (hash-ref ($csp-domains csp) var))] + (for/sum ([val (in-list (domain csp var))] #:when (zero? (nconflicts csp var val assignment))) 1))) (struct $mrv-rec (var num) #:transparent) @@ -277,10 +282,9 @@ (define/contract (mac csp var value assignment removals) ($csp? variable? any/c assignment? (box/c (listof removal?)) . -> . boolean?) ;; Maintain arc consistency. - (AC3 csp (for/list ([X (in-list (neighbors csp var))]) - ($arc X var)) removals)) + (AC3 csp (for/list ([neighbor (in-list (neighbors csp var))]) + ($arc neighbor var)) removals)) - (define current-select-variable (make-parameter #f)) (define current-order-values (make-parameter #f)) (define current-inference (make-parameter #f)) @@ -333,16 +337,16 @@ ($csp? variable? hash? . -> . any/c) ;; Return the value that will give var the least number of conflicts. ;; If there is a tie, choose at random. - (argmin_random_tie (λ (val) (nconflicts csp var val current)) (hash-ref ($csp-domains csp) var))) - + (argmin_random_tie (λ (val) (nconflicts csp var val current)) (domain csp var))) (define current-reset (make-parameter #t)) -(define current-solver (make-parameter backtracking_search)) +(define current-solver (make-parameter #f)) (define/contract (solve* csp [solution-limit +inf.0]) (($csp?) (integer?) . ->* . (or/c #f (non-empty-listof any/c))) + (define solver (or (current-solver) backtracking_search)) (begin0 - (match (for/list ([solution (in-producer ((current-solver) csp) (void))] + (match (for/list ([solution (in-producer (solver csp) (void))] [idx (in-range solution-limit)]) solution) [(list solutions ...) solutions] From 945a583f24efd03fb416fa4eb9781a19b7c500d0 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Tue, 16 Oct 2018 12:44:19 -0700 Subject: [PATCH 130/246] multi --- csp/aima.rkt | 21 ++++++++++++++++++--- 1 file changed, 18 insertions(+), 3 deletions(-) diff --git a/csp/aima.rkt b/csp/aima.rkt index e26dca69..cca13ca7 100644 --- a/csp/aima.rkt +++ b/csp/aima.rkt @@ -3,12 +3,15 @@ (provide (all-defined-out)) (struct $csp (variables domains neighbors constraints initial curr_domains nassigns nchecks current) #:transparent #:mutable) +;; `current` = current assignment (define assignment? hash?) (define variable? symbol?) (define removal? (cons/c variable? any/c)) -(define/contract (make-csp variables domains neighbors constraints) - ((listof variable?) hash? hash? procedure? . -> . $csp?) +(struct $constraint (names proc) #:transparent) + +(define/contract (make-csp variables domains neighbors constraints newconstraints) + ((listof variable?) hash? hash? procedure? (listof $constraint?) . -> . $csp?) ($csp variables domains neighbors constraints null #f 0 0 #f)) (define/contract (domain csp var) @@ -373,7 +376,19 @@ (sa wa nt q nsw v) (t)))]) (values i ns))) -(define csp (make-csp vs ds ns (λ (A a B b) (not (eq? a b))))) +(define (neq? a b) (not (eq? a b))) +(define c (λ (A a B b) (neq? a b))) +(define ncs (list + ($constraint '(wa nt) neq?) + ($constraint '(wa sa) neq?) + ($constraint '(nt sa) neq?) + ($constraint '(nt q) neq?) + ($constraint '(q sa) neq?) + ($constraint '(q nsw) neq?) + ($constraint '(nsw sa) neq?) + ($constraint '(nsw v) neq?) + ($constraint '(v sa) neq?))) +(define csp (make-csp vs ds ns c ncs)) (check-true ($csp? csp)) (define a (make-hasheq)) (assign csp 'key 42 a) From 1353cab9ceb6e661a4bb8126767d460afac3fc4e Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Tue, 16 Oct 2018 13:01:16 -0700 Subject: [PATCH 131/246] neighbors --- csp/aima.rkt | 41 +++++++++++++++++++++++------------------ 1 file changed, 23 insertions(+), 18 deletions(-) diff --git a/csp/aima.rkt b/csp/aima.rkt index cca13ca7..51ef805d 100644 --- a/csp/aima.rkt +++ b/csp/aima.rkt @@ -1,5 +1,5 @@ #lang debug racket -(require racket/generator sugar) +(require racket/generator sugar graph) (provide (all-defined-out)) (struct $csp (variables domains neighbors constraints initial curr_domains nassigns nchecks current) #:transparent #:mutable) @@ -10,9 +10,19 @@ (struct $constraint (names proc) #:transparent) -(define/contract (make-csp variables domains neighbors constraints newconstraints) - ((listof variable?) hash? hash? procedure? (listof $constraint?) . -> . $csp?) - ($csp variables domains neighbors constraints null #f 0 0 #f)) +(define (constraint-graph variables constraints) + (for*/fold ([g (unweighted-graph/undirected variables)]) + ([constraint (in-list constraints)] + [edge (in-combinations ($constraint-names constraint) 2)]) + (apply add-edge! g edge) + g)) + +(define/contract (make-csp variables domains constraints) + ((listof variable?) hash? (listof $constraint?) . -> . $csp?) + (define g (constraint-graph variables constraints)) + (define ns (for/hasheq ([v (in-list variables)]) + (values v (get-neighbors g v)))) + ($csp variables domains ns constraints null #f 0 0 #f)) (define/contract (domain csp var) ($csp? variable? . -> . (listof any/c)) @@ -35,8 +45,13 @@ (define/contract (check-constraint csp A a B b) ($csp? variable? any/c variable? any/c . -> . any/c) + (define AB-constraints (for/list ([constraint (in-list ($csp-constraints csp))] + #:when (for/and ([name (in-list (list A B))]) + (memq name ($constraint-names constraint)))) + constraint)) (begin0 - (($csp-constraints csp) A a B b) + (for/and ([constraint (in-list AB-constraints)]) + (($constraint-proc constraint) a b)) (set-$csp-nchecks! csp (add1 ($csp-nchecks csp))))) (define/contract (reset-counters! csp) @@ -367,17 +382,7 @@ (define vs '(wa nsw t q nt v sa)) (define ds (for/hash ([k vs]) (values k '(red green blue)))) -(define ns (for*/hash ([(i ns) (in-dict - '((wa nt sa) - (nt wa sa q) - (q nt sa nsw) - (nsw q sa v) - (v sa nsw) - (sa wa nt q nsw v) - (t)))]) - (values i ns))) (define (neq? a b) (not (eq? a b))) -(define c (λ (A a B b) (neq? a b))) (define ncs (list ($constraint '(wa nt) neq?) ($constraint '(wa sa) neq?) @@ -388,7 +393,7 @@ ($constraint '(nsw sa) neq?) ($constraint '(nsw v) neq?) ($constraint '(v sa) neq?))) -(define csp (make-csp vs ds ns c ncs)) +(define csp (make-csp vs ds ncs)) (check-true ($csp? csp)) (define a (make-hasheq)) (assign csp 'key 42 a) @@ -459,14 +464,14 @@ (check-equal? (solve csp) (make-hasheq '((nsw . green) (nt . green) (q . red) (sa . blue) (t . blue) (v . red) (wa . red)))) - (check-equal? (begin0 (list ($csp-nassigns csp) ($csp-nchecks csp)) (reset-counters! csp)) '(25 123))) + (check-equal? (begin0 (list ($csp-nassigns csp) ($csp-nchecks csp)) (reset-counters! csp)) '(25 121))) (set-$csp-curr_domains! csp #f) (parameterize ([current-inference mac] [current-reset #f]) (check-equal? (solve csp) (make-hasheq '((nsw . green) (nt . green) (q . red) (sa . blue) (t . blue) (v . red) (wa . red)))) - (check-equal? (begin0 (list ($csp-nassigns csp) ($csp-nchecks csp)) (reset-counters! csp)) '(17 159))) + (check-equal? (begin0 (list ($csp-nassigns csp) ($csp-nchecks csp)) (reset-counters! csp)) '(17 175))) (parameterize ([current-select-variable mrv] [current-order-values lcv] From 36e3fc408e46d57960d09049ee032b658af619a4 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Tue, 16 Oct 2018 13:12:37 -0700 Subject: [PATCH 132/246] and --- csp/aima.rkt | 17 +++++++++++------ 1 file changed, 11 insertions(+), 6 deletions(-) diff --git a/csp/aima.rkt b/csp/aima.rkt index 51ef805d..64547c5f 100644 --- a/csp/aima.rkt +++ b/csp/aima.rkt @@ -9,6 +9,7 @@ (define removal? (cons/c variable? any/c)) (struct $constraint (names proc) #:transparent) +(struct $vd (name vals) #:transparent) (define (constraint-graph variables constraints) (for*/fold ([g (unweighted-graph/undirected variables)]) @@ -17,11 +18,15 @@ (apply add-edge! g edge) g)) -(define/contract (make-csp variables domains constraints) - ((listof variable?) hash? (listof $constraint?) . -> . $csp?) +(define/contract (make-csp variables vds constraints) + ((listof variable?) (listof $vd?) (listof $constraint?) . -> . $csp?) (define g (constraint-graph variables constraints)) (define ns (for/hasheq ([v (in-list variables)]) (values v (get-neighbors g v)))) + (define domains (for/hasheq ([vd (in-list vds)]) + (match vd + [($vd name vals) (values name vals)]))) + ($csp variables domains ns constraints null #f 0 0 #f)) (define/contract (domain csp var) @@ -380,10 +385,10 @@ (require rackunit) (define vs '(wa nsw t q nt v sa)) -(define ds (for/hash ([k vs]) - (values k '(red green blue)))) +(define ds (for/list ([k vs]) + ($vd k '(red green blue)))) (define (neq? a b) (not (eq? a b))) -(define ncs (list +(define cs (list ($constraint '(wa nt) neq?) ($constraint '(wa sa) neq?) ($constraint '(nt sa) neq?) @@ -393,7 +398,7 @@ ($constraint '(nsw sa) neq?) ($constraint '(nsw v) neq?) ($constraint '(v sa) neq?))) -(define csp (make-csp vs ds ncs)) +(define csp (make-csp vs ds cs)) (check-true ($csp? csp)) (define a (make-hasheq)) (assign csp 'key 42 a) From 8400d1caccf2e8598e255d3aaeb6082bcb0a305a Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Tue, 16 Oct 2018 13:25:41 -0700 Subject: [PATCH 133/246] simpler --- csp/aima.rkt | 41 +++++++++++++++++++++-------------------- 1 file changed, 21 insertions(+), 20 deletions(-) diff --git a/csp/aima.rkt b/csp/aima.rkt index 64547c5f..cace3e26 100644 --- a/csp/aima.rkt +++ b/csp/aima.rkt @@ -2,7 +2,7 @@ (require racket/generator sugar graph) (provide (all-defined-out)) -(struct $csp (variables domains neighbors constraints initial curr_domains nassigns nchecks current) #:transparent #:mutable) +(struct $csp (variables domains neighbors constraints initial curr_domains nassigns nchecks current graph) #:transparent #:mutable) ;; `current` = current assignment (define assignment? hash?) (define variable? symbol?) @@ -18,16 +18,16 @@ (apply add-edge! g edge) g)) -(define/contract (make-csp variables vds constraints) - ((listof variable?) (listof $vd?) (listof $constraint?) . -> . $csp?) - (define g (constraint-graph variables constraints)) - (define ns (for/hasheq ([v (in-list variables)]) - (values v (get-neighbors g v)))) +(define/contract (make-csp vds constraints) + ((listof $vd?) (listof $constraint?) . -> . $csp?) + (define variables (map $vd-name vds)) (define domains (for/hasheq ([vd (in-list vds)]) (match vd [($vd name vals) (values name vals)]))) - - ($csp variables domains ns constraints null #f 0 0 #f)) + (define g (constraint-graph variables constraints)) + (define neighbors (for/hasheq ([v (in-list variables)]) + (values v (get-neighbors g v)))) + ($csp variables domains neighbors constraints null #f 0 0 #f g)) (define/contract (domain csp var) ($csp? variable? . -> . (listof any/c)) @@ -384,21 +384,22 @@ [else #false])) (require rackunit) + (define vs '(wa nsw t q nt v sa)) -(define ds (for/list ([k vs]) - ($vd k '(red green blue)))) +(define vds (for/list ([k vs]) + ($vd k '(red green blue)))) (define (neq? a b) (not (eq? a b))) (define cs (list - ($constraint '(wa nt) neq?) - ($constraint '(wa sa) neq?) - ($constraint '(nt sa) neq?) - ($constraint '(nt q) neq?) - ($constraint '(q sa) neq?) - ($constraint '(q nsw) neq?) - ($constraint '(nsw sa) neq?) - ($constraint '(nsw v) neq?) - ($constraint '(v sa) neq?))) -(define csp (make-csp vs ds cs)) + ($constraint '(wa nt) neq?) + ($constraint '(wa sa) neq?) + ($constraint '(nt sa) neq?) + ($constraint '(nt q) neq?) + ($constraint '(q sa) neq?) + ($constraint '(q nsw) neq?) + ($constraint '(nsw sa) neq?) + ($constraint '(nsw v) neq?) + ($constraint '(v sa) neq?))) +(define csp (make-csp vds cs)) (check-true ($csp? csp)) (define a (make-hasheq)) (assign csp 'key 42 a) From 162302d50ac611f0b709e310faa72c0e40f6de0b Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Tue, 16 Oct 2018 13:36:28 -0700 Subject: [PATCH 134/246] work variadic --- csp/aima.rkt | 23 ++++++++++++++++------- 1 file changed, 16 insertions(+), 7 deletions(-) diff --git a/csp/aima.rkt b/csp/aima.rkt index cace3e26..89668ee0 100644 --- a/csp/aima.rkt +++ b/csp/aima.rkt @@ -48,15 +48,19 @@ (define nassigns $csp-nassigns) (define nchecks $csp-nchecks) -(define/contract (check-constraint csp A a B b) +(define/contract (check-constraint csp . varvals) ($csp? variable? any/c variable? any/c . -> . any/c) - (define AB-constraints (for/list ([constraint (in-list ($csp-constraints csp))] - #:when (for/and ([name (in-list (list A B))]) - (memq name ($constraint-names constraint)))) - constraint)) + (define varval-hash (apply hasheq varvals)) + (define relevant-constraints + (for/list ([constraint (in-list ($csp-constraints csp))] + #:when (for/and ([name (in-list (hash-keys varval-hash))]) + (memq name ($constraint-names constraint)))) + constraint)) (begin0 - (for/and ([constraint (in-list AB-constraints)]) - (($constraint-proc constraint) a b)) + (for/and ([constraint (in-list relevant-constraints)]) + (define vals (for/list ([cname (in-list ($constraint-names constraint))]) + (hash-ref varval-hash cname))) + (apply ($constraint-proc constraint) vals)) (set-$csp-nchecks! csp (add1 ($csp-nchecks csp))))) (define/contract (reset-counters! csp) @@ -494,3 +498,8 @@ (solve csp) (make-hasheq '((nsw . red) (nt . red) (q . green) (sa . blue) (t . red) (v . green) (wa . green)))) (check-equal? (begin0 (list ($csp-nassigns csp) ($csp-nchecks csp)) (reset-counters! csp)) '(9 220))) + +(solve (make-csp (list ($vd 'a '(1 2 3)) + ($vd 'b '(4 5 6)) + ($vd 'c '(7 8 9))) + (list ($constraint '(a b c) (λ (a b c) (= (+ a b c) 18)))))) \ No newline at end of file From e0e9779ad28f2828714cf9570157179ba22b07b5 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Tue, 16 Oct 2018 13:45:16 -0700 Subject: [PATCH 135/246] touch --- csp/aima.rkt | 227 ++++++++++++++++++++++++++------------------------- 1 file changed, 114 insertions(+), 113 deletions(-) diff --git a/csp/aima.rkt b/csp/aima.rkt index 89668ee0..c1ec2146 100644 --- a/csp/aima.rkt +++ b/csp/aima.rkt @@ -50,14 +50,14 @@ (define/contract (check-constraint csp . varvals) ($csp? variable? any/c variable? any/c . -> . any/c) - (define varval-hash (apply hasheq varvals)) + (define varval-hash (apply hasheq #R varvals)) (define relevant-constraints (for/list ([constraint (in-list ($csp-constraints csp))] - #:when (for/and ([name (in-list (hash-keys varval-hash))]) - (memq name ($constraint-names constraint)))) + #:when (for/and ([cname (in-list ($constraint-names constraint))]) + (memq cname (hash-keys varval-hash)))) constraint)) (begin0 - (for/and ([constraint (in-list relevant-constraints)]) + (for/and ([constraint (in-list #R relevant-constraints)]) (define vals (for/list ([cname (in-list ($constraint-names constraint))]) (hash-ref varval-hash cname))) (apply ($constraint-proc constraint) vals)) @@ -389,115 +389,116 @@ (require rackunit) -(define vs '(wa nsw t q nt v sa)) -(define vds (for/list ([k vs]) - ($vd k '(red green blue)))) -(define (neq? a b) (not (eq? a b))) -(define cs (list - ($constraint '(wa nt) neq?) - ($constraint '(wa sa) neq?) - ($constraint '(nt sa) neq?) - ($constraint '(nt q) neq?) - ($constraint '(q sa) neq?) - ($constraint '(q nsw) neq?) - ($constraint '(nsw sa) neq?) - ($constraint '(nsw v) neq?) - ($constraint '(v sa) neq?))) -(define csp (make-csp vds cs)) -(check-true ($csp? csp)) -(define a (make-hasheq)) -(assign csp 'key 42 a) -(check-equal? (hash-ref a 'key) 42) -(unassign csp 'key a) -(check-exn exn:fail? (λ () (hash-ref a 'key))) -(check-equal? 0 (nconflicts csp 'wa 'red (hasheq 'wa 42))) -(support_pruning csp) -(check-true (hash? ($csp-curr_domains csp))) - -(check-equal? (suppose csp 'wa 'red) '#&((wa . green) (wa . blue))) -(check-equal? (curr_domain csp 'wa) '(red)) - -(check-equal? (prune csp 'v 'red (box empty)) '#&((v . red))) - -(check-equal? (choices csp 'v) '(green blue)) -(check-equal? (choices csp 'wa) '(red)) -(check-equal? (infer_assignment csp) - (make-hasheq '((wa . red)))) -(check-equal? (suppose csp 'v 'blue) '#&((v . green))) -(check-equal? (infer_assignment csp) - (make-hasheq '((v . blue) (wa . red)))) -(restore csp '#&((wa . green))) -(check-equal? (infer_assignment csp) - (make-hasheq '((v . blue)))) -(restore csp '#&((v . blue))) -(check-equal? (infer_assignment csp) (make-hasheq)) - -(check-equal? (first_unassigned_variable (hash) csp) 'wa) -(check-equal? (unordered_domain_values 'wa (hash) csp) '(red green)) - -(set-$csp-curr_domains! csp #f) ; reset current domains -(check-equal? (solve csp) - (make-hasheq '((nsw . green) (nt . green) (q . red) (sa . blue) (t . blue) (v . red) (wa . red)))) -(check-equal? (begin0 (list ($csp-nassigns csp) ($csp-nchecks csp)) (reset-counters! csp)) '(40 321)) -(check-equal? (length (solve* csp)) 18) - -(check-equal? (suppose csp 'nsw 'red) '#&((nsw . green) (nsw . blue))) -(check-equal? (solve csp) - (make-hasheq '((nsw . red) (nt . red) (q . green) (sa . blue) (t . blue) (v . green) (wa . green)))) -(check-equal? ($csp-nassigns csp) 368) - -(reset-counters! csp) -(check-equal? (suppose csp 'nsw 'red) '#&((nsw . green) (nsw . blue))) -(check-equal? (length (solve* csp)) 6) -(check-equal? (begin0 (list ($csp-nassigns csp) ($csp-nchecks csp)) (reset-counters! csp)) '(111 1035)) - -(parameterize ([current-select-variable mrv] - [current-shuffle #f]) - (check-equal? - (solve csp) - (make-hasheq '((nsw . green) (nt . green) (q . red) (sa . blue) (t . blue) (v . red) (wa . red)))) - (check-equal? (begin0 (list ($csp-nassigns csp) ($csp-nchecks csp)) (reset-counters! csp)) '(39 321))) - -(parameterize ([current-order-values lcv]) - (check-equal? - (solve csp) - (make-hasheq '((nsw . green) (nt . green) (q . red) (sa . blue) (t . blue) (v . red) (wa . red)))) - (check-equal? (begin0 (list ($csp-nassigns csp) ($csp-nchecks csp)) (reset-counters! csp)) '(39 1040))) - -(parameterize ([current-inference forward_checking]) - (forward_checking csp 'sa 'blue (make-hasheq) (box null)) - (check-equal? ($csp-curr_domains csp) - (make-hasheq '((nsw . (red green)) (nt . (red green)) (q . (red green)) (sa . (red green blue)) (t . (red green blue)) (v . (red green)) (wa . (red green)))))) - -(set-$csp-curr_domains! csp #f) -(parameterize ([current-inference forward_checking]) - (check-equal? - (solve csp) - (make-hasheq '((nsw . green) (nt . green) (q . red) (sa . blue) (t . blue) (v . red) (wa . red)))) - (check-equal? (begin0 (list ($csp-nassigns csp) ($csp-nchecks csp)) (reset-counters! csp)) '(25 121))) - -(set-$csp-curr_domains! csp #f) -(parameterize ([current-inference mac] - [current-reset #f]) - (check-equal? (solve csp) - (make-hasheq '((nsw . green) (nt . green) (q . red) (sa . blue) (t . blue) (v . red) (wa . red)))) - (check-equal? (begin0 (list ($csp-nassigns csp) ($csp-nchecks csp)) (reset-counters! csp)) '(17 175))) - -(parameterize ([current-select-variable mrv] - [current-order-values lcv] - [current-inference mac] - [current-reset #f]) - (check-equal? (solve csp) - (make-hasheq '((nsw . green) (nt . green) (q . red) (sa . blue) (t . blue) (v . red) (wa . red)))) - (check-equal? (begin0 (list ($csp-nassigns csp) ($csp-nchecks csp)) (reset-counters! csp)) '(7 45))) - -(set-$csp-curr_domains! csp #f) -(parameterize ([current-shuffle #f] - [current-solver min_conflicts]) - (check-equal? - (solve csp) - (make-hasheq '((nsw . red) (nt . red) (q . green) (sa . blue) (t . red) (v . green) (wa . green)))) - (check-equal? (begin0 (list ($csp-nassigns csp) ($csp-nchecks csp)) (reset-counters! csp)) '(9 220))) +#;(begin + (define vs '(wa nsw t q nt v sa)) + (define vds (for/list ([k vs]) + ($vd k '(red green blue)))) + (define (neq? a b) (not (eq? a b))) + (define cs (list + ($constraint '(wa nt) neq?) + ($constraint '(wa sa) neq?) + ($constraint '(nt sa) neq?) + ($constraint '(nt q) neq?) + ($constraint '(q sa) neq?) + ($constraint '(q nsw) neq?) + ($constraint '(nsw sa) neq?) + ($constraint '(nsw v) neq?) + ($constraint '(v sa) neq?))) + (define csp (make-csp vds cs)) + (check-true ($csp? csp)) + (define a (make-hasheq)) + (assign csp 'key 42 a) + (check-equal? (hash-ref a 'key) 42) + (unassign csp 'key a) + (check-exn exn:fail? (λ () (hash-ref a 'key))) + (check-equal? 0 (nconflicts csp 'wa 'red (hasheq 'wa 42))) + (support_pruning csp) + (check-true (hash? ($csp-curr_domains csp))) + + (check-equal? (suppose csp 'wa 'red) '#&((wa . green) (wa . blue))) + (check-equal? (curr_domain csp 'wa) '(red)) + + (check-equal? (prune csp 'v 'red (box empty)) '#&((v . red))) + + (check-equal? (choices csp 'v) '(green blue)) + (check-equal? (choices csp 'wa) '(red)) + (check-equal? (infer_assignment csp) + (make-hasheq '((wa . red)))) + (check-equal? (suppose csp 'v 'blue) '#&((v . green))) + (check-equal? (infer_assignment csp) + (make-hasheq '((v . blue) (wa . red)))) + (restore csp '#&((wa . green))) + (check-equal? (infer_assignment csp) + (make-hasheq '((v . blue)))) + (restore csp '#&((v . blue))) + (check-equal? (infer_assignment csp) (make-hasheq)) + + (check-equal? (first_unassigned_variable (hash) csp) 'wa) + (check-equal? (unordered_domain_values 'wa (hash) csp) '(red green)) + + (set-$csp-curr_domains! csp #f) ; reset current domains + (check-equal? (solve csp) + (make-hasheq '((nsw . green) (nt . green) (q . red) (sa . blue) (t . blue) (v . red) (wa . red)))) + (check-equal? (begin0 (list ($csp-nassigns csp) ($csp-nchecks csp)) (reset-counters! csp)) '(40 321)) + (check-equal? (length (solve* csp)) 18) + + (check-equal? (suppose csp 'nsw 'red) '#&((nsw . green) (nsw . blue))) + (check-equal? (solve csp) + (make-hasheq '((nsw . red) (nt . red) (q . green) (sa . blue) (t . blue) (v . green) (wa . green)))) + (check-equal? ($csp-nassigns csp) 368) + + (reset-counters! csp) + (check-equal? (suppose csp 'nsw 'red) '#&((nsw . green) (nsw . blue))) + (check-equal? (length (solve* csp)) 6) + (check-equal? (begin0 (list ($csp-nassigns csp) ($csp-nchecks csp)) (reset-counters! csp)) '(111 1035)) + + (parameterize ([current-select-variable mrv] + [current-shuffle #f]) + (check-equal? + (solve csp) + (make-hasheq '((nsw . green) (nt . green) (q . red) (sa . blue) (t . blue) (v . red) (wa . red)))) + (check-equal? (begin0 (list ($csp-nassigns csp) ($csp-nchecks csp)) (reset-counters! csp)) '(39 321))) + + (parameterize ([current-order-values lcv]) + (check-equal? + (solve csp) + (make-hasheq '((nsw . green) (nt . green) (q . red) (sa . blue) (t . blue) (v . red) (wa . red)))) + (check-equal? (begin0 (list ($csp-nassigns csp) ($csp-nchecks csp)) (reset-counters! csp)) '(39 1040))) + + (parameterize ([current-inference forward_checking]) + (forward_checking csp 'sa 'blue (make-hasheq) (box null)) + (check-equal? ($csp-curr_domains csp) + (make-hasheq '((nsw . (red green)) (nt . (red green)) (q . (red green)) (sa . (red green blue)) (t . (red green blue)) (v . (red green)) (wa . (red green)))))) + + (set-$csp-curr_domains! csp #f) + (parameterize ([current-inference forward_checking]) + (check-equal? + (solve csp) + (make-hasheq '((nsw . green) (nt . green) (q . red) (sa . blue) (t . blue) (v . red) (wa . red)))) + (check-equal? (begin0 (list ($csp-nassigns csp) ($csp-nchecks csp)) (reset-counters! csp)) '(25 121))) + + (set-$csp-curr_domains! csp #f) + (parameterize ([current-inference mac] + [current-reset #f]) + (check-equal? (solve csp) + (make-hasheq '((nsw . green) (nt . green) (q . red) (sa . blue) (t . blue) (v . red) (wa . red)))) + (check-equal? (begin0 (list ($csp-nassigns csp) ($csp-nchecks csp)) (reset-counters! csp)) '(17 175))) + + (parameterize ([current-select-variable mrv] + [current-order-values lcv] + [current-inference mac] + [current-reset #f]) + (check-equal? (solve csp) + (make-hasheq '((nsw . green) (nt . green) (q . red) (sa . blue) (t . blue) (v . red) (wa . red)))) + (check-equal? (begin0 (list ($csp-nassigns csp) ($csp-nchecks csp)) (reset-counters! csp)) '(7 45))) + + (set-$csp-curr_domains! csp #f) + (parameterize ([current-shuffle #f] + [current-solver min_conflicts]) + (check-equal? + (solve csp) + (make-hasheq '((nsw . red) (nt . red) (q . green) (sa . blue) (t . red) (v . green) (wa . green)))) + (check-equal? (begin0 (list ($csp-nassigns csp) ($csp-nchecks csp)) (reset-counters! csp)) '(9 220)))) (solve (make-csp (list ($vd 'a '(1 2 3)) ($vd 'b '(4 5 6)) From c3dfa21d7dd002a23f26f250abea20fe6b95d28c Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Tue, 16 Oct 2018 13:58:28 -0700 Subject: [PATCH 136/246] closer --- csp/aima.rkt | 16 +++++++++++----- 1 file changed, 11 insertions(+), 5 deletions(-) diff --git a/csp/aima.rkt b/csp/aima.rkt index c1ec2146..3b5c6b35 100644 --- a/csp/aima.rkt +++ b/csp/aima.rkt @@ -49,15 +49,15 @@ (define nchecks $csp-nchecks) (define/contract (check-constraint csp . varvals) - ($csp? variable? any/c variable? any/c . -> . any/c) - (define varval-hash (apply hasheq #R varvals)) + (($csp?) #:rest (listof any/c) . ->* . any/c) + (define varval-hash (apply hasheq varvals)) (define relevant-constraints (for/list ([constraint (in-list ($csp-constraints csp))] #:when (for/and ([cname (in-list ($constraint-names constraint))]) (memq cname (hash-keys varval-hash)))) constraint)) (begin0 - (for/and ([constraint (in-list #R relevant-constraints)]) + (for/and ([constraint (in-list relevant-constraints)]) (define vals (for/list ([cname (in-list ($constraint-names constraint))]) (hash-ref varval-hash cname))) (apply ($constraint-proc constraint) vals)) @@ -85,16 +85,22 @@ ($csp? assignment? . -> . boolean?) (= (length (hash-keys assignment)) (length ($csp-variables csp)))) + (define/contract (nconflicts csp var val assignment) ($csp? variable? any/c assignment? . -> . number?) ;; Return the number of conflicts var=val has with other variables.""" ;; Subclasses may implement this more efficiently (for/sum ([v (in-list (neighbors csp var))] #:when (assignment . assigns? . v)) - (if (check-constraint csp var val v (hash-ref assignment v)) + #;(define this (apply check-constraint csp (append (list var val) (flatten (for/list ([(k v) (in-hash assignment)] + #:unless (eq? var k)) + (list k v)))))) + (define that (check-constraint csp var val v (hash-ref assignment v))) + (if that 0 1))) + (define (display csp assignment) (displayln csp)) @@ -389,7 +395,7 @@ (require rackunit) -#;(begin +(begin (define vs '(wa nsw t q nt v sa)) (define vds (for/list ([k vs]) ($vd k '(red green blue)))) From 778677e96776824fb7b06e6e68848142f273652e Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Tue, 16 Oct 2018 15:47:09 -0700 Subject: [PATCH 137/246] well --- csp/aima.rkt | 90 ++++++++++++++++++++++++++++++++++------------------ 1 file changed, 59 insertions(+), 31 deletions(-) diff --git a/csp/aima.rkt b/csp/aima.rkt index 3b5c6b35..fa71d61c 100644 --- a/csp/aima.rkt +++ b/csp/aima.rkt @@ -8,6 +8,11 @@ (define variable? symbol?) (define removal? (cons/c variable? any/c)) +(define (update-assignment assignment var val) + (define h (hash-copy assignment)) + (hash-set! h var val) + h) + (struct $constraint (names proc) #:transparent) (struct $vd (name vals) #:transparent) @@ -48,13 +53,15 @@ (define nassigns $csp-nassigns) (define nchecks $csp-nchecks) -(define/contract (check-constraint csp . varvals) - (($csp?) #:rest (listof any/c) . ->* . any/c) - (define varval-hash (apply hasheq varvals)) +(define/contract (check-constraint csp varval-hash [limit #f]) + (($csp? hash?) ((or/c #f variable?)) . ->* . any/c) (define relevant-constraints (for/list ([constraint (in-list ($csp-constraints csp))] - #:when (for/and ([cname (in-list ($constraint-names constraint))]) - (memq cname (hash-keys varval-hash)))) + #:when (let ([cnames ($constraint-names constraint)]) + (and + (if limit (memq limit cnames) #true) + (for/and ([cname (in-list cnames)]) + (memq cname (hash-keys varval-hash)))))) constraint)) (begin0 (for/and ([constraint (in-list relevant-constraints)]) @@ -85,18 +92,17 @@ ($csp? assignment? . -> . boolean?) (= (length (hash-keys assignment)) (length ($csp-variables csp)))) - +(define asses (make-parameter #f)) (define/contract (nconflicts csp var val assignment) ($csp? variable? any/c assignment? . -> . number?) ;; Return the number of conflicts var=val has with other variables.""" ;; Subclasses may implement this more efficiently + (define ass (update-assignment assignment var val)) (for/sum ([v (in-list (neighbors csp var))] #:when (assignment . assigns? . v)) - #;(define this (apply check-constraint csp (append (list var val) (flatten (for/list ([(k v) (in-hash assignment)] - #:unless (eq? var k)) - (list k v)))))) - (define that (check-constraint csp var val v (hash-ref assignment v))) - (if that + (if (check-constraint csp (if asses + ass + (hasheq var val v (hash-ref assignment v)))) 0 1))) @@ -242,7 +248,7 @@ (cond [(not (for/or ([y (in-list (curr_domain csp Xj))]) - (check-constraint csp Xi x Xj y))) + (check-constraint csp (hasheq Xi x Xj y)))) (prune csp Xi x removals) #true] [else revised]))) @@ -305,10 +311,11 @@ ($csp? variable? any/c assignment? (box/c (listof removal?)) . -> . boolean?) ;; Prune neighbor values inconsistent with var=value. (support_pruning csp) ;; necessary to set up curr_domains + (define ass (update-assignment assignment var value)) (for/and ([B (in-list (neighbors csp var))] #:unless (assignment . assigns? . B)) (for ([b (in-list (curr_domain csp B))] - #:unless (check-constraint csp var value B b)) + #:unless (check-constraint csp (if asses ass (hasheq var value B b)))) (prune csp B b removals)) (not (empty? (curr_domain csp B))))) @@ -394,23 +401,44 @@ [else #false])) (require rackunit) - -(begin - (define vs '(wa nsw t q nt v sa)) - (define vds (for/list ([k vs]) - ($vd k '(red green blue)))) - (define (neq? a b) (not (eq? a b))) - (define cs (list - ($constraint '(wa nt) neq?) - ($constraint '(wa sa) neq?) - ($constraint '(nt sa) neq?) - ($constraint '(nt q) neq?) - ($constraint '(q sa) neq?) - ($constraint '(q nsw) neq?) - ($constraint '(nsw sa) neq?) - ($constraint '(nsw v) neq?) - ($constraint '(v sa) neq?))) - (define csp (make-csp vds cs)) +(define vs '(wa nsw t q nt v sa)) +(define vds (for/list ([k vs]) + ($vd k '(red green blue)))) +(define (neq? a b) (not (eq? a b))) +(define cs (list + ($constraint '(wa nt) neq?) + ($constraint '(wa sa) neq?) + ($constraint '(nt sa) neq?) + ($constraint '(nt q) neq?) + ($constraint '(q sa) neq?) + ($constraint '(q nsw) neq?) + ($constraint '(nsw sa) neq?) + ($constraint '(nsw v) neq?) + ($constraint '(v sa) neq?))) +(define csp (make-csp vds cs)) + +(define (one) + (parameterize ([current-select-variable mrv] + [current-order-values lcv] + [current-inference mac] + [current-reset #f] + [current-shuffle #f]) + (set-$csp-curr_domains! csp #f) + (check-equal? (solve csp) + (make-hasheq + '((nsw . green) + (nt . green) + (q . red) + (sa . blue) + (t . red) + (v . red) + (wa . red)))) + + (check-equal? (begin0 (list ($csp-nassigns csp) ($csp-nchecks csp)) (reset-counters! csp)) '(7 97)))) + +(define (test) + (begin + (set-$csp-curr_domains! csp #f) (check-true ($csp? csp)) (define a (make-hasheq)) (assign csp 'key 42 a) @@ -504,7 +532,7 @@ (check-equal? (solve csp) (make-hasheq '((nsw . red) (nt . red) (q . green) (sa . blue) (t . red) (v . green) (wa . green)))) - (check-equal? (begin0 (list ($csp-nassigns csp) ($csp-nchecks csp)) (reset-counters! csp)) '(9 220)))) + (check-equal? (begin0 (list ($csp-nassigns csp) ($csp-nchecks csp)) (reset-counters! csp)) '(9 220))))) (solve (make-csp (list ($vd 'a '(1 2 3)) ($vd 'b '(4 5 6)) From dd61a5182c09898c58c2966126fc778edc119339 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Tue, 16 Oct 2018 15:47:53 -0700 Subject: [PATCH 138/246] Revert "well" This reverts commit 778677e96776824fb7b06e6e68848142f273652e. --- csp/aima.rkt | 90 ++++++++++++++++++---------------------------------- 1 file changed, 31 insertions(+), 59 deletions(-) diff --git a/csp/aima.rkt b/csp/aima.rkt index fa71d61c..3b5c6b35 100644 --- a/csp/aima.rkt +++ b/csp/aima.rkt @@ -8,11 +8,6 @@ (define variable? symbol?) (define removal? (cons/c variable? any/c)) -(define (update-assignment assignment var val) - (define h (hash-copy assignment)) - (hash-set! h var val) - h) - (struct $constraint (names proc) #:transparent) (struct $vd (name vals) #:transparent) @@ -53,15 +48,13 @@ (define nassigns $csp-nassigns) (define nchecks $csp-nchecks) -(define/contract (check-constraint csp varval-hash [limit #f]) - (($csp? hash?) ((or/c #f variable?)) . ->* . any/c) +(define/contract (check-constraint csp . varvals) + (($csp?) #:rest (listof any/c) . ->* . any/c) + (define varval-hash (apply hasheq varvals)) (define relevant-constraints (for/list ([constraint (in-list ($csp-constraints csp))] - #:when (let ([cnames ($constraint-names constraint)]) - (and - (if limit (memq limit cnames) #true) - (for/and ([cname (in-list cnames)]) - (memq cname (hash-keys varval-hash)))))) + #:when (for/and ([cname (in-list ($constraint-names constraint))]) + (memq cname (hash-keys varval-hash)))) constraint)) (begin0 (for/and ([constraint (in-list relevant-constraints)]) @@ -92,17 +85,18 @@ ($csp? assignment? . -> . boolean?) (= (length (hash-keys assignment)) (length ($csp-variables csp)))) -(define asses (make-parameter #f)) + (define/contract (nconflicts csp var val assignment) ($csp? variable? any/c assignment? . -> . number?) ;; Return the number of conflicts var=val has with other variables.""" ;; Subclasses may implement this more efficiently - (define ass (update-assignment assignment var val)) (for/sum ([v (in-list (neighbors csp var))] #:when (assignment . assigns? . v)) - (if (check-constraint csp (if asses - ass - (hasheq var val v (hash-ref assignment v)))) + #;(define this (apply check-constraint csp (append (list var val) (flatten (for/list ([(k v) (in-hash assignment)] + #:unless (eq? var k)) + (list k v)))))) + (define that (check-constraint csp var val v (hash-ref assignment v))) + (if that 0 1))) @@ -248,7 +242,7 @@ (cond [(not (for/or ([y (in-list (curr_domain csp Xj))]) - (check-constraint csp (hasheq Xi x Xj y)))) + (check-constraint csp Xi x Xj y))) (prune csp Xi x removals) #true] [else revised]))) @@ -311,11 +305,10 @@ ($csp? variable? any/c assignment? (box/c (listof removal?)) . -> . boolean?) ;; Prune neighbor values inconsistent with var=value. (support_pruning csp) ;; necessary to set up curr_domains - (define ass (update-assignment assignment var value)) (for/and ([B (in-list (neighbors csp var))] #:unless (assignment . assigns? . B)) (for ([b (in-list (curr_domain csp B))] - #:unless (check-constraint csp (if asses ass (hasheq var value B b)))) + #:unless (check-constraint csp var value B b)) (prune csp B b removals)) (not (empty? (curr_domain csp B))))) @@ -401,44 +394,23 @@ [else #false])) (require rackunit) -(define vs '(wa nsw t q nt v sa)) -(define vds (for/list ([k vs]) - ($vd k '(red green blue)))) -(define (neq? a b) (not (eq? a b))) -(define cs (list - ($constraint '(wa nt) neq?) - ($constraint '(wa sa) neq?) - ($constraint '(nt sa) neq?) - ($constraint '(nt q) neq?) - ($constraint '(q sa) neq?) - ($constraint '(q nsw) neq?) - ($constraint '(nsw sa) neq?) - ($constraint '(nsw v) neq?) - ($constraint '(v sa) neq?))) -(define csp (make-csp vds cs)) - -(define (one) - (parameterize ([current-select-variable mrv] - [current-order-values lcv] - [current-inference mac] - [current-reset #f] - [current-shuffle #f]) - (set-$csp-curr_domains! csp #f) - (check-equal? (solve csp) - (make-hasheq - '((nsw . green) - (nt . green) - (q . red) - (sa . blue) - (t . red) - (v . red) - (wa . red)))) - - (check-equal? (begin0 (list ($csp-nassigns csp) ($csp-nchecks csp)) (reset-counters! csp)) '(7 97)))) - -(define (test) - (begin - (set-$csp-curr_domains! csp #f) + +(begin + (define vs '(wa nsw t q nt v sa)) + (define vds (for/list ([k vs]) + ($vd k '(red green blue)))) + (define (neq? a b) (not (eq? a b))) + (define cs (list + ($constraint '(wa nt) neq?) + ($constraint '(wa sa) neq?) + ($constraint '(nt sa) neq?) + ($constraint '(nt q) neq?) + ($constraint '(q sa) neq?) + ($constraint '(q nsw) neq?) + ($constraint '(nsw sa) neq?) + ($constraint '(nsw v) neq?) + ($constraint '(v sa) neq?))) + (define csp (make-csp vds cs)) (check-true ($csp? csp)) (define a (make-hasheq)) (assign csp 'key 42 a) @@ -532,7 +504,7 @@ (check-equal? (solve csp) (make-hasheq '((nsw . red) (nt . red) (q . green) (sa . blue) (t . red) (v . green) (wa . green)))) - (check-equal? (begin0 (list ($csp-nassigns csp) ($csp-nchecks csp)) (reset-counters! csp)) '(9 220))))) + (check-equal? (begin0 (list ($csp-nassigns csp) ($csp-nchecks csp)) (reset-counters! csp)) '(9 220)))) (solve (make-csp (list ($vd 'a '(1 2 3)) ($vd 'b '(4 5 6)) From 9686c654127803bcf7c32fa9791315a10cad8c12 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Tue, 16 Oct 2018 15:56:42 -0700 Subject: [PATCH 139/246] stab --- csp/aima.rkt | 96 +++++++++++++++++++++++++++++++++++----------------- 1 file changed, 65 insertions(+), 31 deletions(-) diff --git a/csp/aima.rkt b/csp/aima.rkt index 3b5c6b35..04ec2211 100644 --- a/csp/aima.rkt +++ b/csp/aima.rkt @@ -8,6 +8,11 @@ (define variable? symbol?) (define removal? (cons/c variable? any/c)) +(define (update-assignment assignment var val) + (define h (hash-copy assignment)) + (hash-set! h var val) + h) + (struct $constraint (names proc) #:transparent) (struct $vd (name vals) #:transparent) @@ -48,13 +53,15 @@ (define nassigns $csp-nassigns) (define nchecks $csp-nchecks) -(define/contract (check-constraint csp . varvals) - (($csp?) #:rest (listof any/c) . ->* . any/c) - (define varval-hash (apply hasheq varvals)) +(define/contract (check-constraint csp varval-hash [limit #f]) + (($csp? hash?) ((or/c #f variable?)) . ->* . any/c) (define relevant-constraints (for/list ([constraint (in-list ($csp-constraints csp))] - #:when (for/and ([cname (in-list ($constraint-names constraint))]) - (memq cname (hash-keys varval-hash)))) + #:when (let ([cnames ($constraint-names constraint)]) + (and + (if limit (memq limit cnames) #true) + (for/and ([cname (in-list cnames)]) + (memq cname (hash-keys varval-hash)))))) constraint)) (begin0 (for/and ([constraint (in-list relevant-constraints)]) @@ -85,18 +92,18 @@ ($csp? assignment? . -> . boolean?) (= (length (hash-keys assignment)) (length ($csp-variables csp)))) +(define asses (make-parameter #f)) (define/contract (nconflicts csp var val assignment) ($csp? variable? any/c assignment? . -> . number?) ;; Return the number of conflicts var=val has with other variables.""" ;; Subclasses may implement this more efficiently + (define ass (update-assignment assignment var val)) (for/sum ([v (in-list (neighbors csp var))] #:when (assignment . assigns? . v)) - #;(define this (apply check-constraint csp (append (list var val) (flatten (for/list ([(k v) (in-hash assignment)] - #:unless (eq? var k)) - (list k v)))))) - (define that (check-constraint csp var val v (hash-ref assignment v))) - (if that + (if (check-constraint csp (if (asses) + ass + (hasheq var val v (hash-ref assignment v))) var) 0 1))) @@ -242,7 +249,7 @@ (cond [(not (for/or ([y (in-list (curr_domain csp Xj))]) - (check-constraint csp Xi x Xj y))) + (check-constraint csp (hasheq Xi x Xj y) Xi))) (prune csp Xi x removals) #true] [else revised]))) @@ -305,10 +312,13 @@ ($csp? variable? any/c assignment? (box/c (listof removal?)) . -> . boolean?) ;; Prune neighbor values inconsistent with var=value. (support_pruning csp) ;; necessary to set up curr_domains + (define ass (update-assignment assignment var value)) (for/and ([B (in-list (neighbors csp var))] #:unless (assignment . assigns? . B)) (for ([b (in-list (curr_domain csp B))] - #:unless (check-constraint csp var value B b)) + #:unless (check-constraint csp (if (asses) + ass + (hasheq var value B b)) var)) (prune csp B b removals)) (not (empty? (curr_domain csp B))))) @@ -395,22 +405,44 @@ (require rackunit) -(begin - (define vs '(wa nsw t q nt v sa)) - (define vds (for/list ([k vs]) - ($vd k '(red green blue)))) - (define (neq? a b) (not (eq? a b))) - (define cs (list - ($constraint '(wa nt) neq?) - ($constraint '(wa sa) neq?) - ($constraint '(nt sa) neq?) - ($constraint '(nt q) neq?) - ($constraint '(q sa) neq?) - ($constraint '(q nsw) neq?) - ($constraint '(nsw sa) neq?) - ($constraint '(nsw v) neq?) - ($constraint '(v sa) neq?))) - (define csp (make-csp vds cs)) +(define vs '(wa nsw t q nt v sa)) +(define vds (for/list ([k vs]) + ($vd k '(red green blue)))) +(define (neq? a b) (not (eq? a b))) +(define cs (list + ($constraint '(wa nt) neq?) + ($constraint '(wa sa) neq?) + ($constraint '(nt sa) neq?) + ($constraint '(nt q) neq?) + ($constraint '(q sa) neq?) + ($constraint '(q nsw) neq?) + ($constraint '(nsw sa) neq?) + ($constraint '(nsw v) neq?) + ($constraint '(v sa) neq?))) +(define csp (make-csp vds cs)) + +(define (one) + (parameterize ([current-select-variable mrv] + [current-order-values lcv] + [current-inference mac] + [current-reset #f] + [current-shuffle #f]) + (set-$csp-curr_domains! csp #f) + (check-equal? (solve csp) + (make-hasheq + '((nsw . green) + (nt . green) + (q . red) + (sa . blue) + (t . red) + (v . red) + (wa . red)))) + + (check-equal? (begin0 (list ($csp-nassigns csp) ($csp-nchecks csp)) (reset-counters! csp)) '(7 97)))) + +(define (test) + (begin + (set-$csp-curr_domains! csp #f) (check-true ($csp? csp)) (define a (make-hasheq)) (assign csp 'key 42 a) @@ -504,9 +536,11 @@ (check-equal? (solve csp) (make-hasheq '((nsw . red) (nt . red) (q . green) (sa . blue) (t . red) (v . green) (wa . green)))) - (check-equal? (begin0 (list ($csp-nassigns csp) ($csp-nchecks csp)) (reset-counters! csp)) '(9 220)))) + (check-equal? (begin0 (list ($csp-nassigns csp) ($csp-nchecks csp)) (reset-counters! csp)) '(9 220))))) -(solve (make-csp (list ($vd 'a '(1 2 3)) +(define tri (make-csp (list ($vd 'a '(1 2 3)) ($vd 'b '(4 5 6)) ($vd 'c '(7 8 9))) - (list ($constraint '(a b c) (λ (a b c) (= (+ a b c) 18)))))) \ No newline at end of file + (list ($constraint '(a b c) (λ (a b c) (= (+ a b c) 18)))))) + +(solve tri) \ No newline at end of file From fc378d9a8a3739b93c2fe3e0d7f53c9b5517214b Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Tue, 16 Oct 2018 16:52:39 -0700 Subject: [PATCH 140/246] nconflict --- csp/aima.rkt | 70 ++++++++++++++++++++++++++-------------------------- 1 file changed, 35 insertions(+), 35 deletions(-) diff --git a/csp/aima.rkt b/csp/aima.rkt index 04ec2211..e356e993 100644 --- a/csp/aima.rkt +++ b/csp/aima.rkt @@ -50,11 +50,18 @@ (assignment? variable? . -> . boolean?) (hash-has-key? assignment var)) +(define/contract (assignment-ref assignment name-or-names) + (assignment? (or/c (listof variable?) variable?) . -> . (or/c any/c (listof any/c))) + (let loop ([name-or-names name-or-names]) + (match name-or-names + [(? variable? name) (hash-ref assignment name)] + [(list names ...) (map loop names)]))) + (define nassigns $csp-nassigns) (define nchecks $csp-nchecks) -(define/contract (check-constraint csp varval-hash [limit #f]) - (($csp? hash?) ((or/c #f variable?)) . ->* . any/c) +(define/contract (check-constraint csp varval-hash [limit #f] #:conflicts [count-conflicts? #f]) + (($csp? hash?) ((or/c #f variable?) #:conflicts boolean?) . ->* . any/c) (define relevant-constraints (for/list ([constraint (in-list ($csp-constraints csp))] #:when (let ([cnames ($constraint-names constraint)]) @@ -63,12 +70,19 @@ (for/and ([cname (in-list cnames)]) (memq cname (hash-keys varval-hash)))))) constraint)) - (begin0 - (for/and ([constraint (in-list relevant-constraints)]) - (define vals (for/list ([cname (in-list ($constraint-names constraint))]) - (hash-ref varval-hash cname))) - (apply ($constraint-proc constraint) vals)) - (set-$csp-nchecks! csp (add1 ($csp-nchecks csp))))) + (begin + ;; ordinary: behave like for/and, stop if #false result. + ;; count-conflicts mode: behave like for/sum, don't stop till end. + (define-values (result check-count) + (for/fold ([result (if count-conflicts? 0 #true)] + [check-count 0]) + ([constraint (in-list relevant-constraints)] + #:break (false? result)) ; only breaks early in ordinary mode, when #f is result value + (define vals (assignment-ref varval-hash ($constraint-names constraint))) + (define res (apply ($constraint-proc constraint) vals)) + (values (if count-conflicts? (+ (if res 0 1) result) res) (add1 check-count)))) + (set-$csp-nchecks! csp (+ check-count ($csp-nchecks csp))) + result)) (define/contract (reset-counters! csp) ($csp? . -> . void?) @@ -93,19 +107,14 @@ (= (length (hash-keys assignment)) (length ($csp-variables csp)))) (define asses (make-parameter #f)) +(define ncon (make-parameter #f)) (define/contract (nconflicts csp var val assignment) ($csp? variable? any/c assignment? . -> . number?) ;; Return the number of conflicts var=val has with other variables.""" ;; Subclasses may implement this more efficiently (define ass (update-assignment assignment var val)) - (for/sum ([v (in-list (neighbors csp var))] - #:when (assignment . assigns? . v)) - (if (check-constraint csp (if (asses) - ass - (hasheq var val v (hash-ref assignment v))) var) - 0 - 1))) + (check-constraint csp ass var #:conflicts #t)) (define (display csp assignment) @@ -422,23 +431,14 @@ (define csp (make-csp vds cs)) (define (one) - (parameterize ([current-select-variable mrv] - [current-order-values lcv] - [current-inference mac] - [current-reset #f] - [current-shuffle #f]) - (set-$csp-curr_domains! csp #f) - (check-equal? (solve csp) - (make-hasheq - '((nsw . green) - (nt . green) - (q . red) - (sa . blue) - (t . red) - (v . red) - (wa . red)))) + (set-$csp-curr_domains! csp #f) + (parameterize ([current-shuffle #f] + [current-solver min_conflicts]) + (check-equal? + (solve csp) + (make-hasheq '((nsw . red) (nt . red) (q . green) (sa . blue) (t . red) (v . green) (wa . green)))) + (check-equal? (begin0 (list ($csp-nassigns csp) ($csp-nchecks csp)) (reset-counters! csp)) '(9 220)))) - (check-equal? (begin0 (list ($csp-nassigns csp) ($csp-nchecks csp)) (reset-counters! csp)) '(7 97)))) (define (test) (begin @@ -539,8 +539,8 @@ (check-equal? (begin0 (list ($csp-nassigns csp) ($csp-nchecks csp)) (reset-counters! csp)) '(9 220))))) (define tri (make-csp (list ($vd 'a '(1 2 3)) - ($vd 'b '(4 5 6)) - ($vd 'c '(7 8 9))) - (list ($constraint '(a b c) (λ (a b c) (= (+ a b c) 18)))))) + ($vd 'b '(4 5 6)) + ($vd 'c '(7 8 9))) + (list ($constraint '(a b c) (λ (a b c) (= (+ a b c) 18)))))) -(solve tri) \ No newline at end of file +#;(solve tri) \ No newline at end of file From 33b4c750b10d092c0ddbd0f91ab339ea37d5388e Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Tue, 16 Oct 2018 17:30:29 -0700 Subject: [PATCH 141/246] reparations --- csp/aima.rkt | 259 ++++++++++++++++++++++++++++----------------------- 1 file changed, 141 insertions(+), 118 deletions(-) diff --git a/csp/aima.rkt b/csp/aima.rkt index e356e993..042a76be 100644 --- a/csp/aima.rkt +++ b/csp/aima.rkt @@ -23,8 +23,8 @@ (apply add-edge! g edge) g)) -(define/contract (make-csp vds constraints) - ((listof $vd?) (listof $constraint?) . -> . $csp?) +(define/contract (make-csp vds [constraints null]) + (((listof $vd?)) ((listof $constraint?)) . ->* . $csp?) (define variables (map $vd-name vds)) (define domains (for/hasheq ([vd (in-list vds)]) (match vd @@ -53,20 +53,26 @@ (define/contract (assignment-ref assignment name-or-names) (assignment? (or/c (listof variable?) variable?) . -> . (or/c any/c (listof any/c))) (let loop ([name-or-names name-or-names]) - (match name-or-names - [(? variable? name) (hash-ref assignment name)] - [(list names ...) (map loop names)]))) + (match name-or-names + [(? variable? name) (hash-ref assignment name)] + [(list names ...) (map loop names)]))) (define nassigns $csp-nassigns) (define nchecks $csp-nchecks) -(define/contract (check-constraint csp varval-hash [limit #f] #:conflicts [count-conflicts? #f]) - (($csp? hash?) ((or/c #f variable?) #:conflicts boolean?) . ->* . any/c) +(define/contract (reset! csp) + ($csp? . -> . void?) + (set-$csp-curr_domains! csp #f) + (reset-counters! csp)) + +(define/contract (check-constraints csp varval-hash [limits null] #:conflicts [count-conflicts? #f]) + (($csp? hash?) ((listof variable?) #:conflicts boolean?) . ->* . any/c) (define relevant-constraints (for/list ([constraint (in-list ($csp-constraints csp))] #:when (let ([cnames ($constraint-names constraint)]) (and - (if limit (memq limit cnames) #true) + (for/and ([limit (in-list limits)]) + (memq limit cnames)) (for/and ([cname (in-list cnames)]) (memq cname (hash-keys varval-hash)))))) constraint)) @@ -114,7 +120,7 @@ ;; Return the number of conflicts var=val has with other variables.""" ;; Subclasses may implement this more efficiently (define ass (update-assignment assignment var val)) - (check-constraint csp ass var #:conflicts #t)) + (check-constraints csp ass (list var) #:conflicts #t)) (define (display csp assignment) @@ -258,7 +264,7 @@ (cond [(not (for/or ([y (in-list (curr_domain csp Xj))]) - (check-constraint csp (hasheq Xi x Xj y) Xi))) + (check-constraints csp (hasheq Xi x Xj y) (list Xi)))) (prune csp Xi x removals) #true] [else revised]))) @@ -325,9 +331,7 @@ (for/and ([B (in-list (neighbors csp var))] #:unless (assignment . assigns? . B)) (for ([b (in-list (curr_domain csp B))] - #:unless (check-constraint csp (if (asses) - ass - (hasheq var value B b)) var)) + #:unless (check-constraints csp (update-assignment ass B b) (list var B))) (prune csp B b removals)) (not (empty? (curr_domain csp B))))) @@ -430,117 +434,136 @@ ($constraint '(v sa) neq?))) (define csp (make-csp vds cs)) -(define (one) + +(define (tests) (set-$csp-curr_domains! csp #f) - (parameterize ([current-shuffle #f] - [current-solver min_conflicts]) + (check-true ($csp? csp)) + (define a (make-hasheq)) + (assign csp 'key 42 a) + (check-equal? (hash-ref a 'key) 42) + (unassign csp 'key a) + (check-exn exn:fail? (λ () (hash-ref a 'key))) + (check-equal? 0 (nconflicts csp 'wa 'red (hasheq 'wa 42))) + (support_pruning csp) + (check-true (hash? ($csp-curr_domains csp))) + + (check-equal? (suppose csp 'wa 'red) '#&((wa . green) (wa . blue))) + (check-equal? (curr_domain csp 'wa) '(red)) + + (check-equal? (prune csp 'v 'red (box empty)) '#&((v . red))) + + (check-equal? (choices csp 'v) '(green blue)) + (check-equal? (choices csp 'wa) '(red)) + (check-equal? (infer_assignment csp) + (make-hasheq '((wa . red)))) + (check-equal? (suppose csp 'v 'blue) '#&((v . green))) + (check-equal? (infer_assignment csp) + (make-hasheq '((v . blue) (wa . red)))) + (restore csp '#&((wa . green))) + (check-equal? (infer_assignment csp) + (make-hasheq '((v . blue)))) + (restore csp '#&((v . blue))) + (check-equal? (infer_assignment csp) (make-hasheq)) + + (check-equal? (first_unassigned_variable (hash) csp) 'wa) + (check-equal? (unordered_domain_values 'wa (hash) csp) '(red green)) + + (set-$csp-curr_domains! csp #f) ; reset current domains + (check-equal? (solve csp) + (make-hasheq '((nsw . green) (nt . green) (q . red) (sa . blue) (t . blue) (v . red) (wa . red)))) + (check-equal? (begin0 (list ($csp-nassigns csp) ($csp-nchecks csp)) (reset-counters! csp)) '(40 321)) + (check-equal? (length (solve* csp)) 18) + + (check-equal? (suppose csp 'nsw 'red) '#&((nsw . green) (nsw . blue))) + (check-equal? (solve csp) + (make-hasheq '((nsw . red) (nt . red) (q . green) (sa . blue) (t . blue) (v . green) (wa . green)))) + (check-equal? ($csp-nassigns csp) 368) + + (reset-counters! csp) + (check-equal? (suppose csp 'nsw 'red) '#&((nsw . green) (nsw . blue))) + (check-equal? (length (solve* csp)) 6) + (check-equal? (begin0 (list ($csp-nassigns csp) ($csp-nchecks csp)) (reset-counters! csp)) '(111 1035)) + + (parameterize ([current-select-variable mrv] + [current-shuffle #f]) (check-equal? (solve csp) - (make-hasheq '((nsw . red) (nt . red) (q . green) (sa . blue) (t . red) (v . green) (wa . green)))) - (check-equal? (begin0 (list ($csp-nassigns csp) ($csp-nchecks csp)) (reset-counters! csp)) '(9 220)))) + (make-hasheq '((nsw . green) (nt . green) (q . red) (sa . blue) (t . blue) (v . red) (wa . red)))) + (check-equal? (begin0 (list ($csp-nassigns csp) ($csp-nchecks csp)) (reset-counters! csp)) '(39 321))) + + (parameterize ([current-order-values lcv]) + (check-equal? + (solve csp) + (make-hasheq '((nsw . green) (nt . green) (q . red) (sa . blue) (t . blue) (v . red) (wa . red)))) + (check-equal? (begin0 (list ($csp-nassigns csp) ($csp-nchecks csp)) (reset-counters! csp)) '(39 1040))) + (parameterize ([current-inference forward_checking]) + (forward_checking csp 'sa 'blue (make-hasheq) (box null)) + (check-equal? ($csp-curr_domains csp) + (make-hasheq '((nsw . (red green)) (nt . (red green)) (q . (red green)) (sa . (red green blue)) (t . (red green blue)) (v . (red green)) (wa . (red green)))))) -(define (test) - (begin - (set-$csp-curr_domains! csp #f) - (check-true ($csp? csp)) - (define a (make-hasheq)) - (assign csp 'key 42 a) - (check-equal? (hash-ref a 'key) 42) - (unassign csp 'key a) - (check-exn exn:fail? (λ () (hash-ref a 'key))) - (check-equal? 0 (nconflicts csp 'wa 'red (hasheq 'wa 42))) - (support_pruning csp) - (check-true (hash? ($csp-curr_domains csp))) - - (check-equal? (suppose csp 'wa 'red) '#&((wa . green) (wa . blue))) - (check-equal? (curr_domain csp 'wa) '(red)) - - (check-equal? (prune csp 'v 'red (box empty)) '#&((v . red))) - - (check-equal? (choices csp 'v) '(green blue)) - (check-equal? (choices csp 'wa) '(red)) - (check-equal? (infer_assignment csp) - (make-hasheq '((wa . red)))) - (check-equal? (suppose csp 'v 'blue) '#&((v . green))) - (check-equal? (infer_assignment csp) - (make-hasheq '((v . blue) (wa . red)))) - (restore csp '#&((wa . green))) - (check-equal? (infer_assignment csp) - (make-hasheq '((v . blue)))) - (restore csp '#&((v . blue))) - (check-equal? (infer_assignment csp) (make-hasheq)) - - (check-equal? (first_unassigned_variable (hash) csp) 'wa) - (check-equal? (unordered_domain_values 'wa (hash) csp) '(red green)) - - (set-$csp-curr_domains! csp #f) ; reset current domains + (reset-counters! csp) + (set-$csp-curr_domains! csp #f) + (parameterize ([current-inference forward_checking]) + (check-equal? + (solve csp) + (make-hasheq '((nsw . green) (nt . green) (q . red) (sa . blue) (t . blue) (v . red) (wa . red)))) + (check-equal? (begin0 (list ($csp-nassigns csp) ($csp-nchecks csp)) (reset-counters! csp)) '(25 106))) + + (set-$csp-curr_domains! csp #f) + (parameterize ([current-inference mac] + [current-reset #f]) (check-equal? (solve csp) (make-hasheq '((nsw . green) (nt . green) (q . red) (sa . blue) (t . blue) (v . red) (wa . red)))) - (check-equal? (begin0 (list ($csp-nassigns csp) ($csp-nchecks csp)) (reset-counters! csp)) '(40 321)) - (check-equal? (length (solve* csp)) 18) + (check-equal? (begin0 (list ($csp-nassigns csp) ($csp-nchecks csp)) (reset-counters! csp)) '(17 175))) - (check-equal? (suppose csp 'nsw 'red) '#&((nsw . green) (nsw . blue))) + (parameterize ([current-select-variable mrv] + [current-order-values lcv] + [current-inference mac] + [current-reset #f]) (check-equal? (solve csp) - (make-hasheq '((nsw . red) (nt . red) (q . green) (sa . blue) (t . blue) (v . green) (wa . green)))) - (check-equal? ($csp-nassigns csp) 368) - - (reset-counters! csp) - (check-equal? (suppose csp 'nsw 'red) '#&((nsw . green) (nsw . blue))) - (check-equal? (length (solve* csp)) 6) - (check-equal? (begin0 (list ($csp-nassigns csp) ($csp-nchecks csp)) (reset-counters! csp)) '(111 1035)) - - (parameterize ([current-select-variable mrv] - [current-shuffle #f]) - (check-equal? - (solve csp) - (make-hasheq '((nsw . green) (nt . green) (q . red) (sa . blue) (t . blue) (v . red) (wa . red)))) - (check-equal? (begin0 (list ($csp-nassigns csp) ($csp-nchecks csp)) (reset-counters! csp)) '(39 321))) - - (parameterize ([current-order-values lcv]) - (check-equal? - (solve csp) - (make-hasheq '((nsw . green) (nt . green) (q . red) (sa . blue) (t . blue) (v . red) (wa . red)))) - (check-equal? (begin0 (list ($csp-nassigns csp) ($csp-nchecks csp)) (reset-counters! csp)) '(39 1040))) - - (parameterize ([current-inference forward_checking]) - (forward_checking csp 'sa 'blue (make-hasheq) (box null)) - (check-equal? ($csp-curr_domains csp) - (make-hasheq '((nsw . (red green)) (nt . (red green)) (q . (red green)) (sa . (red green blue)) (t . (red green blue)) (v . (red green)) (wa . (red green)))))) - - (set-$csp-curr_domains! csp #f) - (parameterize ([current-inference forward_checking]) - (check-equal? - (solve csp) - (make-hasheq '((nsw . green) (nt . green) (q . red) (sa . blue) (t . blue) (v . red) (wa . red)))) - (check-equal? (begin0 (list ($csp-nassigns csp) ($csp-nchecks csp)) (reset-counters! csp)) '(25 121))) - - (set-$csp-curr_domains! csp #f) - (parameterize ([current-inference mac] - [current-reset #f]) - (check-equal? (solve csp) - (make-hasheq '((nsw . green) (nt . green) (q . red) (sa . blue) (t . blue) (v . red) (wa . red)))) - (check-equal? (begin0 (list ($csp-nassigns csp) ($csp-nchecks csp)) (reset-counters! csp)) '(17 175))) - - (parameterize ([current-select-variable mrv] - [current-order-values lcv] - [current-inference mac] - [current-reset #f]) - (check-equal? (solve csp) - (make-hasheq '((nsw . green) (nt . green) (q . red) (sa . blue) (t . blue) (v . red) (wa . red)))) - (check-equal? (begin0 (list ($csp-nassigns csp) ($csp-nchecks csp)) (reset-counters! csp)) '(7 45))) - - (set-$csp-curr_domains! csp #f) - (parameterize ([current-shuffle #f] - [current-solver min_conflicts]) - (check-equal? - (solve csp) - (make-hasheq '((nsw . red) (nt . red) (q . green) (sa . blue) (t . red) (v . green) (wa . green)))) - (check-equal? (begin0 (list ($csp-nassigns csp) ($csp-nchecks csp)) (reset-counters! csp)) '(9 220))))) - -(define tri (make-csp (list ($vd 'a '(1 2 3)) - ($vd 'b '(4 5 6)) - ($vd 'c '(7 8 9))) - (list ($constraint '(a b c) (λ (a b c) (= (+ a b c) 18)))))) - -#;(solve tri) \ No newline at end of file + (make-hasheq '((nsw . green) (nt . green) (q . red) (sa . blue) (t . blue) (v . red) (wa . red)))) + (check-equal? (begin0 (list ($csp-nassigns csp) ($csp-nchecks csp)) (reset-counters! csp)) '(7 45))) + + (set-$csp-curr_domains! csp #f) + (parameterize ([current-shuffle #f] + [current-solver min_conflicts]) + (check-equal? + (solve csp) + (make-hasheq '((nsw . red) (nt . red) (q . green) (sa . blue) (t . red) (v . green) (wa . green)))) + (check-equal? (begin0 (list ($csp-nassigns csp) ($csp-nchecks csp)) (reset-counters! csp)) '(9 220))) + + (define tri (make-csp (list ($vd 'a '(1 2 3)) + ($vd 'b '(4 5 6)) + ($vd 'c '(7 8 9))) + (list ($constraint '(a b c) (λ (a b c) (= (+ a b c) 18)))))) + + (parameterize ([current-select-variable mrv] + [current-order-values lcv] + [current-inference mac] + [current-reset #f] + [current-shuffle #f]) + (check-equal? (solve tri) (make-hasheq '((a . 3) (b . 6) (c . 9))))) + (check-equal? (begin0 (list ($csp-nassigns tri) ($csp-nchecks tri)) (reset-counters! tri)) '(13 68)) + ) + +(module+ test + (tests)) + + + +#| +(define (abc-test a b c) (/ (+ (* 100 a) (* 10 b) c) (+ a b c))) +(define abc (make-csp (list ($vd 'a (shuffle (range 1 10))) + ($vd 'b (range 1 10)) + ($vd 'c (range 1 10))))) + +(argmin (λ (h) + (abc-test (hash-ref h 'a) (hash-ref h 'b) (hash-ref h 'c))) + (parameterize ([current-select-variable mrv] + [current-order-values lcv] + [current-inference mac] + [current-reset #f] + [current-shuffle #f]) + (solve* abc))) +|# \ No newline at end of file From d8e31ed03f8308c87a6624ef1c15d9fb714ffea3 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Wed, 17 Oct 2018 11:50:48 -0700 Subject: [PATCH 142/246] nit --- csp/aima-smm.rkt | 42 +++++++++++++++++++++++++++++------------- 1 file changed, 29 insertions(+), 13 deletions(-) diff --git a/csp/aima-smm.rkt b/csp/aima-smm.rkt index 949f30f7..f0f6cf0e 100644 --- a/csp/aima-smm.rkt +++ b/csp/aima-smm.rkt @@ -5,26 +5,42 @@ ;+ MORE ;------ ; MONEY + + (define (word-value . xs) (for/sum ([(x idx) (in-indexed (reverse xs))]) (* x (expt 10 idx)))) (define vs '(s e n d m o r y)) -(define ds (for/hash ([k vs]) - (values k (range 10)))) -(define ns (for*/hash ([v (in-list vs)]) - (values v (remove v vs)))) +(define vds (for/list ([k vs]) + ($vd k (range 10)))) + +(define (not= x y) (not (= x y))) + +(define alldiffs + (for/list ([pr (in-combinations vs 2)]) + ($constraint pr not=))) -(define (smm-constraint A a B b) - (and - (not (eq? a b)) - (when (eq? A 's) (= 1 a)))) +(define (smm-func s e n d m o r y) + (= (+ (word-value s e n d) (word-value m o r e)) (word-value m o n e y))) -(define csp (make-csp vs ds ns smm-constraint)) +(define csp (make-csp vds (append + + alldiffs + (list + ($constraint vs smm-func) + ($constraint '(s) positive?) + ($constraint '(m) (λ (x) (= 1 x))) + ($constraint '(d e y) (λ (d e y) (= (modulo (+ d e) 10) y))) + ($constraint '(n d r e y) (λ (n d r e y) + (= (modulo (+ (word-value n d) (word-value r e)) 100) + (word-value e y)))) + ($constraint '(e n d o r y) (λ (e n d o r y) + (= (modulo (+ (word-value e n d) (word-value o r e)) 1000) (word-value n e y)))))))) (parameterize ([current-select-variable mrv] [current-order-values lcv] - [current-inference mac] - [current-reset #f]) - (solve csp)) + [current-inference mac]) + (time (solve csp))) (nassigns csp) -(nchecks csp) \ No newline at end of file +(nchecks csp) +(reset! csp) \ No newline at end of file From 91e0399ed64933699cd760b4a449fa0b6340b46d Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Wed, 17 Oct 2018 11:51:26 -0700 Subject: [PATCH 143/246] again --- csp/port2/python-constraint-master/.gitignore | 60 + .../python-constraint-master/.travis.yml | 21 + csp/port2/python-constraint-master/LICENSE | 23 + csp/port2/python-constraint-master/README.rst | 159 ++ .../constraint/__init__.py | 1461 +++++++++++++++++ .../constraint/compat.py | 14 + .../constraint/version.py | 8 + .../examples/__init__.py | 0 .../examples/abc/__init__.py | 0 .../examples/abc/abc.py | 37 + .../examples/coins/__init__.py | 0 .../examples/coins/coins.py | 36 + .../examples/crosswords/__init__.py | 0 .../examples/crosswords/crosswords.py | 154 ++ .../examples/crosswords/large.mask | 27 + .../examples/crosswords/medium.mask | 19 + .../examples/crosswords/python.mask | 8 + .../examples/crosswords/small.mask | 8 + .../examples/einstein/__init__.py | 0 .../examples/einstein/einstein.py | 209 +++ .../examples/queens/__init__.py | 0 .../examples/queens/queens.py | 54 + .../examples/rooks/__init__.py | 0 .../examples/rooks/rooks.py | 57 + .../examples/studentdesks/__init__.py | 0 .../examples/studentdesks/studentdesks.py | 48 + .../examples/sudoku/__init__.py | 0 .../examples/sudoku/sudoku.py | 71 + .../examples/wordmath/__init__.py | 0 .../examples/wordmath/seisseisdoze.py | 39 + .../examples/wordmath/sendmoremoney.py | 42 + .../examples/wordmath/twotwofour.py | 37 + .../examples/xsum/__init__.py | 0 .../examples/xsum/xsum.py | 48 + csp/port2/python-constraint-master/setup.cfg | 9 + csp/port2/python-constraint-master/setup.py | 123 ++ .../tests/test_constraint.py | 91 + .../tests/test_solvers.py | 17 + .../tests/test_some_not_in_set.py | 102 ++ 39 files changed, 2982 insertions(+) create mode 100755 csp/port2/python-constraint-master/.gitignore create mode 100755 csp/port2/python-constraint-master/.travis.yml create mode 100755 csp/port2/python-constraint-master/LICENSE create mode 100755 csp/port2/python-constraint-master/README.rst create mode 100755 csp/port2/python-constraint-master/constraint/__init__.py create mode 100755 csp/port2/python-constraint-master/constraint/compat.py create mode 100755 csp/port2/python-constraint-master/constraint/version.py create mode 100755 csp/port2/python-constraint-master/examples/__init__.py create mode 100755 csp/port2/python-constraint-master/examples/abc/__init__.py create mode 100755 csp/port2/python-constraint-master/examples/abc/abc.py create mode 100755 csp/port2/python-constraint-master/examples/coins/__init__.py create mode 100755 csp/port2/python-constraint-master/examples/coins/coins.py create mode 100755 csp/port2/python-constraint-master/examples/crosswords/__init__.py create mode 100755 csp/port2/python-constraint-master/examples/crosswords/crosswords.py create mode 100755 csp/port2/python-constraint-master/examples/crosswords/large.mask create mode 100755 csp/port2/python-constraint-master/examples/crosswords/medium.mask create mode 100755 csp/port2/python-constraint-master/examples/crosswords/python.mask create mode 100755 csp/port2/python-constraint-master/examples/crosswords/small.mask create mode 100755 csp/port2/python-constraint-master/examples/einstein/__init__.py create mode 100755 csp/port2/python-constraint-master/examples/einstein/einstein.py create mode 100755 csp/port2/python-constraint-master/examples/queens/__init__.py create mode 100755 csp/port2/python-constraint-master/examples/queens/queens.py create mode 100755 csp/port2/python-constraint-master/examples/rooks/__init__.py create mode 100755 csp/port2/python-constraint-master/examples/rooks/rooks.py create mode 100755 csp/port2/python-constraint-master/examples/studentdesks/__init__.py create mode 100755 csp/port2/python-constraint-master/examples/studentdesks/studentdesks.py create mode 100755 csp/port2/python-constraint-master/examples/sudoku/__init__.py create mode 100755 csp/port2/python-constraint-master/examples/sudoku/sudoku.py create mode 100755 csp/port2/python-constraint-master/examples/wordmath/__init__.py create mode 100755 csp/port2/python-constraint-master/examples/wordmath/seisseisdoze.py create mode 100755 csp/port2/python-constraint-master/examples/wordmath/sendmoremoney.py create mode 100755 csp/port2/python-constraint-master/examples/wordmath/twotwofour.py create mode 100755 csp/port2/python-constraint-master/examples/xsum/__init__.py create mode 100755 csp/port2/python-constraint-master/examples/xsum/xsum.py create mode 100755 csp/port2/python-constraint-master/setup.cfg create mode 100755 csp/port2/python-constraint-master/setup.py create mode 100755 csp/port2/python-constraint-master/tests/test_constraint.py create mode 100755 csp/port2/python-constraint-master/tests/test_solvers.py create mode 100755 csp/port2/python-constraint-master/tests/test_some_not_in_set.py diff --git a/csp/port2/python-constraint-master/.gitignore b/csp/port2/python-constraint-master/.gitignore new file mode 100755 index 00000000..b102207f --- /dev/null +++ b/csp/port2/python-constraint-master/.gitignore @@ -0,0 +1,60 @@ +# Byte-compiled / optimized / DLL files +__pycache__/ +*.py[cod] + +# C extensions +*.so + +# Distribution / packaging +.Python +env/ +build/ +develop-eggs/ +dist/ +downloads/ +eggs/ +.eggs/ +lib/ +lib64/ +parts/ +sdist/ +var/ +*.egg-info/ +.installed.cfg +*.egg + +# PyInstaller +# Usually these files are written by a python script from a template +# before PyInstaller builds the exe, so as to inject date/other infos into it. +*.manifest +*.spec + +# Installer logs +pip-log.txt +pip-delete-this-directory.txt + +# Unit test / coverage reports +htmlcov/ +.tox/ +.coverage +.coverage.* +.cache +nosetests.xml +coverage.xml +*,cover + +# Translations +*.mo +*.pot + +# Django stuff: +*.log + +# Sphinx documentation +docs/_build/ + +# PyBuilder +target/ + +# PyCharm / Intellij +.idea/ diff --git a/csp/port2/python-constraint-master/.travis.yml b/csp/port2/python-constraint-master/.travis.yml new file mode 100755 index 00000000..2bf2b8a3 --- /dev/null +++ b/csp/port2/python-constraint-master/.travis.yml @@ -0,0 +1,21 @@ +language: python +python: + - "2.7" + - "3.3" + - "3.4" + - "3.5" + - "3.6" + +# command to install dependencies +install: + - "pip install -qq flake8" + - "pip install coveralls --quiet" + - "pip install ." + +# command to run tests +script: + - nosetests -s -v --with-coverage --cover-package=constraint + - flake8 --ignore E501 constraint examples tests + +after_success: + - coveralls diff --git a/csp/port2/python-constraint-master/LICENSE b/csp/port2/python-constraint-master/LICENSE new file mode 100755 index 00000000..1551a23a --- /dev/null +++ b/csp/port2/python-constraint-master/LICENSE @@ -0,0 +1,23 @@ +Copyright (c) 2005-2014 - Gustavo Niemeyer + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + +1. Redistributions of source code must retain the above copyright notice, this + list of conditions and the following disclaimer. +2. Redistributions in binary form must reproduce the above copyright notice, + this list of conditions and the following disclaimer in the documentation + and/or other materials provided with the distribution. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND +ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED +WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE +DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR +ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES +(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; +LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND +ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS +SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/csp/port2/python-constraint-master/README.rst b/csp/port2/python-constraint-master/README.rst new file mode 100755 index 00000000..564e46a5 --- /dev/null +++ b/csp/port2/python-constraint-master/README.rst @@ -0,0 +1,159 @@ +|Build Status| |Code Health| |Code Coverage| + +python-constraint +================= + +Introduction +------------ +The Python constraint module offers solvers for `Constraint Satisfaction Problems (CSPs) `_ over finite domains in simple and pure Python. CSP is class of problems which may be represented in terms of variables (a, b, ...), domains (a in [1, 2, 3], ...), and constraints (a < b, ...). + +Examples +-------- + +Basics +~~~~~~ + +This interactive Python session demonstrates the module basic operation: + +.. code-block:: python + + >>> from constraint import * + >>> problem = Problem() + >>> problem.addVariable("a", [1,2,3]) + >>> problem.addVariable("b", [4,5,6]) + >>> problem.getSolutions() + [{'a': 3, 'b': 6}, {'a': 3, 'b': 5}, {'a': 3, 'b': 4}, + {'a': 2, 'b': 6}, {'a': 2, 'b': 5}, {'a': 2, 'b': 4}, + {'a': 1, 'b': 6}, {'a': 1, 'b': 5}, {'a': 1, 'b': 4}] + + >>> problem.addConstraint(lambda a, b: a*2 == b, + ("a", "b")) + >>> problem.getSolutions() + [{'a': 3, 'b': 6}, {'a': 2, 'b': 4}] + + >>> problem = Problem() + >>> problem.addVariables(["a", "b"], [1, 2, 3]) + >>> problem.addConstraint(AllDifferentConstraint()) + >>> problem.getSolutions() + [{'a': 3, 'b': 2}, {'a': 3, 'b': 1}, {'a': 2, 'b': 3}, + {'a': 2, 'b': 1}, {'a': 1, 'b': 2}, {'a': 1, 'b': 3}] + +Rooks problem +~~~~~~~~~~~~~ + +The following example solves the classical Eight Rooks problem: + +.. code-block:: python + + >>> problem = Problem() + >>> numpieces = 8 + >>> cols = range(numpieces) + >>> rows = range(numpieces) + >>> problem.addVariables(cols, rows) + >>> for col1 in cols: + ... for col2 in cols: + ... if col1 < col2: + ... problem.addConstraint(lambda row1, row2: row1 != row2, + ... (col1, col2)) + >>> solutions = problem.getSolutions() + >>> solutions + >>> solutions + [{0: 7, 1: 6, 2: 5, 3: 4, 4: 3, 5: 2, 6: 1, 7: 0}, + {0: 7, 1: 6, 2: 5, 3: 4, 4: 3, 5: 2, 6: 0, 7: 1}, + {0: 7, 1: 6, 2: 5, 3: 4, 4: 3, 5: 1, 6: 2, 7: 0}, + {0: 7, 1: 6, 2: 5, 3: 4, 4: 3, 5: 1, 6: 0, 7: 2}, + ... + {0: 7, 1: 5, 2: 3, 3: 6, 4: 2, 5: 1, 6: 4, 7: 0}, + {0: 7, 1: 5, 2: 3, 3: 6, 4: 1, 5: 2, 6: 0, 7: 4}, + {0: 7, 1: 5, 2: 3, 3: 6, 4: 1, 5: 2, 6: 4, 7: 0}, + {0: 7, 1: 5, 2: 3, 3: 6, 4: 1, 5: 4, 6: 2, 7: 0}, + {0: 7, 1: 5, 2: 3, 3: 6, 4: 1, 5: 4, 6: 0, 7: 2}, + ...] + + +Magic squares +~~~~~~~~~~~~~ + +This example solves a 4x4 magic square: + +.. code-block:: python + + >>> problem = Problem() + >>> problem.addVariables(range(0, 16), range(1, 16 + 1)) + >>> problem.addConstraint(AllDifferentConstraint(), range(0, 16)) + >>> problem.addConstraint(ExactSumConstraint(34), [0, 5, 10, 15]) + >>> problem.addConstraint(ExactSumConstraint(34), [3, 6, 9, 12]) + >>> for row in range(4): + ... problem.addConstraint(ExactSumConstraint(34), + [row * 4 + i for i in range(4)]) + >>> for col in range(4): + ... problem.addConstraint(ExactSumConstraint(34), + [col + 4 * i for i in range(4)]) + >>> solutions = problem.getSolutions() + +Features +-------- + +The following solvers are available: + +- Backtracking solver +- Recursive backtracking solver +- Minimum conflicts solver + + +.. role:: python(code) + :language: python + +Predefined constraint types currently available: + +- :python:`FunctionConstraint` +- :python:`AllDifferentConstraint` +- :python:`AllEqualConstraint` +- :python:`ExactSumConstraint` +- :python:`MaxSumConstraint` +- :python:`MinSumConstraint` +- :python:`InSetConstraint` +- :python:`NotInSetConstraint` +- :python:`SomeInSetConstraint` +- :python:`SomeNotInSetConstraint` + +API documentation +----------------- +Documentation for the module is available at: http://labix.org/doc/constraint/ + +Download and install +-------------------- + +.. code-block:: shell + + $ pip install python-constraint + +Roadmap +------- + +This GitHub organization and repository is a global effort to help to +maintain python-constraint which was written by Gustavo Niemeyer +and originaly located at https://labix.org/python-constraint + +- Create some unit tests - DONE +- Enable continuous integration - DONE +- Port to Python 3 (Python 2 being also supported) - DONE +- Respect Style Guide for Python Code (PEP8) - DONE +- Improve code coverage writting more unit tests - ToDo +- Move doc to Sphinx or MkDocs - https://readthedocs.org/ - ToDo + +Contact +------- +- `Gustavo Niemeyer `_ +- `Sébastien Celles `_ + +But it's probably better to `open an issue `_. + + +.. |Build Status| image:: https://travis-ci.org/python-constraint/python-constraint.svg?branch=master + :target: https://travis-ci.org/python-constraint/python-constraint +.. |Code Health| image:: https://landscape.io/github/python-constraint/python-constraint/master/landscape.svg?style=flat + :target: https://landscape.io/github/python-constraint/python-constraint/master + :alt: Code Health +.. |Code Coverage| image:: https://coveralls.io/repos/github/python-constraint/python-constraint/badge.svg + :target: https://coveralls.io/github/python-constraint/python-constraint diff --git a/csp/port2/python-constraint-master/constraint/__init__.py b/csp/port2/python-constraint-master/constraint/__init__.py new file mode 100755 index 00000000..7932aa33 --- /dev/null +++ b/csp/port2/python-constraint-master/constraint/__init__.py @@ -0,0 +1,1461 @@ +#!/usr/bin/python +# +# Copyright (c) 2005-2014 - Gustavo Niemeyer +# +# All rights reserved. +# +# Redistribution and use in source and binary forms, with or without +# modification, are permitted provided that the following conditions are met: +# +# 1. Redistributions of source code must retain the above copyright notice, this +# list of conditions and the following disclaimer. +# 2. Redistributions in binary form must reproduce the above copyright notice, +# this list of conditions and the following disclaimer in the documentation +# and/or other materials provided with the distribution. +# +# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +# AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE +# DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE +# FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +# DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +# SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +# CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +# OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +# OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. +""" +@var Unassigned: Helper object instance representing unassigned values + +@sort: Problem, Variable, Domain +@group Solvers: Solver, + BacktrackingSolver, + RecursiveBacktrackingSolver, + MinConflictsSolver +@group Constraints: Constraint, + FunctionConstraint, + AllDifferentConstraint, + AllEqualConstraint, + MaxSumConstraint, + ExactSumConstraint, + MinSumConstraint, + InSetConstraint, + NotInSetConstraint, + SomeInSetConstraint, + SomeNotInSetConstraint +""" + +from __future__ import absolute_import, division, print_function + + +from .version import (__author__, __copyright__, __credits__, __license__, # noqa + __version__, __email__, __status__, __url__) # noqa + +import random +import copy +from .compat import xrange + +__all__ = ["Problem", "Variable", "Domain", "Unassigned", + "Solver", "BacktrackingSolver", "RecursiveBacktrackingSolver", + "MinConflictsSolver", "Constraint", "FunctionConstraint", + "AllDifferentConstraint", "AllEqualConstraint", "MaxSumConstraint", + "ExactSumConstraint", "MinSumConstraint", "InSetConstraint", + "NotInSetConstraint", "SomeInSetConstraint", + "SomeNotInSetConstraint"] + + +class Problem(object): + """ + Class used to define a problem and retrieve solutions + """ + + def __init__(self, solver=None): + """ + @param solver: Problem solver used to find solutions + (default is L{BacktrackingSolver}) + @type solver: instance of a L{Solver} subclass + """ + self._solver = solver or BacktrackingSolver() + self._constraints = [] + self._variables = {} + + def reset(self): + """ + Reset the current problem definition + + Example: + + >>> problem = Problem() + >>> problem.addVariable("a", [1, 2]) + >>> problem.reset() + >>> problem.getSolution() + >>> + """ + del self._constraints[:] + self._variables.clear() + + def setSolver(self, solver): + """ + Change the problem solver currently in use + + Example: + + >>> solver = BacktrackingSolver() + >>> problem = Problem(solver) + >>> problem.getSolver() is solver + True + + @param solver: New problem solver + @type solver: instance of a C{Solver} subclass + """ + self._solver = solver + + def getSolver(self): + """ + Obtain the problem solver currently in use + + Example: + + >>> solver = BacktrackingSolver() + >>> problem = Problem(solver) + >>> problem.getSolver() is solver + True + + @return: Solver currently in use + @rtype: instance of a L{Solver} subclass + """ + return self._solver + + def addVariable(self, variable, domain): + """ + Add a variable to the problem + + Example: + + >>> problem = Problem() + >>> problem.addVariable("a", [1, 2]) + >>> problem.getSolution() in ({'a': 1}, {'a': 2}) + True + + @param variable: Object representing a problem variable + @type variable: hashable object + @param domain: Set of items defining the possible values that + the given variable may assume + @type domain: list, tuple, or instance of C{Domain} + """ + if variable in self._variables: + msg = "Tried to insert duplicated variable %s" % repr(variable) + raise ValueError(msg) + if hasattr(domain, '__getitem__'): + domain = Domain(domain) + elif isinstance(domain, Domain): + domain = copy.copy(domain) + else: + msg = "Domains must be instances of subclasses of the Domain class" + raise TypeError(msg) + if not domain: + raise ValueError("Domain is empty") + self._variables[variable] = domain + + def addVariables(self, variables, domain): + """ + Add one or more variables to the problem + + Example: + + >>> problem = Problem() + >>> problem.addVariables(["a", "b"], [1, 2, 3]) + >>> solutions = problem.getSolutions() + >>> len(solutions) + 9 + >>> {'a': 3, 'b': 1} in solutions + True + + @param variables: Any object containing a sequence of objects + represeting problem variables + @type variables: sequence of hashable objects + @param domain: Set of items defining the possible values that + the given variables may assume + @type domain: list, tuple, or instance of C{Domain} + """ + for variable in variables: + self.addVariable(variable, domain) + + def addConstraint(self, constraint, variables=None): + """ + Add a constraint to the problem + + Example: + + >>> problem = Problem() + >>> problem.addVariables(["a", "b"], [1, 2, 3]) + >>> problem.addConstraint(lambda a, b: b == a+1, ["a", "b"]) + >>> solutions = problem.getSolutions() + >>> + + @param constraint: Constraint to be included in the problem + @type constraint: instance a L{Constraint} subclass or a + function to be wrapped by L{FunctionConstraint} + @param variables: Variables affected by the constraint (default to + all variables). Depending on the constraint type + the order may be important. + @type variables: set or sequence of variables + """ + if not isinstance(constraint, Constraint): + if callable(constraint): + constraint = FunctionConstraint(constraint) + else: + msg = "Constraints must be instances of subclasses "\ + "of the Constraint class" + raise ValueError(msg) + self._constraints.append((constraint, variables)) + + def getSolution(self): + """ + Find and return a solution to the problem + + Example: + + >>> problem = Problem() + >>> problem.getSolution() is None + True + >>> problem.addVariables(["a"], [42]) + >>> problem.getSolution() + {'a': 42} + + @return: Solution for the problem + @rtype: dictionary mapping variables to values + """ + domains, constraints, vconstraints = self._getArgs() + if not domains: + return None + return self._solver.getSolution(domains, constraints, vconstraints) + + def getSolutions(self): + """ + Find and return all solutions to the problem + + Example: + + >>> problem = Problem() + >>> problem.getSolutions() == [] + True + >>> problem.addVariables(["a"], [42]) + >>> problem.getSolutions() + [{'a': 42}] + + @return: All solutions for the problem + @rtype: list of dictionaries mapping variables to values + """ + domains, constraints, vconstraints = self._getArgs() + if not domains: + return [] + return self._solver.getSolutions(domains, constraints, vconstraints) + + def getSolutionIter(self): + """ + Return an iterator to the solutions of the problem + + Example: + + >>> problem = Problem() + >>> list(problem.getSolutionIter()) == [] + True + >>> problem.addVariables(["a"], [42]) + >>> iter = problem.getSolutionIter() + >>> next(iter) + {'a': 42} + >>> next(iter) + Traceback (most recent call last): + File "", line 1, in ? + StopIteration + """ + domains, constraints, vconstraints = self._getArgs() + if not domains: + return iter(()) + return self._solver.getSolutionIter(domains, constraints, + vconstraints) + + def _getArgs(self): + domains = self._variables.copy() + allvariables = domains.keys() + constraints = [] + for constraint, variables in self._constraints: + if not variables: + variables = list(allvariables) + constraints.append((constraint, variables)) + vconstraints = {} + for variable in domains: + vconstraints[variable] = [] + for constraint, variables in constraints: + for variable in variables: + vconstraints[variable].append((constraint, variables)) + for constraint, variables in constraints[:]: + constraint.preProcess(variables, domains, + constraints, vconstraints) + for domain in domains.values(): + domain.resetState() + if not domain: + return None, None, None + # doArc8(getArcs(domains, constraints), domains, {}) + return domains, constraints, vconstraints + +# ---------------------------------------------------------------------- +# Solvers +# ---------------------------------------------------------------------- + + +def getArcs(domains, constraints): + """ + Return a dictionary mapping pairs (arcs) of constrained variables + + @attention: Currently unused. + """ + arcs = {} + for x in constraints: + constraint, variables = x + if len(variables) == 2: + variable1, variable2 = variables + arcs.setdefault(variable1, {})\ + .setdefault(variable2, [])\ + .append(x) + arcs.setdefault(variable2, {})\ + .setdefault(variable1, [])\ + .append(x) + return arcs + + +def doArc8(arcs, domains, assignments): + """ + Perform the ARC-8 arc checking algorithm and prune domains + + @attention: Currently unused. + """ + check = dict.fromkeys(domains, True) + while check: + variable, _ = check.popitem() + if variable not in arcs or variable in assignments: + continue + domain = domains[variable] + arcsvariable = arcs[variable] + for othervariable in arcsvariable: + arcconstraints = arcsvariable[othervariable] + if othervariable in assignments: + otherdomain = [assignments[othervariable]] + else: + otherdomain = domains[othervariable] + if domain: + # changed = False + for value in domain[:]: + assignments[variable] = value + if otherdomain: + for othervalue in otherdomain: + assignments[othervariable] = othervalue + for constraint, variables in arcconstraints: + if not constraint(variables, domains, + assignments, True): + break + else: + # All constraints passed. Value is safe. + break + else: + # All othervalues failed. Kill value. + domain.hideValue(value) + # changed = True + del assignments[othervariable] + del assignments[variable] + # if changed: + # check.update(dict.fromkeys(arcsvariable)) + if not domain: + return False + return True + + +class Solver(object): + """ + Abstract base class for solvers + + @sort: getSolution, getSolutions, getSolutionIter + """ + + def getSolution(self, domains, constraints, vconstraints): + """ + Return one solution for the given problem + + @param domains: Dictionary mapping variables to their domains + @type domains: dict + @param constraints: List of pairs of (constraint, variables) + @type constraints: list + @param vconstraints: Dictionary mapping variables to a list of + constraints affecting the given variables. + @type vconstraints: dict + """ + msg = "%s is an abstract class" % self.__class__.__name__ + raise NotImplementedError(msg) + + def getSolutions(self, domains, constraints, vconstraints): + """ + Return all solutions for the given problem + + @param domains: Dictionary mapping variables to domains + @type domains: dict + @param constraints: List of pairs of (constraint, variables) + @type constraints: list + @param vconstraints: Dictionary mapping variables to a list of + constraints affecting the given variables. + @type vconstraints: dict + """ + msg = "%s provides only a single solution" % self.__class__.__name__ + raise NotImplementedError(msg) + + def getSolutionIter(self, domains, constraints, vconstraints): + """ + Return an iterator for the solutions of the given problem + + @param domains: Dictionary mapping variables to domains + @type domains: dict + @param constraints: List of pairs of (constraint, variables) + @type constraints: list + @param vconstraints: Dictionary mapping variables to a list of + constraints affecting the given variables. + @type vconstraints: dict + """ + msg = "%s doesn't provide iteration" % self.__class__.__name__ + raise NotImplementedError(msg) + + +class BacktrackingSolver(Solver): + """ + Problem solver with backtracking capabilities + + Examples: + + >>> result = [[('a', 1), ('b', 2)], + ... [('a', 1), ('b', 3)], + ... [('a', 2), ('b', 3)]] + + >>> problem = Problem(BacktrackingSolver()) + >>> problem.addVariables(["a", "b"], [1, 2, 3]) + >>> problem.addConstraint(lambda a, b: b > a, ["a", "b"]) + + >>> solution = problem.getSolution() + >>> sorted(solution.items()) in result + True + + >>> for solution in problem.getSolutionIter(): + ... sorted(solution.items()) in result + True + True + True + + >>> for solution in problem.getSolutions(): + ... sorted(solution.items()) in result + True + True + True + """ + + def __init__(self, forwardcheck=True): + """ + @param forwardcheck: If false forward checking will not be requested + to constraints while looking for solutions + (default is true) + @type forwardcheck: bool + """ + self._forwardcheck = forwardcheck + + def getSolutionIter(self, domains, constraints, vconstraints): + forwardcheck = self._forwardcheck + assignments = {} + + queue = [] + + while True: + + # Mix the Degree and Minimum Remaing Values (MRV) heuristics + lst = [(-len(vconstraints[variable]), + len(domains[variable]), variable) for variable in domains] + lst.sort() + for item in lst: + if item[-1] not in assignments: + # Found unassigned variable + variable = item[-1] + values = domains[variable][:] + if forwardcheck: + pushdomains = [domains[x] for x in domains + if x not in assignments and x != variable] + else: + pushdomains = None + break + else: + # No unassigned variables. We've got a solution. Go back + # to last variable, if there's one. + yield assignments.copy() + if not queue: + return + variable, values, pushdomains = queue.pop() + if pushdomains: + for domain in pushdomains: + domain.popState() + + while True: + # We have a variable. Do we have any values left? + if not values: + # No. Go back to last variable, if there's one. + del assignments[variable] + while queue: + variable, values, pushdomains = queue.pop() + if pushdomains: + for domain in pushdomains: + domain.popState() + if values: + break + del assignments[variable] + else: + return + + # Got a value. Check it. + assignments[variable] = values.pop() + + if pushdomains: + for domain in pushdomains: + domain.pushState() + + for constraint, variables in vconstraints[variable]: + if not constraint(variables, domains, assignments, + pushdomains): + # Value is not good. + break + else: + break + + if pushdomains: + for domain in pushdomains: + domain.popState() + + # Push state before looking for next variable. + queue.append((variable, values, pushdomains)) + + raise RuntimeError("Can't happen") + + def getSolution(self, domains, constraints, vconstraints): + iter = self.getSolutionIter(domains, constraints, vconstraints) + try: + return next(iter) + except StopIteration: + return None + + def getSolutions(self, domains, constraints, vconstraints): + return list(self.getSolutionIter(domains, constraints, vconstraints)) + + +class RecursiveBacktrackingSolver(Solver): + """ + Recursive problem solver with backtracking capabilities + + Examples: + + >>> result = [[('a', 1), ('b', 2)], + ... [('a', 1), ('b', 3)], + ... [('a', 2), ('b', 3)]] + + >>> problem = Problem(RecursiveBacktrackingSolver()) + >>> problem.addVariables(["a", "b"], [1, 2, 3]) + >>> problem.addConstraint(lambda a, b: b > a, ["a", "b"]) + + >>> solution = problem.getSolution() + >>> sorted(solution.items()) in result + True + + >>> for solution in problem.getSolutions(): + ... sorted(solution.items()) in result + True + True + True + + >>> problem.getSolutionIter() + Traceback (most recent call last): + ... + NotImplementedError: RecursiveBacktrackingSolver doesn't provide iteration + """ + + def __init__(self, forwardcheck=True): + """ + @param forwardcheck: If false forward checking will not be requested + to constraints while looking for solutions + (default is true) + @type forwardcheck: bool + """ + self._forwardcheck = forwardcheck + + def recursiveBacktracking(self, solutions, domains, vconstraints, + assignments, single): + + # Mix the Degree and Minimum Remaing Values (MRV) heuristics + lst = [(-len(vconstraints[variable]), + len(domains[variable]), variable) for variable in domains] + lst.sort() + for item in lst: + if item[-1] not in assignments: + # Found an unassigned variable. Let's go. + break + else: + # No unassigned variables. We've got a solution. + solutions.append(assignments.copy()) + return solutions + + variable = item[-1] + assignments[variable] = None + + forwardcheck = self._forwardcheck + if forwardcheck: + pushdomains = [domains[x] for x in domains if x not in assignments] + else: + pushdomains = None + + for value in domains[variable]: + assignments[variable] = value + if pushdomains: + for domain in pushdomains: + domain.pushState() + for constraint, variables in vconstraints[variable]: + if not constraint(variables, domains, assignments, + pushdomains): + # Value is not good. + break + else: + # Value is good. Recurse and get next variable. + self.recursiveBacktracking(solutions, domains, vconstraints, + assignments, single) + if solutions and single: + return solutions + if pushdomains: + for domain in pushdomains: + domain.popState() + del assignments[variable] + return solutions + + def getSolution(self, domains, constraints, vconstraints): + solutions = self.recursiveBacktracking([], domains, vconstraints, + {}, True) + return solutions and solutions[0] or None + + def getSolutions(self, domains, constraints, vconstraints): + return self.recursiveBacktracking([], domains, vconstraints, + {}, False) + + +class MinConflictsSolver(Solver): + """ + Problem solver based on the minimum conflicts theory + + Examples: + + >>> result = [[('a', 1), ('b', 2)], + ... [('a', 1), ('b', 3)], + ... [('a', 2), ('b', 3)]] + + >>> problem = Problem(MinConflictsSolver()) + >>> problem.addVariables(["a", "b"], [1, 2, 3]) + >>> problem.addConstraint(lambda a, b: b > a, ["a", "b"]) + + >>> solution = problem.getSolution() + >>> sorted(solution.items()) in result + True + + >>> problem.getSolutions() + Traceback (most recent call last): + ... + NotImplementedError: MinConflictsSolver provides only a single solution + + >>> problem.getSolutionIter() + Traceback (most recent call last): + ... + NotImplementedError: MinConflictsSolver doesn't provide iteration + """ + + def __init__(self, steps=1000): + """ + @param steps: Maximum number of steps to perform before giving up + when looking for a solution (default is 1000) + @type steps: int + """ + self._steps = steps + + def getSolution(self, domains, constraints, vconstraints): + assignments = {} + # Initial assignment + for variable in domains: + assignments[variable] = random.choice(domains[variable]) + for _ in xrange(self._steps): + conflicted = False + lst = list(domains.keys()) + random.shuffle(lst) + for variable in lst: + # Check if variable is not in conflict + for constraint, variables in vconstraints[variable]: + if not constraint(variables, domains, assignments): + break + else: + continue + # Variable has conflicts. Find values with less conflicts. + mincount = len(vconstraints[variable]) + minvalues = [] + for value in domains[variable]: + assignments[variable] = value + count = 0 + for constraint, variables in vconstraints[variable]: + if not constraint(variables, domains, assignments): + count += 1 + if count == mincount: + minvalues.append(value) + elif count < mincount: + mincount = count + del minvalues[:] + minvalues.append(value) + # Pick a random one from these values. + assignments[variable] = random.choice(minvalues) + conflicted = True + if not conflicted: + return assignments + return None + +# ---------------------------------------------------------------------- +# Variables +# ---------------------------------------------------------------------- + + +class Variable(object): + """ + Helper class for variable definition + + Using this class is optional, since any hashable object, + including plain strings and integers, may be used as variables. + """ + + def __init__(self, name): + """ + @param name: Generic variable name for problem-specific purposes + @type name: string + """ + self.name = name + + def __repr__(self): + return self.name + + +Unassigned = Variable("Unassigned") + +# ---------------------------------------------------------------------- +# Domains +# ---------------------------------------------------------------------- + + +class Domain(list): + """ + Class used to control possible values for variables + + When list or tuples are used as domains, they are automatically + converted to an instance of that class. + """ + + def __init__(self, set): + """ + @param set: Set of values that the given variables may assume + @type set: set of objects comparable by equality + """ + list.__init__(self, set) + self._hidden = [] + self._states = [] + + def resetState(self): + """ + Reset to the original domain state, including all possible values + """ + self.extend(self._hidden) + del self._hidden[:] + del self._states[:] + + def pushState(self): + """ + Save current domain state + + Variables hidden after that call are restored when that state + is popped from the stack. + """ + self._states.append(len(self)) + + def popState(self): + """ + Restore domain state from the top of the stack + + Variables hidden since the last popped state are then available + again. + """ + diff = self._states.pop() - len(self) + if diff: + self.extend(self._hidden[-diff:]) + del self._hidden[-diff:] + + def hideValue(self, value): + """ + Hide the given value from the domain + + After that call the given value won't be seen as a possible value + on that domain anymore. The hidden value will be restored when the + previous saved state is popped. + + @param value: Object currently available in the domain + """ + list.remove(self, value) + self._hidden.append(value) + +# ---------------------------------------------------------------------- +# Constraints +# ---------------------------------------------------------------------- + + +class Constraint(object): + """ + Abstract base class for constraints + """ + + def __call__(self, variables, domains, assignments, forwardcheck=False): + """ + Perform the constraint checking + + If the forwardcheck parameter is not false, besides telling if + the constraint is currently broken or not, the constraint + implementation may choose to hide values from the domains of + unassigned variables to prevent them from being used, and thus + prune the search space. + + @param variables: Variables affected by that constraint, in the + same order provided by the user + @type variables: sequence + @param domains: Dictionary mapping variables to their domains + @type domains: dict + @param assignments: Dictionary mapping assigned variables to their + current assumed value + @type assignments: dict + @param forwardcheck: Boolean value stating whether forward checking + should be performed or not + @return: Boolean value stating if this constraint is currently + broken or not + @rtype: bool + """ + return True + + def preProcess(self, variables, domains, constraints, vconstraints): + """ + Preprocess variable domains + + This method is called before starting to look for solutions, + and is used to prune domains with specific constraint logic + when possible. For instance, any constraints with a single + variable may be applied on all possible values and removed, + since they may act on individual values even without further + knowledge about other assignments. + + @param variables: Variables affected by that constraint, in the + same order provided by the user + @type variables: sequence + @param domains: Dictionary mapping variables to their domains + @type domains: dict + @param constraints: List of pairs of (constraint, variables) + @type constraints: list + @param vconstraints: Dictionary mapping variables to a list of + constraints affecting the given variables. + @type vconstraints: dict + """ + if len(variables) == 1: + variable = variables[0] + domain = domains[variable] + for value in domain[:]: + if not self(variables, domains, {variable: value}): + domain.remove(value) + constraints.remove((self, variables)) + vconstraints[variable].remove((self, variables)) + + def forwardCheck(self, variables, domains, assignments, + _unassigned=Unassigned): + """ + Helper method for generic forward checking + + Currently, this method acts only when there's a single + unassigned variable. + + @param variables: Variables affected by that constraint, in the + same order provided by the user + @type variables: sequence + @param domains: Dictionary mapping variables to their domains + @type domains: dict + @param assignments: Dictionary mapping assigned variables to their + current assumed value + @type assignments: dict + @return: Boolean value stating if this constraint is currently + broken or not + @rtype: bool + """ + unassignedvariable = _unassigned + for variable in variables: + if variable not in assignments: + if unassignedvariable is _unassigned: + unassignedvariable = variable + else: + break + else: + if unassignedvariable is not _unassigned: + # Remove from the unassigned variable domain's all + # values which break our variable's constraints. + domain = domains[unassignedvariable] + if domain: + for value in domain[:]: + assignments[unassignedvariable] = value + if not self(variables, domains, assignments): + domain.hideValue(value) + del assignments[unassignedvariable] + if not domain: + return False + return True + + +class FunctionConstraint(Constraint): + """ + Constraint which wraps a function defining the constraint logic + + Examples: + + >>> problem = Problem() + >>> problem.addVariables(["a", "b"], [1, 2]) + >>> def func(a, b): + ... return b > a + >>> problem.addConstraint(func, ["a", "b"]) + >>> problem.getSolution() + {'a': 1, 'b': 2} + + >>> problem = Problem() + >>> problem.addVariables(["a", "b"], [1, 2]) + >>> def func(a, b): + ... return b > a + >>> problem.addConstraint(FunctionConstraint(func), ["a", "b"]) + >>> problem.getSolution() + {'a': 1, 'b': 2} + """ + + def __init__(self, func, assigned=True): + """ + @param func: Function wrapped and queried for constraint logic + @type func: callable object + @param assigned: Whether the function may receive unassigned + variables or not + @type assigned: bool + """ + self._func = func + self._assigned = assigned + + def __call__(self, variables, domains, assignments, forwardcheck=False, + _unassigned=Unassigned): + parms = [assignments.get(x, _unassigned) for x in variables] + missing = parms.count(_unassigned) + if missing: + return ((self._assigned or self._func(*parms)) and + (not forwardcheck or missing != 1 or + self.forwardCheck(variables, domains, assignments))) + return self._func(*parms) + + +class AllDifferentConstraint(Constraint): + """ + Constraint enforcing that values of all given variables are different + + Example: + + >>> problem = Problem() + >>> problem.addVariables(["a", "b"], [1, 2]) + >>> problem.addConstraint(AllDifferentConstraint()) + >>> sorted(sorted(x.items()) for x in problem.getSolutions()) + [[('a', 1), ('b', 2)], [('a', 2), ('b', 1)]] + """ + + def __call__(self, variables, domains, assignments, forwardcheck=False, + _unassigned=Unassigned): + seen = {} + for variable in variables: + value = assignments.get(variable, _unassigned) + if value is not _unassigned: + if value in seen: + return False + seen[value] = True + if forwardcheck: + for variable in variables: + if variable not in assignments: + domain = domains[variable] + for value in seen: + if value in domain: + domain.hideValue(value) + if not domain: + return False + return True + + +class AllEqualConstraint(Constraint): + """ + Constraint enforcing that values of all given variables are equal + + Example: + + >>> problem = Problem() + >>> problem.addVariables(["a", "b"], [1, 2]) + >>> problem.addConstraint(AllEqualConstraint()) + >>> sorted(sorted(x.items()) for x in problem.getSolutions()) + [[('a', 1), ('b', 1)], [('a', 2), ('b', 2)]] + """ + + def __call__(self, variables, domains, assignments, forwardcheck=False, + _unassigned=Unassigned): + singlevalue = _unassigned + for variable in variables: + value = assignments.get(variable, _unassigned) + if singlevalue is _unassigned: + singlevalue = value + elif value is not _unassigned and value != singlevalue: + return False + if forwardcheck and singlevalue is not _unassigned: + for variable in variables: + if variable not in assignments: + domain = domains[variable] + if singlevalue not in domain: + return False + for value in domain[:]: + if value != singlevalue: + domain.hideValue(value) + return True + + +class MaxSumConstraint(Constraint): + """ + Constraint enforcing that values of given variables sum up to + a given amount + + Example: + + >>> problem = Problem() + >>> problem.addVariables(["a", "b"], [1, 2]) + >>> problem.addConstraint(MaxSumConstraint(3)) + >>> sorted(sorted(x.items()) for x in problem.getSolutions()) + [[('a', 1), ('b', 1)], [('a', 1), ('b', 2)], [('a', 2), ('b', 1)]] + """ + + def __init__(self, maxsum, multipliers=None): + """ + @param maxsum: Value to be considered as the maximum sum + @type maxsum: number + @param multipliers: If given, variable values will be multiplied by + the given factors before being summed to be checked + @type multipliers: sequence of numbers + """ + self._maxsum = maxsum + self._multipliers = multipliers + + def preProcess(self, variables, domains, constraints, vconstraints): + Constraint.preProcess(self, variables, domains, + constraints, vconstraints) + multipliers = self._multipliers + maxsum = self._maxsum + if multipliers: + for variable, multiplier in zip(variables, multipliers): + domain = domains[variable] + for value in domain[:]: + if value * multiplier > maxsum: + domain.remove(value) + else: + for variable in variables: + domain = domains[variable] + for value in domain[:]: + if value > maxsum: + domain.remove(value) + + def __call__(self, variables, domains, assignments, forwardcheck=False): + multipliers = self._multipliers + maxsum = self._maxsum + sum = 0 + if multipliers: + for variable, multiplier in zip(variables, multipliers): + if variable in assignments: + sum += assignments[variable] * multiplier + if type(sum) is float: + sum = round(sum, 10) + if sum > maxsum: + return False + if forwardcheck: + for variable, multiplier in zip(variables, multipliers): + if variable not in assignments: + domain = domains[variable] + for value in domain[:]: + if sum + value * multiplier > maxsum: + domain.hideValue(value) + if not domain: + return False + else: + for variable in variables: + if variable in assignments: + sum += assignments[variable] + if type(sum) is float: + sum = round(sum, 10) + if sum > maxsum: + return False + if forwardcheck: + for variable in variables: + if variable not in assignments: + domain = domains[variable] + for value in domain[:]: + if sum + value > maxsum: + domain.hideValue(value) + if not domain: + return False + return True + + +class ExactSumConstraint(Constraint): + """ + Constraint enforcing that values of given variables sum exactly + to a given amount + + Example: + + >>> problem = Problem() + >>> problem.addVariables(["a", "b"], [1, 2]) + >>> problem.addConstraint(ExactSumConstraint(3)) + >>> sorted(sorted(x.items()) for x in problem.getSolutions()) + [[('a', 1), ('b', 2)], [('a', 2), ('b', 1)]] + """ + + def __init__(self, exactsum, multipliers=None): + """ + @param exactsum: Value to be considered as the exact sum + @type exactsum: number + @param multipliers: If given, variable values will be multiplied by + the given factors before being summed to be checked + @type multipliers: sequence of numbers + """ + self._exactsum = exactsum + self._multipliers = multipliers + + def preProcess(self, variables, domains, constraints, vconstraints): + Constraint.preProcess(self, variables, domains, + constraints, vconstraints) + multipliers = self._multipliers + exactsum = self._exactsum + if multipliers: + for variable, multiplier in zip(variables, multipliers): + domain = domains[variable] + for value in domain[:]: + if value * multiplier > exactsum: + domain.remove(value) + else: + for variable in variables: + domain = domains[variable] + for value in domain[:]: + if value > exactsum: + domain.remove(value) + + def __call__(self, variables, domains, assignments, forwardcheck=False): + multipliers = self._multipliers + exactsum = self._exactsum + sum = 0 + missing = False + if multipliers: + for variable, multiplier in zip(variables, multipliers): + if variable in assignments: + sum += assignments[variable] * multiplier + else: + missing = True + if type(sum) is float: + sum = round(sum, 10) + if sum > exactsum: + return False + if forwardcheck and missing: + for variable, multiplier in zip(variables, multipliers): + if variable not in assignments: + domain = domains[variable] + for value in domain[:]: + if sum + value * multiplier > exactsum: + domain.hideValue(value) + if not domain: + return False + else: + for variable in variables: + if variable in assignments: + sum += assignments[variable] + else: + missing = True + if type(sum) is float: + sum = round(sum, 10) + if sum > exactsum: + return False + if forwardcheck and missing: + for variable in variables: + if variable not in assignments: + domain = domains[variable] + for value in domain[:]: + if sum + value > exactsum: + domain.hideValue(value) + if not domain: + return False + if missing: + return sum <= exactsum + else: + return sum == exactsum + + +class MinSumConstraint(Constraint): + """ + Constraint enforcing that values of given variables sum at least + to a given amount + + Example: + + >>> problem = Problem() + >>> problem.addVariables(["a", "b"], [1, 2]) + >>> problem.addConstraint(MinSumConstraint(3)) + >>> sorted(sorted(x.items()) for x in problem.getSolutions()) + [[('a', 1), ('b', 2)], [('a', 2), ('b', 1)], [('a', 2), ('b', 2)]] + """ + + def __init__(self, minsum, multipliers=None): + """ + @param minsum: Value to be considered as the minimum sum + @type minsum: number + @param multipliers: If given, variable values will be multiplied by + the given factors before being summed to be checked + @type multipliers: sequence of numbers + """ + self._minsum = minsum + self._multipliers = multipliers + + def __call__(self, variables, domains, assignments, forwardcheck=False): + for variable in variables: + if variable not in assignments: + return True + else: + multipliers = self._multipliers + minsum = self._minsum + sum = 0 + if multipliers: + for variable, multiplier in zip(variables, multipliers): + sum += assignments[variable] * multiplier + else: + for variable in variables: + sum += assignments[variable] + if type(sum) is float: + sum = round(sum, 10) + return sum >= minsum + + +class InSetConstraint(Constraint): + """ + Constraint enforcing that values of given variables are present in + the given set + + Example: + + >>> problem = Problem() + >>> problem.addVariables(["a", "b"], [1, 2]) + >>> problem.addConstraint(InSetConstraint([1])) + >>> sorted(sorted(x.items()) for x in problem.getSolutions()) + [[('a', 1), ('b', 1)]] + """ + + def __init__(self, set): + """ + @param set: Set of allowed values + @type set: set + """ + self._set = set + + def __call__(self, variables, domains, assignments, forwardcheck=False): + # preProcess() will remove it. + raise RuntimeError("Can't happen") + + def preProcess(self, variables, domains, constraints, vconstraints): + set = self._set + for variable in variables: + domain = domains[variable] + for value in domain[:]: + if value not in set: + domain.remove(value) + vconstraints[variable].remove((self, variables)) + constraints.remove((self, variables)) + + +class NotInSetConstraint(Constraint): + """ + Constraint enforcing that values of given variables are not present in + the given set + + Example: + + >>> problem = Problem() + >>> problem.addVariables(["a", "b"], [1, 2]) + >>> problem.addConstraint(NotInSetConstraint([1])) + >>> sorted(sorted(x.items()) for x in problem.getSolutions()) + [[('a', 2), ('b', 2)]] + """ + + def __init__(self, set): + """ + @param set: Set of disallowed values + @type set: set + """ + self._set = set + + def __call__(self, variables, domains, assignments, forwardcheck=False): + # preProcess() will remove it. + raise RuntimeError("Can't happen") + + def preProcess(self, variables, domains, constraints, vconstraints): + set = self._set + for variable in variables: + domain = domains[variable] + for value in domain[:]: + if value in set: + domain.remove(value) + vconstraints[variable].remove((self, variables)) + constraints.remove((self, variables)) + + +class SomeInSetConstraint(Constraint): + """ + Constraint enforcing that at least some of the values of given + variables must be present in a given set + + Example: + + >>> problem = Problem() + >>> problem.addVariables(["a", "b"], [1, 2]) + >>> problem.addConstraint(SomeInSetConstraint([1])) + >>> sorted(sorted(x.items()) for x in problem.getSolutions()) + [[('a', 1), ('b', 1)], [('a', 1), ('b', 2)], [('a', 2), ('b', 1)]] + """ + + def __init__(self, set, n=1, exact=False): + """ + @param set: Set of values to be checked + @type set: set + @param n: Minimum number of assigned values that should be present + in set (default is 1) + @type n: int + @param exact: Whether the number of assigned values which are + present in set must be exactly C{n} + @type exact: bool + """ + self._set = set + self._n = n + self._exact = exact + + def __call__(self, variables, domains, assignments, forwardcheck=False): + set = self._set + missing = 0 + found = 0 + for variable in variables: + if variable in assignments: + found += assignments[variable] in set + else: + missing += 1 + if missing: + if self._exact: + if not (found <= self._n <= missing + found): + return False + else: + if self._n > missing + found: + return False + if forwardcheck and self._n - found == missing: + # All unassigned variables must be assigned to + # values in the set. + for variable in variables: + if variable not in assignments: + domain = domains[variable] + for value in domain[:]: + if value not in set: + domain.hideValue(value) + if not domain: + return False + else: + if self._exact: + if found != self._n: + return False + else: + if found < self._n: + return False + return True + + +class SomeNotInSetConstraint(Constraint): + """ + Constraint enforcing that at least some of the values of given + variables must not be present in a given set + + Example: + + >>> problem = Problem() + >>> problem.addVariables(["a", "b"], [1, 2]) + >>> problem.addConstraint(SomeNotInSetConstraint([1])) + >>> sorted(sorted(x.items()) for x in problem.getSolutions()) + [[('a', 1), ('b', 2)], [('a', 2), ('b', 1)], [('a', 2), ('b', 2)]] + """ + + def __init__(self, set, n=1, exact=False): + """ + @param set: Set of values to be checked + @type set: set + @param n: Minimum number of assigned values that should not be present + in set (default is 1) + @type n: int + @param exact: Whether the number of assigned values which are + not present in set must be exactly C{n} + @type exact: bool + """ + self._set = set + self._n = n + self._exact = exact + + def __call__(self, variables, domains, assignments, forwardcheck=False): + set = self._set + missing = 0 + found = 0 + for variable in variables: + if variable in assignments: + found += assignments[variable] not in set + else: + missing += 1 + if missing: + if self._exact: + if not (found <= self._n <= missing + found): + return False + else: + if self._n > missing + found: + return False + if forwardcheck and self._n - found == missing: + # All unassigned variables must be assigned to + # values not in the set. + for variable in variables: + if variable not in assignments: + domain = domains[variable] + for value in domain[:]: + if value in set: + domain.hideValue(value) + if not domain: + return False + else: + if self._exact: + if found != self._n: + return False + else: + if found < self._n: + return False + return True + + +if __name__ == "__main__": + import doctest + doctest.testmod() diff --git a/csp/port2/python-constraint-master/constraint/compat.py b/csp/port2/python-constraint-master/constraint/compat.py new file mode 100755 index 00000000..ef31a009 --- /dev/null +++ b/csp/port2/python-constraint-master/constraint/compat.py @@ -0,0 +1,14 @@ +#!/usr/bin/env python +# -*- coding: utf-8 -*- + +import sys + +PY2 = sys.version_info[0] == 2 +PY3 = (sys.version_info[0] >= 3) + +if PY3: + string_types = str + xrange = range +else: + string_types = basestring # noqa + xrange = xrange diff --git a/csp/port2/python-constraint-master/constraint/version.py b/csp/port2/python-constraint-master/constraint/version.py new file mode 100755 index 00000000..af97862e --- /dev/null +++ b/csp/port2/python-constraint-master/constraint/version.py @@ -0,0 +1,8 @@ +__author__ = "Gustavo Niemeyer" +__copyright__ = "Copyright (c) 2005-2014 - Gustavo Niemeyer " +__credits__ = ["Sebastien Celles"] +__license__ = "" +__version__ = "1.3.1" +__email__ = "gustavo@niemeyer.net" +__status__ = "Development" +__url__ = 'https://github.com/python-constraint/python-constraint' diff --git a/csp/port2/python-constraint-master/examples/__init__.py b/csp/port2/python-constraint-master/examples/__init__.py new file mode 100755 index 00000000..e69de29b diff --git a/csp/port2/python-constraint-master/examples/abc/__init__.py b/csp/port2/python-constraint-master/examples/abc/__init__.py new file mode 100755 index 00000000..e69de29b diff --git a/csp/port2/python-constraint-master/examples/abc/abc.py b/csp/port2/python-constraint-master/examples/abc/abc.py new file mode 100755 index 00000000..27b72906 --- /dev/null +++ b/csp/port2/python-constraint-master/examples/abc/abc.py @@ -0,0 +1,37 @@ +#!/usr/bin/python +# +# What's the minimum value for: +# +# ABC +# ------- +# A+B+C +# +# From http://www.umassd.edu/mathcontest/abc.cfm +# +from constraint import Problem + + +def solve(): + problem = Problem() + problem.addVariables("abc", range(1, 10)) + problem.getSolutions() + minvalue = 999 / (9 * 3) + minsolution = {} + for solution in problem.getSolutions(): + a = solution["a"] + b = solution["b"] + c = solution["c"] + value = (a * 100 + b * 10 + c) / (a + b + c) + if value < minvalue: + minsolution = solution + return minvalue, minsolution + + +def main(): + minvalue, minsolution = solve() + print(minvalue) + print(minsolution) + + +if __name__ == "__main__": + main() diff --git a/csp/port2/python-constraint-master/examples/coins/__init__.py b/csp/port2/python-constraint-master/examples/coins/__init__.py new file mode 100755 index 00000000..e69de29b diff --git a/csp/port2/python-constraint-master/examples/coins/coins.py b/csp/port2/python-constraint-master/examples/coins/coins.py new file mode 100755 index 00000000..98c2b62d --- /dev/null +++ b/csp/port2/python-constraint-master/examples/coins/coins.py @@ -0,0 +1,36 @@ +#!/usr/bin/python +# +# 100 coins must sum to $5.00 +# +# That's kind of a country-specific problem, since depending on the +# country there are different values for coins. Here is presented +# the solution for a given set. +# +from constraint import Problem, ExactSumConstraint +import sys + + +def solve(): + problem = Problem() + total = 5.00 + variables = ("0.01", "0.05", "0.10", "0.50", "1.00") + values = [float(x) for x in variables] + for variable, value in zip(variables, values): + problem.addVariable(variable, range(int(total / value))) + problem.addConstraint(ExactSumConstraint(total, values), variables) + problem.addConstraint(ExactSumConstraint(100)) + solutions = problem.getSolutionIter() + return solutions, variables + + +def main(): + solutions, variables = solve() + for i, solution in enumerate(solutions): + sys.stdout.write("%03d -> " % (i + 1)) + for variable in variables: + sys.stdout.write("%s:%d " % (variable, solution[variable])) + sys.stdout.write("\n") + + +if __name__ == "__main__": + main() diff --git a/csp/port2/python-constraint-master/examples/crosswords/__init__.py b/csp/port2/python-constraint-master/examples/crosswords/__init__.py new file mode 100755 index 00000000..e69de29b diff --git a/csp/port2/python-constraint-master/examples/crosswords/crosswords.py b/csp/port2/python-constraint-master/examples/crosswords/crosswords.py new file mode 100755 index 00000000..df0fce61 --- /dev/null +++ b/csp/port2/python-constraint-master/examples/crosswords/crosswords.py @@ -0,0 +1,154 @@ +#!/usr/bin/python +from constraint import Problem, AllDifferentConstraint +import random +import sys + +MINLEN = 3 + + +def main(puzzle, lines): + puzzle = puzzle.rstrip().splitlines() + while puzzle and not puzzle[0]: + del puzzle[0] + + # Extract horizontal words + horizontal = [] + word = [] + predefined = {} + for row in range(len(puzzle)): + for col in range(len(puzzle[row])): + char = puzzle[row][col] + if not char.isspace(): + word.append((row, col)) + if char != "#": + predefined[row, col] = char + elif word: + if len(word) > MINLEN: + horizontal.append(word[:]) + del word[:] + if word: + if len(word) > MINLEN: + horizontal.append(word[:]) + del word[:] + + # Extract vertical words + vertical = [] + validcol = True + col = 0 + while validcol: + validcol = False + for row in range(len(puzzle)): + if col >= len(puzzle[row]): + if word: + if len(word) > MINLEN: + vertical.append(word[:]) + del word[:] + else: + validcol = True + char = puzzle[row][col] + if not char.isspace(): + word.append((row, col)) + if char != "#": + predefined[row, col] = char + elif word: + if len(word) > MINLEN: + vertical.append(word[:]) + del word[:] + if word: + if len(word) > MINLEN: + vertical.append(word[:]) + del word[:] + col += 1 + + # hnames = ["h%d" % i for i in range(len(horizontal))] + # vnames = ["v%d" % i for i in range(len(vertical))] + + # problem = Problem(MinConflictsSolver()) + problem = Problem() + + for hi, hword in enumerate(horizontal): + for vi, vword in enumerate(vertical): + for hchar in hword: + if hchar in vword: + hci = hword.index(hchar) + vci = vword.index(hchar) + problem.addConstraint(lambda hw, vw, hci=hci, vci=vci: + hw[hci] == vw[vci], + ("h%d" % hi, "v%d" % vi)) + + for char, letter in predefined.items(): + for hi, hword in enumerate(horizontal): + if char in hword: + hci = hword.index(char) + problem.addConstraint(lambda hw, hci=hci, letter=letter: + hw[hci] == letter, ("h%d" % hi,)) + for vi, vword in enumerate(vertical): + if char in vword: + vci = vword.index(char) + problem.addConstraint(lambda vw, vci=vci, letter=letter: + vw[vci] == letter, ("v%d" % vi,)) + + wordsbylen = {} + for hword in horizontal: + wordsbylen[len(hword)] = [] + for vword in vertical: + wordsbylen[len(vword)] = [] + + for line in lines: + line = line.strip() + ll = len(line) + if ll in wordsbylen: + wordsbylen[ll].append(line.upper()) + + for hi, hword in enumerate(horizontal): + words = wordsbylen[len(hword)] + random.shuffle(words) + problem.addVariable("h%d" % hi, words) + for vi, vword in enumerate(vertical): + words = wordsbylen[len(vword)] + random.shuffle(words) + problem.addVariable("v%d" % vi, words) + + problem.addConstraint(AllDifferentConstraint()) + + solution = problem.getSolution() + if not solution: + print("No solution found!") + + maxcol = 0 + maxrow = 0 + for hword in horizontal: + for row, col in hword: + if row > maxrow: + maxrow = row + if col > maxcol: + maxcol = col + for vword in vertical: + for row, col in vword: + if row > maxrow: + maxrow = row + if col > maxcol: + maxcol = col + + matrix = [] + for row in range(maxrow + 1): + matrix.append([" "] * (maxcol + 1)) + + for variable in solution: + if variable[0] == "v": + word = vertical[int(variable[1:])] + else: + word = horizontal[int(variable[1:])] + for (row, col), char in zip(word, solution[variable]): + matrix[row][col] = char + + for row in range(maxrow + 1): + for col in range(maxcol + 1): + sys.stdout.write(matrix[row][col]) + sys.stdout.write("\n") + + +if __name__ == "__main__": + if len(sys.argv) != 3: + sys.exit("Usage: crosswords.py ") + main(open(sys.argv[1]).read(), open(sys.argv[2])) diff --git a/csp/port2/python-constraint-master/examples/crosswords/large.mask b/csp/port2/python-constraint-master/examples/crosswords/large.mask new file mode 100755 index 00000000..ba5364c8 --- /dev/null +++ b/csp/port2/python-constraint-master/examples/crosswords/large.mask @@ -0,0 +1,27 @@ + +# ######## # +# # # # # +######## # # +# # # # # +# # ######## +# # # # # # +######## # # +# # # # # # + # # # +######## # # + # # # # # + # ######## + # # # # # + # # ######## + # # # # # # + # # ######## + # # # # +######## # # + # # # # # # + # # # # # # + ######## # # + # # # # + # ######## + # # # # +######## # # + diff --git a/csp/port2/python-constraint-master/examples/crosswords/medium.mask b/csp/port2/python-constraint-master/examples/crosswords/medium.mask new file mode 100755 index 00000000..3332a097 --- /dev/null +++ b/csp/port2/python-constraint-master/examples/crosswords/medium.mask @@ -0,0 +1,19 @@ + + # +######### +# # # +# # ###### +# # # +# # # # +# # # # +######## # +# # # + # # # + ######### + # # # + ######### + # # # + # # +####### + # + diff --git a/csp/port2/python-constraint-master/examples/crosswords/python.mask b/csp/port2/python-constraint-master/examples/crosswords/python.mask new file mode 100755 index 00000000..fe5a5767 --- /dev/null +++ b/csp/port2/python-constraint-master/examples/crosswords/python.mask @@ -0,0 +1,8 @@ + P + Y +####T#### + # H # + # O # +####N # + # # +######### diff --git a/csp/port2/python-constraint-master/examples/crosswords/small.mask b/csp/port2/python-constraint-master/examples/crosswords/small.mask new file mode 100755 index 00000000..0e43ff78 --- /dev/null +++ b/csp/port2/python-constraint-master/examples/crosswords/small.mask @@ -0,0 +1,8 @@ + # + # +######### + # # + # # # # +##### # # + # # # +######### diff --git a/csp/port2/python-constraint-master/examples/einstein/__init__.py b/csp/port2/python-constraint-master/examples/einstein/__init__.py new file mode 100755 index 00000000..e69de29b diff --git a/csp/port2/python-constraint-master/examples/einstein/einstein.py b/csp/port2/python-constraint-master/examples/einstein/einstein.py new file mode 100755 index 00000000..2ce6e45b --- /dev/null +++ b/csp/port2/python-constraint-master/examples/einstein/einstein.py @@ -0,0 +1,209 @@ +#!/usr/bin/python +# +# ALBERT EINSTEIN'S RIDDLE +# +# ARE YOU IN THE TOP 2% OF INTELLIGENT PEOPLE IN THE WORLD? +# SOLVE THE RIDDLE AND FIND OUT. +# +# There are no tricks, just pure logic, so good luck and don't give up. +# +# 1. In a street there are five houses, painted five different colours. +# 2. In each house lives a person of different nationality +# 3. These five homeowners each drink a different kind of beverage, smoke +# different brand of cigar and keep a different pet. +# +# THE QUESTION: WHO OWNS THE FISH? +# +# HINTS +# +# 1. The Brit lives in a red house. +# 2. The Swede keeps dogs as pets. +# 3. The Dane drinks tea. +# 4. The Green house is on the left of the White house. +# 5. The owner of the Green house drinks coffee. +# 6. The person who smokes Pall Mall rears birds. +# 7. The owner of the Yellow house smokes Dunhill. +# 8. The man living in the centre house drinks milk. +# 9. The Norwegian lives in the first house. +# 10. The man who smokes Blends lives next to the one who keeps cats. +# 11. The man who keeps horses lives next to the man who smokes Dunhill. +# 12. The man who smokes Blue Master drinks beer. +# 13. The German smokes Prince. +# 14. The Norwegian lives next to the blue house. +# 15. The man who smokes Blends has a neighbour who drinks water. +# +# ALBERT EINSTEIN WROTE THIS RIDDLE EARLY DURING THE 19th CENTURY. HE +# SAID THAT 98% OF THE WORLD POPULATION WOULD NOT BE ABLE TO SOLVE IT. + +from constraint import Problem, AllDifferentConstraint + +# Check http://www.csc.fi/oppaat/f95/python/talot.py + + +def solve(): + problem = Problem() + for i in range(1, 6): + problem.addVariable("color%d" % i, + ["red", "white", "green", "yellow", "blue"]) + problem.addVariable("nationality%d" % i, + ["brit", "swede", "dane", "norwegian", "german"]) + problem.addVariable("drink%d" % i, + ["tea", "coffee", "milk", "beer", "water"]) + problem.addVariable("smoke%d" % i, + ["pallmall", "dunhill", "blends", + "bluemaster", "prince"]) + problem.addVariable("pet%d" % i, + ["dogs", "birds", "cats", "horses", "fish"]) + + problem.addConstraint(AllDifferentConstraint(), + ["color%d" % i for i in range(1, 6)]) + problem.addConstraint(AllDifferentConstraint(), + ["nationality%d" % i for i in range(1, 6)]) + problem.addConstraint(AllDifferentConstraint(), + ["drink%d" % i for i in range(1, 6)]) + problem.addConstraint(AllDifferentConstraint(), + ["smoke%d" % i for i in range(1, 6)]) + problem.addConstraint(AllDifferentConstraint(), + ["pet%d" % i for i in range(1, 6)]) + + for i in range(1, 6): + + # Hint 1 + problem.addConstraint(lambda nationality, color: + nationality != "brit" or color == "red", + ("nationality%d" % i, "color%d" % i)) + + # Hint 2 + problem.addConstraint(lambda nationality, pet: + nationality != "swede" or pet == "dogs", + ("nationality%d" % i, "pet%d" % i)) + + # Hint 3 + problem.addConstraint(lambda nationality, drink: + nationality != "dane" or drink == "tea", + ("nationality%d" % i, "drink%d" % i)) + + # Hint 4 + if i < 5: + problem.addConstraint(lambda colora, colorb: + colora != "green" or colorb == "white", + ("color%d" % i, "color%d" % (i + 1))) + else: + problem.addConstraint(lambda color: color != "green", + ("color%d" % i,)) + + # Hint 5 + problem.addConstraint(lambda color, drink: + color != "green" or drink == "coffee", + ("color%d" % i, "drink%d" % i)) + + # Hint 6 + problem.addConstraint(lambda smoke, pet: + smoke != "pallmall" or pet == "birds", + ("smoke%d" % i, "pet%d" % i)) + + # Hint 7 + problem.addConstraint(lambda color, smoke: + color != "yellow" or smoke == "dunhill", + ("color%d" % i, "smoke%d" % i)) + + # Hint 8 + if i == 3: + problem.addConstraint(lambda drink: drink == "milk", + ("drink%d" % i,)) + + # Hint 9 + if i == 1: + problem.addConstraint(lambda nationality: + nationality == "norwegian", + ("nationality%d" % i,)) + + # Hint 10 + if 1 < i < 5: + problem.addConstraint(lambda smoke, peta, petb: + smoke != "blends" or peta == "cats" or + petb == "cats", + ("smoke%d" % i, "pet%d" % (i - 1), + "pet%d" % (i + 1))) + else: + problem.addConstraint(lambda smoke, pet: + smoke != "blends" or pet == "cats", + ("smoke%d" % i, + "pet%d" % (i == 1 and 2 or 4))) + + # Hint 11 + if 1 < i < 5: + problem.addConstraint(lambda pet, smokea, smokeb: + pet != "horses" or smokea == "dunhill" or + smokeb == "dunhill", + ("pet%d" % i, "smoke%d" % (i - 1), + "smoke%d" % (i + 1))) + else: + problem.addConstraint(lambda pet, smoke: + pet != "horses" or smoke == "dunhill", + ("pet%d" % i, + "smoke%d" % (i == 1 and 2 or 4))) + + # Hint 12 + problem.addConstraint(lambda smoke, drink: + smoke != "bluemaster" or drink == "beer", + ("smoke%d" % i, "drink%d" % i)) + + # Hint 13 + problem.addConstraint(lambda nationality, smoke: + nationality != "german" or smoke == "prince", + ("nationality%d" % i, "smoke%d" % i)) + + # Hint 14 + if 1 < i < 5: + problem.addConstraint(lambda nationality, colora, colorb: + nationality != "norwegian" or + colora == "blue" or colorb == "blue", + ("nationality%d" % i, "color%d" % (i - 1), + "color%d" % (i + 1))) + else: + problem.addConstraint(lambda nationality, color: + nationality != "norwegian" or + color == "blue", + ("nationality%d" % i, + "color%d" % (i == 1 and 2 or 4))) + + # Hint 15 + if 1 < i < 5: + problem.addConstraint(lambda smoke, drinka, drinkb: + smoke != "blends" or + drinka == "water" or drinkb == "water", + ("smoke%d" % i, "drink%d" % (i - 1), + "drink%d" % (i + 1))) + else: + problem.addConstraint(lambda smoke, drink: + smoke != "blends" or drink == "water", + ("smoke%d" % i, + "drink%d" % (i == 1 and 2 or 4))) + + solutions = problem.getSolutions() + return solutions + + +def showSolution(solution): + for i in range(1, 6): + print("House %d" % i) + print("--------") + print("Nationality: %s" % solution["nationality%d" % i]) + print("Color: %s" % solution["color%d" % i]) + print("Drink: %s" % solution["drink%d" % i]) + print("Smoke: %s" % solution["smoke%d" % i]) + print("Pet: %s" % solution["pet%d" % i]) + print("") + + +def main(): + solutions = solve() + print("Found %d solution(s)!" % len(solutions)) + print("") + for solution in solutions: + showSolution(solution) + + +if __name__ == "__main__": + main() diff --git a/csp/port2/python-constraint-master/examples/queens/__init__.py b/csp/port2/python-constraint-master/examples/queens/__init__.py new file mode 100755 index 00000000..e69de29b diff --git a/csp/port2/python-constraint-master/examples/queens/queens.py b/csp/port2/python-constraint-master/examples/queens/queens.py new file mode 100755 index 00000000..88aa5651 --- /dev/null +++ b/csp/port2/python-constraint-master/examples/queens/queens.py @@ -0,0 +1,54 @@ +#!/usr/bin/python +# +# http://mathworld.wolfram.com/QueensProblem.html +# +from constraint import Problem +import sys + + +def solve(): + problem = Problem() + size = 8 + cols = range(size) + rows = range(size) + problem.addVariables(cols, rows) + for col1 in cols: + for col2 in cols: + if col1 < col2: + problem.addConstraint(lambda row1, row2, col1=col1, col2=col2: + abs(row1 - row2) != abs(col1 - col2) and + row1 != row2, (col1, col2)) + solutions = problem.getSolutions() + return solutions, size + + +def showSolution(solution, size): + sys.stdout.write(" %s \n" % ("-" * ((size * 4) - 1))) + for i in range(size): + sys.stdout.write(" |") + for j in range(size): + if solution[j] == i: + sys.stdout.write(" %d |" % j) + else: + sys.stdout.write(" |") + sys.stdout.write("\n") + if i != size - 1: + sys.stdout.write(" |%s|\n" % ("-" * ((size * 4) - 1))) + sys.stdout.write(" %s \n" % ("-" * ((size * 4) - 1))) + + +def main(show=False): + solutions, size = solve() + print("Found %d solution(s)!" % len(solutions)) + if show: + for solution in solutions: + showSolution(solution, size) + + +if __name__ == "__main__": + show = False + if len(sys.argv) == 2 and sys.argv[1] == "-s": + show = True + elif len(sys.argv) != 1: + sys.exit("Usage: queens.py [-s]") + main(show) diff --git a/csp/port2/python-constraint-master/examples/rooks/__init__.py b/csp/port2/python-constraint-master/examples/rooks/__init__.py new file mode 100755 index 00000000..e69de29b diff --git a/csp/port2/python-constraint-master/examples/rooks/rooks.py b/csp/port2/python-constraint-master/examples/rooks/rooks.py new file mode 100755 index 00000000..a7979019 --- /dev/null +++ b/csp/port2/python-constraint-master/examples/rooks/rooks.py @@ -0,0 +1,57 @@ +#!/usr/bin/python +# +# http://mathworld.wolfram.com/RooksProblem.html +# +from constraint import Problem +import sys + + +def factorial(x): + return x == 1 or factorial(x - 1) * x + + +def solve(size): + problem = Problem() + cols = range(size) + rows = range(size) + problem.addVariables(cols, rows) + for col1 in cols: + for col2 in cols: + if col1 < col2: + problem.addConstraint(lambda row1, row2: row1 != row2, + (col1, col2)) + solutions = problem.getSolutions() + return solutions + + +def main(show=False): + size = 8 + solutions = solve(size) + print("Found %d solution(s)!" % len(solutions)) + if show: + for solution in solutions: + showSolution(solution, size) + + +def showSolution(solution, size): + sys.stdout.write(" %s \n" % ("-" * ((size * 4) - 1))) + for i in range(size): + sys.stdout.write(" |") + for j in range(size): + if solution[j] == i: + sys.stdout.write(" %d |" % j) + else: + sys.stdout.write(" |") + sys.stdout.write("\n") + if i != size - 1: + sys.stdout.write(" |%s|\n" % ("-" * ((size * 4) - 1))) + sys.stdout.write(" %s \n" % ("-" * ((size * 4) - 1))) + + +if __name__ == "__main__": + show = False + if len(sys.argv) == 2 and sys.argv[1] == "-s": + show = True + elif len(sys.argv) != 1: + sys.exit("Usage: rooks.py [-s]") + main(show) diff --git a/csp/port2/python-constraint-master/examples/studentdesks/__init__.py b/csp/port2/python-constraint-master/examples/studentdesks/__init__.py new file mode 100755 index 00000000..e69de29b diff --git a/csp/port2/python-constraint-master/examples/studentdesks/studentdesks.py b/csp/port2/python-constraint-master/examples/studentdesks/studentdesks.py new file mode 100755 index 00000000..a2978ec9 --- /dev/null +++ b/csp/port2/python-constraint-master/examples/studentdesks/studentdesks.py @@ -0,0 +1,48 @@ +#!/usr/bin/python +# +# http://home.chello.no/~dudley/ +# +from constraint import Problem, AllDifferentConstraint, SomeInSetConstraint +import sys + +STUDENTDESKS = [[0, 1, 0, 0, 0, 0], + [0, 2, 3, 4, 5, 6], + [0, 7, 8, 9, 10, 0], + [0, 11, 12, 13, 14, 0], + [15, 16, 17, 18, 19, 0], + [0, 0, 0, 0, 20, 0]] + + +def solve(): + problem = Problem() + problem.addVariables(range(1, 21), ["A", "B", "C", "D", "E"]) + problem.addConstraint(SomeInSetConstraint(["A"], 4, True)) + problem.addConstraint(SomeInSetConstraint(["B"], 4, True)) + problem.addConstraint(SomeInSetConstraint(["C"], 4, True)) + problem.addConstraint(SomeInSetConstraint(["D"], 4, True)) + problem.addConstraint(SomeInSetConstraint(["E"], 4, True)) + for row in range(len(STUDENTDESKS) - 1): + for col in range(len(STUDENTDESKS[row]) - 1): + lst = [STUDENTDESKS[row][col], STUDENTDESKS[row][col + 1], + STUDENTDESKS[row + 1][col], STUDENTDESKS[row + 1][col + 1]] + lst = [x for x in lst if x] + problem.addConstraint(AllDifferentConstraint(), lst) + solutions = problem.getSolution() + return solutions + + +def main(): + solutions = solve() + showSolution(solutions) + + +def showSolution(solution): + for row in range(len(STUDENTDESKS)): + for col in range(len(STUDENTDESKS[row])): + id = STUDENTDESKS[row][col] + sys.stdout.write(" %s" % (id and solution[id] or " ")) + sys.stdout.write("\n") + + +if __name__ == "__main__": + main() diff --git a/csp/port2/python-constraint-master/examples/sudoku/__init__.py b/csp/port2/python-constraint-master/examples/sudoku/__init__.py new file mode 100755 index 00000000..e69de29b diff --git a/csp/port2/python-constraint-master/examples/sudoku/sudoku.py b/csp/port2/python-constraint-master/examples/sudoku/sudoku.py new file mode 100755 index 00000000..820c76dd --- /dev/null +++ b/csp/port2/python-constraint-master/examples/sudoku/sudoku.py @@ -0,0 +1,71 @@ +# +# Sudoku puzzle solver by by Luigi Poderico (www.poderico.it). +# +import sys +from constraint import Problem, AllDifferentConstraint + + +def solve(): + problem = Problem() + + # Define the variables: 9 rows of 9 variables rangin in 1...9 + for i in range(1, 10): + problem.addVariables(range(i * 10 + 1, i * 10 + 10), range(1, 10)) + + # Each row has different values + for i in range(1, 10): + problem.addConstraint(AllDifferentConstraint(), range(i * 10 + 1, i * 10 + 10)) + + # Each colum has different values + for i in range(1, 10): + problem.addConstraint(AllDifferentConstraint(), range(10 + i, 100 + i, 10)) + + # Each 3x3 box has different values + problem.addConstraint(AllDifferentConstraint(), [11, 12, 13, 21, 22, 23, 31, 32, 33]) + problem.addConstraint(AllDifferentConstraint(), [41, 42, 43, 51, 52, 53, 61, 62, 63]) + problem.addConstraint(AllDifferentConstraint(), [71, 72, 73, 81, 82, 83, 91, 92, 93]) + + problem.addConstraint(AllDifferentConstraint(), [14, 15, 16, 24, 25, 26, 34, 35, 36]) + problem.addConstraint(AllDifferentConstraint(), [44, 45, 46, 54, 55, 56, 64, 65, 66]) + problem.addConstraint(AllDifferentConstraint(), [74, 75, 76, 84, 85, 86, 94, 95, 96]) + + problem.addConstraint(AllDifferentConstraint(), [17, 18, 19, 27, 28, 29, 37, 38, 39]) + problem.addConstraint(AllDifferentConstraint(), [47, 48, 49, 57, 58, 59, 67, 68, 69]) + problem.addConstraint(AllDifferentConstraint(), [77, 78, 79, 87, 88, 89, 97, 98, 99]) + + # Some value is given. + initValue = [[0, 9, 0, 7, 0, 0, 8, 6, 0], + [0, 3, 1, 0, 0, 5, 0, 2, 0], + [8, 0, 6, 0, 0, 0, 0, 0, 0], + [0, 0, 7, 0, 5, 0, 0, 0, 6], + [0, 0, 0, 3, 0, 7, 0, 0, 0], + [5, 0, 0, 0, 1, 0, 7, 0, 0], + [0, 0, 0, 0, 0, 0, 1, 0, 9], + [0, 2, 0, 6, 0, 0, 0, 5, 0], + [0, 5, 4, 0, 0, 8, 0, 7, 0]] + + for i in range(1, 10): + for j in range(1, 10): + if initValue[i - 1][j - 1] != 0: + problem.addConstraint(lambda var, val=initValue[i - 1][j - 1]: + var == val, (i * 10 + j,)) + + # Get the solutions. + solutions = problem.getSolutions() + return solutions + + +def main(): + solutions = solve() + # Print the solutions + for solution in solutions: + for i in range(1, 10): + for j in range(1, 10): + index = i * 10 + j + sys.stdout.write("%s " % solution[index]) + print("") + print("") + + +if __name__ == "__main__": + main() diff --git a/csp/port2/python-constraint-master/examples/wordmath/__init__.py b/csp/port2/python-constraint-master/examples/wordmath/__init__.py new file mode 100755 index 00000000..e69de29b diff --git a/csp/port2/python-constraint-master/examples/wordmath/seisseisdoze.py b/csp/port2/python-constraint-master/examples/wordmath/seisseisdoze.py new file mode 100755 index 00000000..22776db0 --- /dev/null +++ b/csp/port2/python-constraint-master/examples/wordmath/seisseisdoze.py @@ -0,0 +1,39 @@ +#!/usr/bin/python +# +# Assign equal values to equal letters, and different values to +# different letters, in a way that satisfies the following sum: +# +# SEIS +# + SEIS +# ------ +# DOZE +# +from constraint import Problem, AllDifferentConstraint + + +def solve(): + problem = Problem() + problem.addVariables("seidoz", range(10)) + problem.addConstraint(lambda s, e: (2 * s) % 10 == e, "se") + problem.addConstraint(lambda i, s, z, e: ((10 * 2 * i) + (2 * s)) % 100 == + z * 10 + e, "isze") + problem.addConstraint(lambda s, e, i, d, o, z: + 2 * (s * 1000 + e * 100 + i * 10 + s) == + d * 1000 + o * 100 + z * 10 + e, "seidoz") + problem.addConstraint(lambda s: s != 0, "s") + problem.addConstraint(lambda d: d != 0, "d") + problem.addConstraint(AllDifferentConstraint()) + solutions = problem.getSolutions() + return solutions + + +def main(): + solutions = solve() + print("SEIS+SEIS=DOZE") + for s in solutions: + print("%(s)d%(e)d%(i)d%(s)s+%(s)d%(e)d%(i)d%(s)d=" + "%(d)d%(o)d%(z)d%(e)d") % s + + +if __name__ == "__main__": + main() diff --git a/csp/port2/python-constraint-master/examples/wordmath/sendmoremoney.py b/csp/port2/python-constraint-master/examples/wordmath/sendmoremoney.py new file mode 100755 index 00000000..9e9578ec --- /dev/null +++ b/csp/port2/python-constraint-master/examples/wordmath/sendmoremoney.py @@ -0,0 +1,42 @@ +#!/usr/bin/python +# +# Assign equal values to equal letters, and different values to +# different letters, in a way that satisfies the following sum: +# +# SEND +# + MORE +# ------ +# MONEY +# +from constraint import Problem, NotInSetConstraint, AllDifferentConstraint + + +def solve(): + problem = Problem() + problem.addVariables("sendmory", range(10)) + problem.addConstraint(lambda d, e, y: (d + e) % 10 == y, "dey") + problem.addConstraint(lambda n, d, r, e, y: (n * 10 + d + r * 10 + e) % 100 == + e * 10 + y, "ndrey") + problem.addConstraint(lambda e, n, d, o, r, y: + (e * 100 + n * 10 + d + o * 100 + r * 10 + e) % 1000 == + n * 100 + e * 10 + y, "endory") + problem.addConstraint(lambda s, e, n, d, m, o, r, y: + 1000 * s + 100 * e + 10 * n + d + 1000 * m + 100 * o + 10 * r + e == + 10000 * m + 1000 * o + 100 * n + 10 * e + y, "sendmory") + problem.addConstraint(NotInSetConstraint([0]), "sm") + problem.addConstraint(AllDifferentConstraint()) + solutions = problem.getSolutions() + return solutions + + +def main(): + solutions = solve() + print("SEND+MORE=MONEY") + for s in solutions: + print("%(s)d%(e)d%(n)d%(d)d+" + "%(m)d%(o)d%(r)d%(e)d=" + "%(m)d%(o)d%(n)d%(e)d%(y)d" % s) + + +if __name__ == "__main__": + main() diff --git a/csp/port2/python-constraint-master/examples/wordmath/twotwofour.py b/csp/port2/python-constraint-master/examples/wordmath/twotwofour.py new file mode 100755 index 00000000..33e4aabb --- /dev/null +++ b/csp/port2/python-constraint-master/examples/wordmath/twotwofour.py @@ -0,0 +1,37 @@ +#!/usr/bin/python +# +# Assign equal values to equal letters, and different values to +# different letters, in a way that satisfies the following sum: +# +# TWO +# + TWO +# ----- +# FOUR +# +from constraint import Problem, AllDifferentConstraint, NotInSetConstraint + + +def solve(): + problem = Problem() + problem.addVariables("twofur", range(10)) + problem.addConstraint(lambda o, r: (2 * o) % 10 == r, "or") + problem.addConstraint(lambda w, o, u, + r: ((10 * 2 * w) + (2 * o)) % 100 == u * 10 + r, "wour") + problem.addConstraint(lambda t, w, o, f, u, r: + 2 * (t * 100 + w * 10 + o) == + f * 1000 + o * 100 + u * 10 + r, "twofur") + problem.addConstraint(NotInSetConstraint([0]), "ft") + problem.addConstraint(AllDifferentConstraint()) + solutions = problem.getSolutions() + return solutions + + +def main(): + solutions = solve() + print("TWO+TWO=FOUR") + for s in solutions: + print("%(t)d%(w)d%(o)d+%(t)d%(w)d%(o)d=%(f)d%(o)d%(u)d%(r)d" % s) + + +if __name__ == "__main__": + main() diff --git a/csp/port2/python-constraint-master/examples/xsum/__init__.py b/csp/port2/python-constraint-master/examples/xsum/__init__.py new file mode 100755 index 00000000..e69de29b diff --git a/csp/port2/python-constraint-master/examples/xsum/xsum.py b/csp/port2/python-constraint-master/examples/xsum/xsum.py new file mode 100755 index 00000000..987438f3 --- /dev/null +++ b/csp/port2/python-constraint-master/examples/xsum/xsum.py @@ -0,0 +1,48 @@ +#!/usr/bin/python +# +# Reorganize the following numbers in a way that each line of +# 5 numbers sum to 27. +# +# 1 6 +# 2 7 +# 3 +# 8 4 +# 9 5 +# +from constraint import Problem, AllDifferentConstraint + + +def solve(): + problem = Problem() + problem.addVariables("abcdxefgh", range(1, 10)) + problem.addConstraint(lambda a, b, c, d, x: + a < b < c < d and a + b + c + d + x == 27, "abcdx") + problem.addConstraint(lambda e, f, g, h, x: + e < f < g < h and e + f + g + h + x == 27, "efghx") + problem.addConstraint(AllDifferentConstraint()) + solutions = problem.getSolutions() + return solutions + + +def main(): + solutions = solve() + print("Found %d solutions!" % len(solutions)) + showSolutions(solutions) + + +def showSolutions(solutions): + for solution in solutions: + print(""" %d %d + %d %d + %d + %d %d + %d %d +""" % (solution["a"], solution["e"], + solution["b"], solution["f"], + solution["x"], + solution["g"], solution["c"], + solution["h"], solution["d"])) + + +if __name__ == "__main__": + main() diff --git a/csp/port2/python-constraint-master/setup.cfg b/csp/port2/python-constraint-master/setup.cfg new file mode 100755 index 00000000..5bf04527 --- /dev/null +++ b/csp/port2/python-constraint-master/setup.cfg @@ -0,0 +1,9 @@ +[bdist_wheel] +universal = 1 + +[bdist_rpm] +doc_files = README.rst +use_bzip2 = 1 + +[sdist] +formats = bztar diff --git a/csp/port2/python-constraint-master/setup.py b/csp/port2/python-constraint-master/setup.py new file mode 100755 index 00000000..4a597e55 --- /dev/null +++ b/csp/port2/python-constraint-master/setup.py @@ -0,0 +1,123 @@ +#!/usr/bin/env python +# -*- coding: utf-8 -*- + +from setuptools import setup, find_packages # Always prefer setuptools over distutils +from codecs import open # To use a consistent encoding +from os import path +import io + +NAME = 'python-constraint' +filename = "%s/version.py" % 'constraint' +with open(filename) as f: + exec(f.read()) + +here = path.abspath(path.dirname(__file__)) + +def readme(): + filename = path.join(here, 'README.rst') + with io.open(filename, 'rt', encoding='UTF-8') as f: + return f.read() + +setup( + name=NAME, + + # Versions should comply with PEP440. For a discussion on single-sourcing + # the version across setup.py and the project code, see + # https://packaging.python.org/en/latest/development.html#single-sourcing-the-version + #version='0.0.1', + version=__version__, + + description="python-constraint is a module implementing support "\ + "for handling CSPs (Constraint Solving Problems) over finite domain", + + long_description=readme(), + + # The project's main homepage. + url=__url__, + + # Author details + author=__author__, + author_email=__email__, + + # Choose your license + license=__license__, + + # See https://pypi.python.org/pypi?%3Aaction=list_classifiers + classifiers=[ + # How mature is this project? Common values are + # 3 - Alpha + # 4 - Beta + # 5 - Production/Stable + 'Development Status :: 3 - Alpha', + + # Indicate who your project is intended for + 'Environment :: Console', + #'Topic :: Software Development :: Build Tools', + 'Intended Audience :: Science/Research', + 'Operating System :: OS Independent', + + # Specify the Python versions you support here. In particular, ensure + # that you indicate whether you support Python 2, Python 3 or both. + 'Programming Language :: Cython', + + 'Programming Language :: Python', + #'Programming Language :: Python :: 2', + #'Programming Language :: Python :: 2.6', + 'Programming Language :: Python :: 2.7', + #'Programming Language :: Python :: 3', + #'Programming Language :: Python :: 3.2', + 'Programming Language :: Python :: 3.3', + 'Programming Language :: Python :: 3.4', + 'Programming Language :: Python :: 3.5', + 'Programming Language :: Python :: 3.6', + + 'Topic :: Scientific/Engineering', + + # Pick your license as you wish (should match "license" above) + 'License :: OSI Approved :: BSD License', + + ], + + # What does your project relate to? + keywords='csp constraint solving problems problem solver', + + # You can just specify the packages manually here if your project is + # simple. Or you can use find_packages(). + packages=find_packages(exclude=['contrib', 'docs', 'tests*']), + + # List run-time dependencies here. These will be installed by pip when your + # project is installed. For an analysis of "install_requires" vs pip's + # requirements files see: + # https://packaging.python.org/en/latest/technical.html#install-requires-vs-requirements-files + install_requires=[], + + # List additional groups of dependencies here (e.g. development dependencies). + # You can install these using the following syntax, for example: + # $ pip install -e .[dev,test] + extras_require = { + 'dev': ['check-manifest', 'nose'], + 'test': ['coverage', 'nose'], + }, + + # If there are data files included in your packages that need to be + # installed, specify them here. If using Python 2.6 or less, then these + # have to be included in MANIFEST.in as well. + #package_data={ + # 'sample': ['logging.conf'], + #}, + + # Although 'package_data' is the preferred approach, in some case you may + # need to place data files outside of your packages. + # see http://docs.python.org/3.4/distutils/setupscript.html#installing-additional-files + # In this case, 'data_file' will be installed into '/my_data' + #data_files=[('my_data', ['data/data_file'])], + + # To provide executable scripts, use entry points in preference to the + # "scripts" keyword. Entry points provide cross-platform support and allow + # pip to create the appropriate form of executable for the target platform. + #entry_points={ + # 'console_scripts': [ + # 'sample=sample:main', + # ], + #}, +) diff --git a/csp/port2/python-constraint-master/tests/test_constraint.py b/csp/port2/python-constraint-master/tests/test_constraint.py new file mode 100755 index 00000000..e644bf4b --- /dev/null +++ b/csp/port2/python-constraint-master/tests/test_constraint.py @@ -0,0 +1,91 @@ +import constraint + +from examples.abc import abc +from examples.coins import coins +# from examples.crosswords import crosswords +from examples.einstein import einstein +from examples.queens import queens +from examples.rooks import rooks +from examples.studentdesks import studentdesks +# from examples.sudoku import sudoku +# from examples.wordmath import (seisseisdoze, sendmoremoney, twotwofour) +# from examples.xsum import xsum + +import constraint.compat as compat + + +def test_abc(): + solutions = abc.solve() + minvalue, minsolution = solutions + assert minvalue == 37 + assert minsolution == {'a': 1, 'c': 2, 'b': 1} + + +def test_coins(): + solutions = coins.solve() + assert len(solutions) == 2 + + +def test_einstein(): + solutions = einstein.solve() + expected_solutions = [ + { + 'nationality2': 'dane', + 'nationality3': 'brit', + 'nationality1': 'norwegian', + 'nationality4': 'german', + 'nationality5': 'swede', + 'color1': 'yellow', + 'color3': 'red', + 'color2': 'blue', + 'color5': 'white', + 'color4': 'green', + 'drink4': 'coffee', + 'drink5': 'beer', + 'drink1': 'water', + 'drink2': 'tea', + 'drink3': 'milk', + 'smoke5': 'bluemaster', + 'smoke4': 'prince', + 'smoke3': 'pallmall', + 'smoke2': 'blends', + 'smoke1': 'dunhill', + 'pet5': 'dogs', + 'pet4': 'fish', + 'pet1': 'cats', + 'pet3': 'birds', + 'pet2': 'horses' + } + ] + assert solutions == expected_solutions + + +def test_queens(): + solutions, size = queens.solve() + assert size == 8 + for solution in solutions: + queens.showSolution(solution, size) + + +def test_rooks(): + size = 8 + solutions = rooks.solve(size) + assert len(solutions) == rooks.factorial(size) + + +def test_studentdesks(): + solutions = studentdesks.solve() + expected_solutions = {1: 'A', 2: 'E', 3: 'D', 4: 'E', 5: 'D', 6: 'A', 7: 'C', 8: 'B', 9: 'C', 10: 'B', 11: 'E', 12: 'D', 13: 'E', 14: 'D', 15: 'A', 16: 'C', 17: 'B', 18: 'C', 19: 'B', 20: 'A'} + assert solutions == expected_solutions + + +def test_constraint_without_variables(): + problem = constraint.Problem() + problem.addVariable("a", [1, 2, 3]) + problem.addConstraint(lambda a: a * 2 == 6) + solutions = problem.getSolutions() + assert solutions == [{'a': 3}] + + +def test_version(): + assert isinstance(constraint.__version__, compat.string_types) diff --git a/csp/port2/python-constraint-master/tests/test_solvers.py b/csp/port2/python-constraint-master/tests/test_solvers.py new file mode 100755 index 00000000..1a24d382 --- /dev/null +++ b/csp/port2/python-constraint-master/tests/test_solvers.py @@ -0,0 +1,17 @@ +from constraint import Problem, MinConflictsSolver + + +def test_min_conflicts_solver(): + problem = Problem(MinConflictsSolver()) + problem.addVariable("x", [0, 1]) + problem.addVariable("y", [0, 1]) + solution = problem.getSolution() + + possible_solutions = [ + {'x': 0, 'y': 0}, + {'x': 0, 'y': 1}, + {'x': 1, 'y': 0}, + {'x': 1, 'y': 1} + ] + + assert solution in possible_solutions diff --git a/csp/port2/python-constraint-master/tests/test_some_not_in_set.py b/csp/port2/python-constraint-master/tests/test_some_not_in_set.py new file mode 100755 index 00000000..31ac4fc4 --- /dev/null +++ b/csp/port2/python-constraint-master/tests/test_some_not_in_set.py @@ -0,0 +1,102 @@ +from constraint import Domain, Variable, SomeNotInSetConstraint + + +def test_empty_constraint(): + constrainer = SomeNotInSetConstraint(set()) + v1, v2 = variables = [Variable('v1'), Variable('v2')] + assignments = {v1: 'a', v2: 'b'} + + assert constrainer(variables, {}, assignments) + + +def test_no_overlap(): + constrainer = SomeNotInSetConstraint(set('zy')) + v1, v2 = variables = [Variable('v1'), Variable('v2')] + assignments = {v1: 'a', v2: 'b'} + + assert constrainer(variables, {}, assignments) + + +def test_some_overlap(): + constrainer = SomeNotInSetConstraint(set('b')) + v1, v2 = variables = [Variable('v1'), Variable('v2')] + assignments = {v1: 'a', v2: 'b'} + + assert constrainer(variables, {}, assignments) + + +def test_too_much_overlap(): + constrainer = SomeNotInSetConstraint(set('ab')) + v1, v2 = variables = [Variable('v1'), Variable('v2')] + assignments = {v1: 'a', v2: 'b'} + + assert not constrainer(variables, {}, assignments) + + +def test_exact(): + constrainer = SomeNotInSetConstraint(set('abc'), n=2, exact=True) + v1, v2, v3 = variables = [Variable('v1'), Variable('v2'), Variable('v3')] + + assignments = {v1: 'a', v2: 'y', v3: 'z'} + assert constrainer(variables, {}, assignments) + + assignments = {v1: 'a', v2: 'y'} + assert constrainer(variables, {}, assignments) + + assignments = {v1: 'a', v2: 'b', v3: 'z'} + assert not constrainer(variables, {}, assignments) + + assignments = {v1: 'a', v2: 'b'} + assert not constrainer(variables, {}, assignments) + + assignments = {v1: 'a', v2: 'b', v3: 'c'} + assert not constrainer(variables, {}, assignments) + + assignments = {v1: 'x', v2: 'y', v3: 'z'} + assert not constrainer(variables, {}, assignments) + + +def test_forwardcheck(): + constrainer = SomeNotInSetConstraint(set('abc'), n=2) + v1, v2, v3 = variables = [Variable('v1'), Variable('v2'), Variable('v3')] + + domains = {v1: Domain(['a']), v2: Domain(['b', 'y']), + v3: Domain(['c', 'z'])} + assert constrainer(variables, domains, {v1: 'a'}) + assert ['a'] == list(domains[v1]) + assert ['b', 'y'] == list(domains[v2]) + assert ['c', 'z'] == list(domains[v3]) + + assert constrainer(variables, domains, {v1: 'a'}, True) + assert ['a'] == list(domains[v1]) + assert ['y'] == list(domains[v2]) + assert ['z'] == list(domains[v3]) + + +def test_forwardcheck_empty_domain(): + constrainer = SomeNotInSetConstraint(set('abc')) + v1, v2 = variables = [Variable('v1'), Variable('v2')] + + domains = {v1: Domain(['a']), v2: Domain(['b'])} + assert constrainer(variables, domains, {v1: 'a'}) + assert not constrainer(variables, domains, {v1: 'a'}, True) + + +def test_forwardcheck_exact(): + constrainer = SomeNotInSetConstraint(set('abc'), n=2, exact=True) + v1, v2, v3 = variables = [Variable('v1'), Variable('v2'), Variable('v3')] + assignments = {v1: 'a'} + + domains = {v1: Domain(['a', 'x']), v2: Domain(['b', 'y']), + v3: Domain(['c', 'z'])} + assert constrainer(variables, domains, assignments) + assert constrainer(variables, domains, assignments, True) + assert 'b' not in domains[v2] + assert 'y' in domains[v2] + assert 'c' not in domains[v3] + assert 'z' in domains[v3] + + domains = {v1: Domain(['a', 'x']), v2: Domain(['b', 'y']), + v3: Domain(['c'])} + assert constrainer(variables, domains, assignments) + assert not constrainer(variables, domains, assignments, True) From b94c278f4bb939278bfcdde589cf2e8bacdfa9ba Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Thu, 18 Oct 2018 16:25:02 -0700 Subject: [PATCH 144/246] clean --- csp/hacs.rkt | 163 +++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 163 insertions(+) create mode 100644 csp/hacs.rkt diff --git a/csp/hacs.rkt b/csp/hacs.rkt new file mode 100644 index 00000000..a5e0e552 --- /dev/null +++ b/csp/hacs.rkt @@ -0,0 +1,163 @@ +#lang debug racket +(require racket/generator sugar graph rackunit math) +(provide (all-defined-out)) + +(struct $csp ([vars #:mutable] + [constraints #:mutable]) #:transparent) +(struct $constraint (names proc) #:transparent) +(struct $var (name vals) #:transparent) +(define $var-name? symbol?) +(struct $avar $var () #:transparent) +(struct inconsistency-signal (csp) #:transparent) + +(define/contract (check-name-in-csp! caller csp name) + (symbol? $csp? $var-name? . -> . void?) + (define names (map $var-name ($csp-vars csp))) + (unless (memq name names) + (raise-argument-error caller (format "one of these existing csp var names: ~v" names) name))) + +(define/contract ($csp-var csp name) + ($csp? $var-name? . -> . $var?) + (check-name-in-csp! '$csp-var csp name) + (for/first ([var (in-list ($csp-vars csp))] + #:when (eq? name ($var-name var))) + var)) + +(define/contract ($csp-vals csp name) + ($csp? $var-name? . -> . (listof any/c)) + (check-name-in-csp! '$csp-vals csp name) + ($var-vals ($csp-var csp name))) + +(define order-domain-values values) +(define (assign-val csp name val) + ($csp + (for/list ([var ($csp-vars csp)]) + (if (eq? name ($var-name var)) + ($avar name (list val)) + var)) + ($csp-constraints csp))) + +(define current-select-variable (make-parameter #f)) +(define current-order-values (make-parameter #f)) +(define current-inference (make-parameter #f)) + +(define (first-unassigned-variable csp) + (for/first ([var ($csp-vars csp)] + #:unless ($avar? var)) + var)) + +(check-equal? (first-unassigned-variable ($csp (list ($var 'a (range 3)) ($var 'b (range 3))) null)) ($var 'a (range 3))) +(check-equal? (first-unassigned-variable ($csp (list ($avar 'a (range 3)) ($var 'b (range 3))) null)) ($var 'b (range 3))) +(check-false (first-unassigned-variable ($csp (list ($avar 'a (range 3)) ($avar 'b (range 3))) null))) + +(define first-domain-value values) + +(define (no-inference csp name) csp) + +(define (forward-check csp aname) + (define aval (first ($csp-vals csp aname))) + (define (filter-vals var) + (match-define ($var name vals) var) + (define new-vals + (match (for*/list ([constraint (in-list ($csp-constraints csp))] + [cnames (in-value ($constraint-names constraint))] + #:when (and (memq aname cnames) (memq name cnames))) + constraint) + [(list) vals] + [constraints + (for*/list ([val (in-list vals)] + [constraint (in-list constraints)] + [cnames (in-value ($constraint-names constraint))] + #:when (cond + [(eq? (first cnames) name) + (($constraint-proc constraint) val aval)] + [(eq? (second cnames) name) + (($constraint-proc constraint) aval val)] + [else #true])) + val)])) + (unless (pair? new-vals) (raise (inconsistency-signal csp))) + new-vals) + + ($csp + (for/list ([var ($csp-vars csp)]) + (if ($avar? var) + var + ($var ($var-name var) (filter-vals var)))) + ($csp-constraints csp))) + +(check-equal? + ($csp-vars (forward-check ($csp (list ($avar 'a '(1)) ($var 'b (range 2))) null) 'a)) + (list ($avar 'a '(1)) ($var 'b '(0 1)))) + +(check-equal? + ;; no inconsistency because b≠c not checked (because fc is relative to a) + ($csp-vars (forward-check ($csp (list ($avar 'a '(1)) ($var 'b (range 2)) ($var 'c '(0))) + (list ($constraint '(a b) (negate =)) + ($constraint '(b c) (negate =)))) 'a)) + (list ($avar 'a '(1)) ($var 'b '(0)) ($var 'c '(0)))) + +(check-equal? + ;; no inconsistency because a≠b not checked (because fc ignores a, which is already assigned) + ($csp-vars (forward-check ($csp (list ($avar 'a '(1)) ($avar 'b '(1)) ($var 'c (range 2))) + (list ($constraint '(a b) (negate =)) + ($constraint '(b c) (negate =)))) 'b)) + (list ($avar 'a '(1)) ($avar 'b '(1)) ($var 'c '(0)))) + +(check-exn inconsistency-signal? + (λ () ($csp-vars (forward-check ($csp (list ($avar 'a '(1)) + ($var 'b '(1))) + (list ($constraint '(a b) (negate =)))) 'a)))) + +(define/contract (backtrack-solution-generator csp + [select-unassigned-variable (or (current-select-variable) first-unassigned-variable)] + [order-domain-values (or (current-order-values) first-domain-value)] + [inference (or (current-inference) no-inference)]) + (($csp?) (procedure? procedure? procedure?) . ->* . generator?) + (generator () + (let backtrack ([csp csp]) + (match (select-unassigned-variable csp) + [#false (yield csp)] + [($var name vals) + (for ([val (in-list (order-domain-values vals))]) + (with-handlers ([inconsistency-signal? void]) + (let* ([csp (assign-val csp name val)] + [csp (inference csp name)]) + (backtrack csp))))])))) + +(define/contract (solve* csp [finish-proc $csp-vars][solution-limit +inf.0]) + (($csp?) (procedure? integer?) . ->* . (listof any/c)) + (for/list ([solution (in-producer (backtrack-solution-generator csp) (void))] + [idx (in-range solution-limit)]) + (finish-proc solution))) + +(define/contract (solve csp [finish-proc $csp-vars]) + (($csp?) (procedure?) . ->* . (or/c #false any/c)) + (match (solve* csp finish-proc 1) + [(list solution) solution] + [else #false])) + +(define (<> a b) (not (= a b))) +(define (neq? a b) (not (eq? a b))) + +(parameterize ([current-inference forward-check]) + (time (solve* ($csp (list ($var 'a (range 3)) + ($var 'b (range 3)) + ($var 'c (range 3))) + (list ($constraint '(a b) <>) + ($constraint '(a c) <>) + ($constraint '(b c) <>)))))) +(parameterize ([current-inference forward-check]) + (define vds (for/list ([k '(wa nsw t q nt v sa)]) + ($var k '(red green blue)))) + (define cs (list + ($constraint '(wa nt) neq?) + ($constraint '(wa sa) neq?) + ($constraint '(nt sa) neq?) + ($constraint '(nt q) neq?) + ($constraint '(q sa) neq?) + ($constraint '(q nsw) neq?) + ($constraint '(nsw sa) neq?) + ($constraint '(nsw v) neq?) + ($constraint '(v sa) neq?))) + (define csp ($csp vds cs)) + (check-equal? (time (length (solve* csp))) 18)) \ No newline at end of file From 426125c09346f4a654d9343e37a68faec4b92216 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Thu, 18 Oct 2018 17:34:41 -0700 Subject: [PATCH 145/246] touchup --- csp/hacs.rkt | 120 +++++++++++++++++++++++++++++++-------------------- 1 file changed, 73 insertions(+), 47 deletions(-) diff --git a/csp/hacs.rkt b/csp/hacs.rkt index a5e0e552..1eb3d4b9 100644 --- a/csp/hacs.rkt +++ b/csp/hacs.rkt @@ -10,6 +10,12 @@ (struct $avar $var () #:transparent) (struct inconsistency-signal (csp) #:transparent) +(define current-select-variable (make-parameter #f)) +(define current-order-values (make-parameter #f)) +(define current-inference (make-parameter #f)) +(define current-solver (make-parameter #f)) + + (define/contract (check-name-in-csp! caller csp name) (symbol? $csp? $var-name? . -> . void?) (define names (map $var-name ($csp-vars csp))) @@ -29,7 +35,8 @@ ($var-vals ($csp-var csp name))) (define order-domain-values values) -(define (assign-val csp name val) +(define/contract (assign-val csp name val) + ($csp? $var-name? any/c . -> . $csp?) ($csp (for/list ([var ($csp-vars csp)]) (if (eq? name ($var-name var)) @@ -37,49 +44,52 @@ var)) ($csp-constraints csp))) -(define current-select-variable (make-parameter #f)) -(define current-order-values (make-parameter #f)) -(define current-inference (make-parameter #f)) - -(define (first-unassigned-variable csp) - (for/first ([var ($csp-vars csp)] +(define/contract (first-unassigned-variable csp) + ($csp? . -> . (or/c #false (and/c $var? (not/c $avar?)))) + (for/first ([var (in-list ($csp-vars csp))] #:unless ($avar? var)) var)) -(check-equal? (first-unassigned-variable ($csp (list ($var 'a (range 3)) ($var 'b (range 3))) null)) ($var 'a (range 3))) -(check-equal? (first-unassigned-variable ($csp (list ($avar 'a (range 3)) ($var 'b (range 3))) null)) ($var 'b (range 3))) +(check-equal? (first-unassigned-variable ($csp (list ($var 'a (range 3)) ($var 'b (range 3))) null)) + ($var 'a (range 3))) +(check-equal? (first-unassigned-variable ($csp (list ($avar 'a (range 3)) ($var 'b (range 3))) null)) + ($var 'b (range 3))) (check-false (first-unassigned-variable ($csp (list ($avar 'a (range 3)) ($avar 'b (range 3))) null))) (define first-domain-value values) (define (no-inference csp name) csp) -(define (forward-check csp aname) +(define/contract (relating constraints names) + ((listof $constraint?) (listof $var-name?) . -> . (listof $constraint?)) + (for*/list ([constraint (in-list constraints)] + [cnames (in-value ($constraint-names constraint))] + #:when (for/and ([name (in-list names)]) + (memq name cnames))) + constraint)) + +(define/contract (forward-check csp aname) + ($csp? $var-name? . -> . $csp?) (define aval (first ($csp-vals csp aname))) (define (filter-vals var) (match-define ($var name vals) var) (define new-vals - (match (for*/list ([constraint (in-list ($csp-constraints csp))] - [cnames (in-value ($constraint-names constraint))] - #:when (and (memq aname cnames) (memq name cnames))) - constraint) - [(list) vals] + (match (($csp-constraints csp) . relating . (list aname name)) + [(? empty?) vals] [constraints - (for*/list ([val (in-list vals)] - [constraint (in-list constraints)] - [cnames (in-value ($constraint-names constraint))] - #:when (cond - [(eq? (first cnames) name) - (($constraint-proc constraint) val aval)] - [(eq? (second cnames) name) - (($constraint-proc constraint) aval val)] - [else #true])) + (for/list ([val (in-list vals)] + #:when (for/and ([constraint (in-list constraints)]) + (let ([proc ($constraint-proc constraint)]) + (if (eq? name (first ($constraint-names constraint))) + (proc val aval) + (proc aval val))))) val)])) - (unless (pair? new-vals) (raise (inconsistency-signal csp))) + (unless (pair? new-vals) + (raise (inconsistency-signal csp))) new-vals) ($csp - (for/list ([var ($csp-vars csp)]) + (for/list ([var (in-list ($csp-vars csp))]) (if ($avar? var) var ($var ($var-name var) (filter-vals var)))) @@ -90,14 +100,14 @@ (list ($avar 'a '(1)) ($var 'b '(0 1)))) (check-equal? - ;; no inconsistency because b≠c not checked (because fc is relative to a) + ;; no inconsistency: b≠c not checked when fc is relative to a ($csp-vars (forward-check ($csp (list ($avar 'a '(1)) ($var 'b (range 2)) ($var 'c '(0))) (list ($constraint '(a b) (negate =)) ($constraint '(b c) (negate =)))) 'a)) (list ($avar 'a '(1)) ($var 'b '(0)) ($var 'c '(0)))) (check-equal? - ;; no inconsistency because a≠b not checked (because fc ignores a, which is already assigned) + ;; no inconsistency: a≠b not checked when fc ignores a, which is already assigned ($csp-vars (forward-check ($csp (list ($avar 'a '(1)) ($avar 'b '(1)) ($var 'c (range 2))) (list ($constraint '(a b) (negate =)) ($constraint '(b c) (negate =)))) 'b)) @@ -108,11 +118,21 @@ ($var 'b '(1))) (list ($constraint '(a b) (negate =)))) 'a)))) -(define/contract (backtrack-solution-generator csp - [select-unassigned-variable (or (current-select-variable) first-unassigned-variable)] - [order-domain-values (or (current-order-values) first-domain-value)] - [inference (or (current-inference) no-inference)]) - (($csp?) (procedure? procedure? procedure?) . ->* . generator?) + +(check-equal? ($csp-vars (forward-check ($csp (list ($avar 'a (range 3)) + ($var 'b (range 3))) + (list ($constraint '(a b) <) + ($constraint '(a b) <) + ($constraint '(a b) <))) 'a)) + (list ($avar 'a '(0 1 2)) ($var 'b '(1 2)))) + + +(define/contract (backtracking-solver + csp + #:select-variable [select-unassigned-variable (or (current-select-variable) first-unassigned-variable)] + #:order-values [order-domain-values (or (current-order-values) first-domain-value)] + #:inference [inference (or (current-inference) no-inference)]) + (($csp?) (#:select-variable procedure? #:order-values procedure? #:inference procedure?) . ->* . generator?) (generator () (let backtrack ([csp csp]) (match (select-unassigned-variable csp) @@ -124,28 +144,34 @@ [csp (inference csp name)]) (backtrack csp))))])))) -(define/contract (solve* csp [finish-proc $csp-vars][solution-limit +inf.0]) - (($csp?) (procedure? integer?) . ->* . (listof any/c)) - (for/list ([solution (in-producer (backtrack-solution-generator csp) (void))] - [idx (in-range solution-limit)]) +(define/contract (solve* csp + #:finish-proc [finish-proc $csp-vars] + #:solver [solver (or (current-solver) backtracking-solver)] + #:count [max-solutions +inf.0]) + (($csp?) (#:finish-proc procedure? #:solver generator? #:count integer?) . ->* . (listof any/c)) + (for/list ([solution (in-producer (solver csp) (void))] + [idx (in-range max-solutions)]) (finish-proc solution))) -(define/contract (solve csp [finish-proc $csp-vars]) - (($csp?) (procedure?) . ->* . (or/c #false any/c)) - (match (solve* csp finish-proc 1) +(define/contract (solve csp + #:finish-proc [finish-proc $csp-vars] + #:solver [solver (or (current-solver) backtracking-solver)]) + (($csp?) (#:finish-proc procedure? #:solver generator?) . ->* . (or/c #false any/c)) + (match (solve* csp #:finish-proc finish-proc #:solver solver #:count 1) [(list solution) solution] [else #false])) (define (<> a b) (not (= a b))) (define (neq? a b) (not (eq? a b))) -(parameterize ([current-inference forward-check]) - (time (solve* ($csp (list ($var 'a (range 3)) - ($var 'b (range 3)) - ($var 'c (range 3))) - (list ($constraint '(a b) <>) - ($constraint '(a c) <>) - ($constraint '(b c) <>)))))) +#;(parameterize ([current-inference forward-check]) + (time (solve* ($csp (list ($var 'a (range 3)) + ($var 'b (range 3)) + ($var 'c (range 3))) + (list ($constraint '(a b) <>) + ($constraint '(a c) <>) + ($constraint '(b c) <>)))))) + (parameterize ([current-inference forward-check]) (define vds (for/list ([k '(wa nsw t q nt v sa)]) ($var k '(red green blue)))) From 2ef93b91a1fbd03ed598f47cb0faedf794e0856b Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Thu, 18 Oct 2018 21:53:48 -0700 Subject: [PATCH 146/246] pasts --- csp/hacs.rkt | 71 ++++++++++++++++++++++++++++------------------------ 1 file changed, 38 insertions(+), 33 deletions(-) diff --git a/csp/hacs.rkt b/csp/hacs.rkt index 1eb3d4b9..99e8aab3 100644 --- a/csp/hacs.rkt +++ b/csp/hacs.rkt @@ -5,9 +5,14 @@ (struct $csp ([vars #:mutable] [constraints #:mutable]) #:transparent) (struct $constraint (names proc) #:transparent) -(struct $var (name vals) #:transparent) +(struct $var (name vals past conflicts) #:transparent) +(define (+$var name vals [past null] [conflicts null]) + ($var name vals past conflicts)) + (define $var-name? symbol?) (struct $avar $var () #:transparent) +(define (+$avar name vals [past null] [conflicts null]) + ($avar name vals past conflicts)) (struct inconsistency-signal (csp) #:transparent) (define current-select-variable (make-parameter #f)) @@ -40,7 +45,7 @@ ($csp (for/list ([var ($csp-vars csp)]) (if (eq? name ($var-name var)) - ($avar name (list val)) + (+$avar name (list val)) var)) ($csp-constraints csp))) @@ -50,11 +55,11 @@ #:unless ($avar? var)) var)) -(check-equal? (first-unassigned-variable ($csp (list ($var 'a (range 3)) ($var 'b (range 3))) null)) - ($var 'a (range 3))) -(check-equal? (first-unassigned-variable ($csp (list ($avar 'a (range 3)) ($var 'b (range 3))) null)) - ($var 'b (range 3))) -(check-false (first-unassigned-variable ($csp (list ($avar 'a (range 3)) ($avar 'b (range 3))) null))) +(check-equal? (first-unassigned-variable ($csp (list (+$var 'a (range 3)) (+$var 'b (range 3))) null)) + (+$var 'a (range 3))) +(check-equal? (first-unassigned-variable ($csp (list (+$avar 'a (range 3)) (+$var 'b (range 3))) null)) + (+$var 'b (range 3))) +(check-false (first-unassigned-variable ($csp (list (+$avar 'a (range 3)) (+$avar 'b (range 3))) null))) (define first-domain-value values) @@ -72,59 +77,59 @@ ($csp? $var-name? . -> . $csp?) (define aval (first ($csp-vals csp aname))) (define (filter-vals var) - (match-define ($var name vals) var) - (define new-vals - (match (($csp-constraints csp) . relating . (list aname name)) - [(? empty?) vals] - [constraints + (match-define ($var name vals _ _) var) + (match (($csp-constraints csp) . relating . (list aname name)) + [(? empty?) var] + [constraints + (define new-vals (for/list ([val (in-list vals)] #:when (for/and ([constraint (in-list constraints)]) (let ([proc ($constraint-proc constraint)]) (if (eq? name (first ($constraint-names constraint))) (proc val aval) (proc aval val))))) - val)])) - (unless (pair? new-vals) - (raise (inconsistency-signal csp))) - new-vals) + val)) + (unless (pair? new-vals) + (raise (inconsistency-signal csp))) + (+$var name new-vals (cons aname ($var-past var)) ($var-conflicts var))])) ($csp (for/list ([var (in-list ($csp-vars csp))]) (if ($avar? var) var - ($var ($var-name var) (filter-vals var)))) + (filter-vals var))) ($csp-constraints csp))) (check-equal? - ($csp-vars (forward-check ($csp (list ($avar 'a '(1)) ($var 'b (range 2))) null) 'a)) - (list ($avar 'a '(1)) ($var 'b '(0 1)))) + ($csp-vars (forward-check ($csp (list (+$avar 'a '(1)) (+$var 'b (range 2))) null) 'a)) + (list (+$avar 'a '(1)) (+$var 'b '(0 1)))) (check-equal? ;; no inconsistency: b≠c not checked when fc is relative to a - ($csp-vars (forward-check ($csp (list ($avar 'a '(1)) ($var 'b (range 2)) ($var 'c '(0))) + ($csp-vars (forward-check ($csp (list (+$avar 'a '(1)) (+$var 'b (range 2)) (+$var 'c '(0))) (list ($constraint '(a b) (negate =)) ($constraint '(b c) (negate =)))) 'a)) - (list ($avar 'a '(1)) ($var 'b '(0)) ($var 'c '(0)))) + (list (+$avar 'a '(1)) (+$var 'b '(0) '(a)) (+$var 'c '(0)))) (check-equal? ;; no inconsistency: a≠b not checked when fc ignores a, which is already assigned - ($csp-vars (forward-check ($csp (list ($avar 'a '(1)) ($avar 'b '(1)) ($var 'c (range 2))) + ($csp-vars (forward-check ($csp (list (+$avar 'a '(1)) (+$avar 'b '(1)) (+$var 'c (range 2))) (list ($constraint '(a b) (negate =)) ($constraint '(b c) (negate =)))) 'b)) - (list ($avar 'a '(1)) ($avar 'b '(1)) ($var 'c '(0)))) + (list (+$avar 'a '(1)) (+$avar 'b '(1)) (+$var 'c '(0) '(b)))) (check-exn inconsistency-signal? - (λ () ($csp-vars (forward-check ($csp (list ($avar 'a '(1)) - ($var 'b '(1))) + (λ () ($csp-vars (forward-check ($csp (list (+$avar 'a '(1)) + (+$var 'b '(1))) (list ($constraint '(a b) (negate =)))) 'a)))) -(check-equal? ($csp-vars (forward-check ($csp (list ($avar 'a (range 3)) - ($var 'b (range 3))) +(check-equal? ($csp-vars (forward-check ($csp (list (+$avar 'a (range 3)) + (+$var 'b (range 3))) (list ($constraint '(a b) <) ($constraint '(a b) <) ($constraint '(a b) <))) 'a)) - (list ($avar 'a '(0 1 2)) ($var 'b '(1 2)))) + (list (+$avar 'a '(0 1 2)) (+$var 'b '(1 2) '(a)))) (define/contract (backtracking-solver @@ -137,7 +142,7 @@ (let backtrack ([csp csp]) (match (select-unassigned-variable csp) [#false (yield csp)] - [($var name vals) + [($var name vals _ _) (for ([val (in-list (order-domain-values vals))]) (with-handlers ([inconsistency-signal? void]) (let* ([csp (assign-val csp name val)] @@ -165,16 +170,16 @@ (define (neq? a b) (not (eq? a b))) #;(parameterize ([current-inference forward-check]) - (time (solve* ($csp (list ($var 'a (range 3)) - ($var 'b (range 3)) - ($var 'c (range 3))) + (time (solve* ($csp (list (+$var 'a (range 3)) + (+$var 'b (range 3)) + (+$var 'c (range 3))) (list ($constraint '(a b) <>) ($constraint '(a c) <>) ($constraint '(b c) <>)))))) (parameterize ([current-inference forward-check]) (define vds (for/list ([k '(wa nsw t q nt v sa)]) - ($var k '(red green blue)))) + (+$var k '(red green blue)))) (define cs (list ($constraint '(wa nt) neq?) ($constraint '(wa sa) neq?) From fa87b1b606ac8ec04594275e90bd88cbb847cc9e Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Thu, 18 Oct 2018 23:49:59 -0700 Subject: [PATCH 147/246] stranger --- csp/hacs.rkt | 46 ++++++++++++++++++++++++++++++++++++---------- 1 file changed, 36 insertions(+), 10 deletions(-) diff --git a/csp/hacs.rkt b/csp/hacs.rkt index 99e8aab3..95648900 100644 --- a/csp/hacs.rkt +++ b/csp/hacs.rkt @@ -49,6 +49,16 @@ var)) ($csp-constraints csp))) +(define/contract (update-conflicts csp name conflicts) + ($csp? $var-name? (listof $var-name?) . -> . $csp?) + ($csp + (for/list ([var ($csp-vars csp)]) + (match var + [($var (? (λ (x) (eq? x name))) vals past _) + (+$avar name vals past conflicts)] + [else var])) + ($csp-constraints csp))) + (define/contract (first-unassigned-variable csp) ($csp? . -> . (or/c #false (and/c $var? (not/c $avar?)))) (for/first ([var (in-list ($csp-vars csp))] @@ -75,9 +85,10 @@ (define/contract (forward-check csp aname) ($csp? $var-name? . -> . $csp?) + #R csp (define aval (first ($csp-vals csp aname))) (define (filter-vals var) - (match-define ($var name vals _ _) var) + (match-define ($var name vals past conflicts) var) (match (($csp-constraints csp) . relating . (list aname name)) [(? empty?) var] [constraints @@ -90,8 +101,8 @@ (proc aval val))))) val)) (unless (pair? new-vals) - (raise (inconsistency-signal csp))) - (+$var name new-vals (cons aname ($var-past var)) ($var-conflicts var))])) + (raise (inconsistency-signal past))) + (+$var name new-vals (cons aname past) conflicts)])) ($csp (for/list ([var (in-list ($csp-vars csp))]) @@ -101,9 +112,16 @@ ($csp-constraints csp))) (check-equal? + ;; no forward checking when no constraints ($csp-vars (forward-check ($csp (list (+$avar 'a '(1)) (+$var 'b (range 2))) null) 'a)) (list (+$avar 'a '(1)) (+$var 'b '(0 1)))) +(check-equal? + ($csp-vars (forward-check (forward-check ($csp (list (+$avar 'a '(1)) (+$avar 'b '(0)) (+$var 'c '(0 1 2))) + (list ($constraint '(a c) (negate =)) + ($constraint '(b c) (negate =)))) 'a) 'b)) + (list (+$avar 'a '(1)) (+$avar 'b '(0) '()) (+$var 'c '(2) '(b a)))) + (check-equal? ;; no inconsistency: b≠c not checked when fc is relative to a ($csp-vars (forward-check ($csp (list (+$avar 'a '(1)) (+$var 'b (range 2)) (+$var 'c '(0))) @@ -143,11 +161,19 @@ (match (select-unassigned-variable csp) [#false (yield csp)] [($var name vals _ _) - (for ([val (in-list (order-domain-values vals))]) - (with-handlers ([inconsistency-signal? void]) + (for/fold ([conflicts null] + #:result (void)) + ([val (in-list (order-domain-values vals))]) + #R conflicts + (with-handlers ([inconsistency-signal? + (λ (sig) + (match sig + [(inconsistency-signal new-conflicts) + (append new-conflicts conflicts)]))]) (let* ([csp (assign-val csp name val)] [csp (inference csp name)]) - (backtrack csp))))])))) + (backtrack csp)) + conflicts))])))) (define/contract (solve* csp #:finish-proc [finish-proc $csp-vars] @@ -169,10 +195,10 @@ (define (<> a b) (not (= a b))) (define (neq? a b) (not (eq? a b))) -#;(parameterize ([current-inference forward-check]) - (time (solve* ($csp (list (+$var 'a (range 3)) - (+$var 'b (range 3)) - (+$var 'c (range 3))) +(parameterize ([current-inference forward-check]) + (time (solve* ($csp (list (+$var 'a '(1)) + (+$var 'b '(1)) + (+$var 'c '(1))) (list ($constraint '(a b) <>) ($constraint '(a c) <>) ($constraint '(b c) <>)))))) From d80cfd42128a532433e60513ad5edf14f4af239a Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Fri, 19 Oct 2018 00:00:31 -0700 Subject: [PATCH 148/246] conflicts? --- csp/hacs.rkt | 51 +++++++++++++++++++++++++-------------------------- 1 file changed, 25 insertions(+), 26 deletions(-) diff --git a/csp/hacs.rkt b/csp/hacs.rkt index 95648900..56c8a834 100644 --- a/csp/hacs.rkt +++ b/csp/hacs.rkt @@ -45,7 +45,7 @@ ($csp (for/list ([var ($csp-vars csp)]) (if (eq? name ($var-name var)) - (+$avar name (list val)) + (+$avar name (list val) ($var-past var) ($var-conflicts var)) var)) ($csp-constraints csp))) @@ -85,7 +85,6 @@ (define/contract (forward-check csp aname) ($csp? $var-name? . -> . $csp?) - #R csp (define aval (first ($csp-vals csp aname))) (define (filter-vals var) (match-define ($var name vals past conflicts) var) @@ -164,7 +163,6 @@ (for/fold ([conflicts null] #:result (void)) ([val (in-list (order-domain-values vals))]) - #R conflicts (with-handlers ([inconsistency-signal? (λ (sig) (match sig @@ -195,26 +193,27 @@ (define (<> a b) (not (= a b))) (define (neq? a b) (not (eq? a b))) -(parameterize ([current-inference forward-check]) - (time (solve* ($csp (list (+$var 'a '(1)) - (+$var 'b '(1)) - (+$var 'c '(1))) - (list ($constraint '(a b) <>) - ($constraint '(a c) <>) - ($constraint '(b c) <>)))))) - -(parameterize ([current-inference forward-check]) - (define vds (for/list ([k '(wa nsw t q nt v sa)]) - (+$var k '(red green blue)))) - (define cs (list - ($constraint '(wa nt) neq?) - ($constraint '(wa sa) neq?) - ($constraint '(nt sa) neq?) - ($constraint '(nt q) neq?) - ($constraint '(q sa) neq?) - ($constraint '(q nsw) neq?) - ($constraint '(nsw sa) neq?) - ($constraint '(nsw v) neq?) - ($constraint '(v sa) neq?))) - (define csp ($csp vds cs)) - (check-equal? (time (length (solve* csp))) 18)) \ No newline at end of file +(check-equal? + (parameterize ([current-inference forward-check]) + (length (solve* ($csp (list (+$var 'x (range 3)) + (+$var 'y (range 3)) + (+$var 'z (range 3))) + (list ($constraint '(x y) <>) + ($constraint '(x z) <>) + ($constraint '(y z) <>)))))) 6) + +#;(parameterize ([current-inference forward-check]) + (define vds (for/list ([k '(wa nsw t q nt v sa)]) + (+$var k '(red green blue)))) + (define cs (list + ($constraint '(wa nt) neq?) + ($constraint '(wa sa) neq?) + ($constraint '(nt sa) neq?) + ($constraint '(nt q) neq?) + ($constraint '(q sa) neq?) + ($constraint '(q nsw) neq?) + ($constraint '(nsw sa) neq?) + ($constraint '(nsw v) neq?) + ($constraint '(v sa) neq?))) + (define csp ($csp vds cs)) + (check-equal? (time (length (solve* csp))) 18)) \ No newline at end of file From cb4644cf80ed297c8052744d74090bd31cbd67d1 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Fri, 19 Oct 2018 00:18:20 -0700 Subject: [PATCH 149/246] give --- csp/hacs.rkt | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/csp/hacs.rkt b/csp/hacs.rkt index 56c8a834..2fb90d0b 100644 --- a/csp/hacs.rkt +++ b/csp/hacs.rkt @@ -161,7 +161,7 @@ [#false (yield csp)] [($var name vals _ _) (for/fold ([conflicts null] - #:result (void)) + #:result (void conflicts)) ([val (in-list (order-domain-values vals))]) (with-handlers ([inconsistency-signal? (λ (sig) @@ -202,7 +202,7 @@ ($constraint '(x z) <>) ($constraint '(y z) <>)))))) 6) -#;(parameterize ([current-inference forward-check]) +(parameterize ([current-inference forward-check]) (define vds (for/list ([k '(wa nsw t q nt v sa)]) (+$var k '(red green blue)))) (define cs (list From 2e3a5d3fa01d6ed9e0c9036a67ca6f6fb46b8b8e Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Fri, 19 Oct 2018 07:14:00 -0700 Subject: [PATCH 150/246] nova --- csp/hacs.rkt | 73 ++++++++++++++++++++++++++++------------------------ 1 file changed, 39 insertions(+), 34 deletions(-) diff --git a/csp/hacs.rkt b/csp/hacs.rkt index 2fb90d0b..6cb8d28e 100644 --- a/csp/hacs.rkt +++ b/csp/hacs.rkt @@ -6,15 +6,17 @@ [constraints #:mutable]) #:transparent) (struct $constraint (names proc) #:transparent) (struct $var (name vals past conflicts) #:transparent) -(define (+$var name vals [past null] [conflicts null]) +(define (+var name vals [past null] [conflicts null]) ($var name vals past conflicts)) (define $var-name? symbol?) (struct $avar $var () #:transparent) -(define (+$avar name vals [past null] [conflicts null]) +(define (+avar name vals [past null] [conflicts null]) ($avar name vals past conflicts)) (struct inconsistency-signal (csp) #:transparent) +(struct $conflict (names) #:transparent) + (define current-select-variable (make-parameter #f)) (define current-order-values (make-parameter #f)) (define current-inference (make-parameter #f)) @@ -45,7 +47,7 @@ ($csp (for/list ([var ($csp-vars csp)]) (if (eq? name ($var-name var)) - (+$avar name (list val) ($var-past var) ($var-conflicts var)) + (+avar name (list val) ($var-past var) ($var-conflicts var)) var)) ($csp-constraints csp))) @@ -55,7 +57,7 @@ (for/list ([var ($csp-vars csp)]) (match var [($var (? (λ (x) (eq? x name))) vals past _) - (+$avar name vals past conflicts)] + (+avar name vals past conflicts)] [else var])) ($csp-constraints csp))) @@ -65,11 +67,11 @@ #:unless ($avar? var)) var)) -(check-equal? (first-unassigned-variable ($csp (list (+$var 'a (range 3)) (+$var 'b (range 3))) null)) - (+$var 'a (range 3))) -(check-equal? (first-unassigned-variable ($csp (list (+$avar 'a (range 3)) (+$var 'b (range 3))) null)) - (+$var 'b (range 3))) -(check-false (first-unassigned-variable ($csp (list (+$avar 'a (range 3)) (+$avar 'b (range 3))) null))) +(check-equal? (first-unassigned-variable ($csp (list (+var 'a (range 3)) (+var 'b (range 3))) null)) + (+var 'a (range 3))) +(check-equal? (first-unassigned-variable ($csp (list (+avar 'a (range 3)) (+var 'b (range 3))) null)) + (+var 'b (range 3))) +(check-false (first-unassigned-variable ($csp (list (+avar 'a (range 3)) (+avar 'b (range 3))) null))) (define first-domain-value values) @@ -100,8 +102,8 @@ (proc aval val))))) val)) (unless (pair? new-vals) - (raise (inconsistency-signal past))) - (+$var name new-vals (cons aname past) conflicts)])) + (raise ($conflict past))) + (+var name new-vals (cons aname past) conflicts)])) ($csp (for/list ([var (in-list ($csp-vars csp))]) @@ -112,41 +114,41 @@ (check-equal? ;; no forward checking when no constraints - ($csp-vars (forward-check ($csp (list (+$avar 'a '(1)) (+$var 'b (range 2))) null) 'a)) - (list (+$avar 'a '(1)) (+$var 'b '(0 1)))) + ($csp-vars (forward-check ($csp (list (+avar 'a '(1)) (+var 'b (range 2))) null) 'a)) + (list (+avar 'a '(1)) (+var 'b '(0 1)))) (check-equal? - ($csp-vars (forward-check (forward-check ($csp (list (+$avar 'a '(1)) (+$avar 'b '(0)) (+$var 'c '(0 1 2))) + ($csp-vars (forward-check (forward-check ($csp (list (+avar 'a '(1)) (+avar 'b '(0)) (+var 'c '(0 1 2))) (list ($constraint '(a c) (negate =)) ($constraint '(b c) (negate =)))) 'a) 'b)) - (list (+$avar 'a '(1)) (+$avar 'b '(0) '()) (+$var 'c '(2) '(b a)))) + (list (+avar 'a '(1)) (+avar 'b '(0) '()) (+var 'c '(2) '(b a)))) (check-equal? ;; no inconsistency: b≠c not checked when fc is relative to a - ($csp-vars (forward-check ($csp (list (+$avar 'a '(1)) (+$var 'b (range 2)) (+$var 'c '(0))) + ($csp-vars (forward-check ($csp (list (+avar 'a '(1)) (+var 'b (range 2)) (+var 'c '(0))) (list ($constraint '(a b) (negate =)) ($constraint '(b c) (negate =)))) 'a)) - (list (+$avar 'a '(1)) (+$var 'b '(0) '(a)) (+$var 'c '(0)))) + (list (+avar 'a '(1)) (+var 'b '(0) '(a)) (+var 'c '(0)))) (check-equal? ;; no inconsistency: a≠b not checked when fc ignores a, which is already assigned - ($csp-vars (forward-check ($csp (list (+$avar 'a '(1)) (+$avar 'b '(1)) (+$var 'c (range 2))) + ($csp-vars (forward-check ($csp (list (+avar 'a '(1)) (+avar 'b '(1)) (+var 'c (range 2))) (list ($constraint '(a b) (negate =)) ($constraint '(b c) (negate =)))) 'b)) - (list (+$avar 'a '(1)) (+$avar 'b '(1)) (+$var 'c '(0) '(b)))) + (list (+avar 'a '(1)) (+avar 'b '(1)) (+var 'c '(0) '(b)))) -(check-exn inconsistency-signal? - (λ () ($csp-vars (forward-check ($csp (list (+$avar 'a '(1)) - (+$var 'b '(1))) +(check-exn $conflict? + (λ () ($csp-vars (forward-check ($csp (list (+avar 'a '(1)) + (+var 'b '(1))) (list ($constraint '(a b) (negate =)))) 'a)))) -(check-equal? ($csp-vars (forward-check ($csp (list (+$avar 'a (range 3)) - (+$var 'b (range 3))) +(check-equal? ($csp-vars (forward-check ($csp (list (+avar 'a (range 3)) + (+var 'b (range 3))) (list ($constraint '(a b) <) ($constraint '(a b) <) ($constraint '(a b) <))) 'a)) - (list (+$avar 'a '(0 1 2)) (+$var 'b '(1 2) '(a)))) + (list (+avar 'a '(0 1 2)) (+var 'b '(1 2) '(a)))) (define/contract (backtracking-solver @@ -163,11 +165,14 @@ (for/fold ([conflicts null] #:result (void conflicts)) ([val (in-list (order-domain-values vals))]) - (with-handlers ([inconsistency-signal? - (λ (sig) - (match sig - [(inconsistency-signal new-conflicts) - (append new-conflicts conflicts)]))]) + (with-handlers ([$conflict? + (λ (c) + (match c + [($conflict names) (cond + [(empty? names) conflicts] + [(memq name names) + (append conflicts (remq name names))] + [else (raise c)])]))]) (let* ([csp (assign-val csp name val)] [csp (inference csp name)]) (backtrack csp)) @@ -195,16 +200,16 @@ (check-equal? (parameterize ([current-inference forward-check]) - (length (solve* ($csp (list (+$var 'x (range 3)) - (+$var 'y (range 3)) - (+$var 'z (range 3))) + (length (solve* ($csp (list (+var 'x (range 3)) + (+var 'y (range 3)) + (+var 'z (range 3))) (list ($constraint '(x y) <>) ($constraint '(x z) <>) ($constraint '(y z) <>)))))) 6) (parameterize ([current-inference forward-check]) (define vds (for/list ([k '(wa nsw t q nt v sa)]) - (+$var k '(red green blue)))) + (+var k '(red green blue)))) (define cs (list ($constraint '(wa nt) neq?) ($constraint '(wa sa) neq?) From 2eca36e674cbbd04dd2652e6fb2aa8fcd61b2328 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Fri, 19 Oct 2018 12:51:57 -0700 Subject: [PATCH 151/246] fc+cdj works --- csp/hacs-map.rkt | 58 +++++++++++++ csp/hacs-smm.rkt | 47 +++++++++++ csp/hacs-test.rkt | 71 ++++++++++++++++ csp/hacs.rkt | 210 +++++++++++++++++++--------------------------- 4 files changed, 262 insertions(+), 124 deletions(-) create mode 100644 csp/hacs-map.rkt create mode 100644 csp/hacs-smm.rkt create mode 100644 csp/hacs-test.rkt diff --git a/csp/hacs-map.rkt b/csp/hacs-map.rkt new file mode 100644 index 00000000..f843dafc --- /dev/null +++ b/csp/hacs-map.rkt @@ -0,0 +1,58 @@ +#lang debug racket +(require "hacs.rkt") +(module+ test (require rackunit)) + +(define (map-coloring-csp colors neighbors) + (define variables (remove-duplicates (flatten neighbors) eq?)) + (define vds (for/list ([var (in-list variables)]) + ($var var colors null))) + (define cs (for*/list ([neighbor neighbors] + [target (cdr neighbor)]) + ($constraint (list (car neighbor) target) neq?))) + ($csp vds cs)) + +(define (parse-colors str) (map string->symbol (map string-downcase (regexp-match* "." str)))) +(define(parse-neighbors str) + (define recs (map string-trim (string-split str ";"))) + (for/list ([rec recs]) + (match-define (cons head tail) (string-split rec ":")) + (map string->symbol (map string-downcase (map string-trim (cons head (string-split (if (pair? tail) + (car tail) + "")))))))) + + +(current-inference forward-check) +(current-select-variable minimum-remaining-values) +(define aus (map-coloring-csp (parse-colors "RGB") + (parse-neighbors "SA: WA NT Q NSW V; NT: WA Q; NSW: Q V; T: "))) + +(module+ test + (check-equal? (length (solve* aus)) 18)) + +(define usa (map-coloring-csp (parse-colors "RGBY") + (parse-neighbors "WA: OR ID; OR: ID NV CA; CA: NV AZ; NV: ID UT AZ; ID: MT WY UT; + UT: WY CO AZ; MT: ND SD WY; WY: SD NE CO; CO: NE KA OK NM; NM: OK TX; + ND: MN SD; SD: MN IA NE; NE: IA MO KA; KA: MO OK; OK: MO AR TX; + TX: AR LA; MN: WI IA; IA: WI IL MO; MO: IL KY TN AR; AR: MS TN LA; + LA: MS; WI: MI IL; IL: IN KY; IN: OH KY; MS: TN AL; AL: TN GA FL; + MI: OH IN; OH: PA WV KY; KY: WV VA TN; TN: VA NC GA; GA: NC SC FL; + PA: NY NJ DE MD WV; WV: MD VA; VA: MD DC NC; NC: SC; NY: VT MA CT NJ; + NJ: DE; DE: MD; MD: DC; VT: NH MA; MA: NH RI CT; CT: RI; ME: NH; + HI: ; AK:"))) + +(module+ test + (check-true (pair? (solve usa)))) + +(define fr (map-coloring-csp (parse-colors "RGBY") + (parse-neighbors "AL: LO FC; AQ: MP LI PC; AU: LI CE BO RA LR MP; BO: CE IF CA FC RA + AU; BR: NB PL; CA: IF PI LO FC BO; CE: PL NB NH IF BO AU LI PC; FC: BO + CA LO AL RA; IF: NH PI CA BO CE; LI: PC CE AU MP AQ; LO: CA AL FC; LR: + MP AU RA PA; MP: AQ LI AU LR; NB: NH CE PL BR; NH: PI IF CE NB; NO: + PI; PA: LR RA; PC: PL CE LI AQ; PI: NH NO CA IF; PL: BR NB CE PC; RA: + AU BO FC PA LR"))) + +(module+ test +(check-true (pair? (solve fr)))) + +(module+ main + (solve aus)) \ No newline at end of file diff --git a/csp/hacs-smm.rkt b/csp/hacs-smm.rkt new file mode 100644 index 00000000..58e9ac67 --- /dev/null +++ b/csp/hacs-smm.rkt @@ -0,0 +1,47 @@ +#lang br +(require "hacs.rkt") + +; SEND +;+ MORE +;------ +; MONEY + +(define $vd +var) + +(define (word-value . xs) + (for/sum ([(x idx) (in-indexed (reverse xs))]) + (* x (expt 10 idx)))) + +(define vs '(s e n d m o r y)) +(define vds (for/list ([k vs]) + ($vd k (range 10)))) + +(define (not= x y) (not (= x y))) + +(define alldiffs + (for/list ([pr (in-combinations vs 2)]) + ($constraint pr not=))) + +(define (smm-func s e n d m o r y) + (= (+ (word-value s e n d) (word-value m o r e)) (word-value m o n e y))) + +(define csp ($csp vds (append + + alldiffs + (list + ($constraint vs smm-func) + ($constraint '(s) positive?) + ($constraint '(m) (λ (x) (= 1 x))) + ($constraint '(d e y) (λ (d e y) (= (modulo (+ d e) 10) y))) + ($constraint '(n d r e y) (λ (n d r e y) + (= (modulo (+ (word-value n d) (word-value r e)) 100) + (word-value e y)))) + ($constraint '(e n d o r y) (λ (e n d o r y) + (= (modulo (+ (word-value e n d) (word-value o r e)) 1000) (word-value n e y)))))))) +(parameterize ([current-select-variable mrv] + [current-order-values lcv] + [current-inference mac]) + (time (solve csp))) +(nassigns csp) +(nchecks csp) +(reset! csp) \ No newline at end of file diff --git a/csp/hacs-test.rkt b/csp/hacs-test.rkt new file mode 100644 index 00000000..94f2aad3 --- /dev/null +++ b/csp/hacs-test.rkt @@ -0,0 +1,71 @@ +#lang debug racket +(require "hacs.rkt" rackunit) + +(check-equal? (first-unassigned-variable ($csp (list (+var 'a (range 3)) (+var 'b (range 3))) null)) + (+var 'a (range 3))) +(check-equal? (first-unassigned-variable ($csp (list (+avar 'a (range 3)) (+var 'b (range 3))) null)) + (+var 'b (range 3))) +(check-false (first-unassigned-variable ($csp (list (+avar 'a (range 3)) (+avar 'b (range 3))) null))) + +(check-equal? + ;; no forward checking when no constraints + ($csp-vars (forward-check ($csp (list (+avar 'a '(1)) (+var 'b (range 2))) null) 'a)) + (list (+avar 'a '(1)) (+var 'b '(0 1)))) + +(check-equal? + ($csp-vars (forward-check (forward-check ($csp (list (+avar 'a '(1)) (+avar 'b '(0)) (+var 'c '(0 1 2))) + (list ($constraint '(a c) (negate =)) + ($constraint '(b c) (negate =)))) 'a) 'b)) + (list (+avar 'a '(1)) (+avar 'b '(0) '()) (+var 'c '(2) '(b a)))) + +(check-equal? + ;; no inconsistency: b≠c not checked when fc is relative to a + ($csp-vars (forward-check ($csp (list (+avar 'a '(1)) (+var 'b (range 2)) (+var 'c '(0))) + (list ($constraint '(a b) (negate =)) + ($constraint '(b c) (negate =)))) 'a)) + (list (+avar 'a '(1)) (+var 'b '(0) '(a)) (+var 'c '(0)))) + +(check-equal? + ;; no inconsistency: a≠b not checked when fc ignores a, which is already assigned + ($csp-vars (forward-check ($csp (list (+avar 'a '(1)) (+avar 'b '(1)) (+var 'c (range 2))) + (list ($constraint '(a b) (negate =)) + ($constraint '(b c) (negate =)))) 'b)) + (list (+avar 'a '(1)) (+avar 'b '(1)) (+var 'c '(0) '(b)))) + +(check-exn $backtrack? + (λ () ($csp-vars (forward-check ($csp (list (+avar 'a '(1)) + (+var 'b '(1))) + (list ($constraint '(a b) (negate =)))) 'a)))) + + +(check-equal? ($csp-vars (forward-check ($csp (list (+avar 'a (range 3)) + (+var 'b (range 3))) + (list ($constraint '(a b) <) + ($constraint '(a b) <) + ($constraint '(a b) <))) 'a)) + (list (+avar 'a '(0 1 2)) (+var 'b '(1 2) '(a)))) + +(check-equal? + (parameterize ([current-inference forward-check]) + (length (solve* ($csp (list (+var 'x (range 3)) + (+var 'y (range 3)) + (+var 'z (range 3))) + (list ($constraint '(x y) <>) + ($constraint '(x z) <>) + ($constraint '(y z) <>)))))) 6) + +(parameterize ([current-inference forward-check]) + (define vds (for/list ([k '(wa nt nsw q t v sa)]) + (+var k '(red green blue)))) + (define cs (list + ($constraint '(wa nt) neq?) + ($constraint '(wa sa) neq?) + ($constraint '(nt sa) neq?) + ($constraint '(nt q) neq?) + ($constraint '(q sa) neq?) + ($constraint '(q nsw) neq?) + ($constraint '(nsw sa) neq?) + ($constraint '(nsw v) neq?) + ($constraint '(v sa) neq?))) + (define csp ($csp vds cs)) + (check-equal? (length (solve* csp)) 18)) \ No newline at end of file diff --git a/csp/hacs.rkt b/csp/hacs.rkt index 6cb8d28e..210bc391 100644 --- a/csp/hacs.rkt +++ b/csp/hacs.rkt @@ -1,27 +1,27 @@ #lang debug racket -(require racket/generator sugar graph rackunit math) +(require racket/generator) (provide (all-defined-out)) (struct $csp ([vars #:mutable] [constraints #:mutable]) #:transparent) (struct $constraint (names proc) #:transparent) -(struct $var (name vals past conflicts) #:transparent) -(define (+var name vals [past null] [conflicts null]) - ($var name vals past conflicts)) +(struct $var (name domain past) #:transparent) +(define (+var name vals [past null]) + ($var name vals past)) (define $var-name? symbol?) (struct $avar $var () #:transparent) -(define (+avar name vals [past null] [conflicts null]) - ($avar name vals past conflicts)) +(define (+avar name vals [past null]) + ($avar name vals past)) (struct inconsistency-signal (csp) #:transparent) -(struct $conflict (names) #:transparent) +(struct $backtrack (names) #:transparent) (define current-select-variable (make-parameter #f)) (define current-order-values (make-parameter #f)) (define current-inference (make-parameter #f)) (define current-solver (make-parameter #f)) - +(define current-shuffle (make-parameter #t)) (define/contract (check-name-in-csp! caller csp name) (symbol? $csp? $var-name? . -> . void?) @@ -39,7 +39,7 @@ (define/contract ($csp-vals csp name) ($csp? $var-name? . -> . (listof any/c)) (check-name-in-csp! '$csp-vals csp name) - ($var-vals ($csp-var csp name))) + ($var-domain ($csp-var csp name))) (define order-domain-values values) (define/contract (assign-val csp name val) @@ -47,7 +47,7 @@ ($csp (for/list ([var ($csp-vars csp)]) (if (eq? name ($var-name var)) - (+avar name (list val) ($var-past var) ($var-conflicts var)) + (+avar name (list val) ($var-past var)) var)) ($csp-constraints csp))) @@ -56,22 +56,34 @@ ($csp (for/list ([var ($csp-vars csp)]) (match var - [($var (? (λ (x) (eq? x name))) vals past _) + [($var (? (λ (x) (eq? x name))) vals past) (+avar name vals past conflicts)] [else var])) ($csp-constraints csp))) +(define (unassigned-vars csp) + (for/list ([var (in-list ($csp-vars csp))] + #:unless ($avar? var)) + var)) + (define/contract (first-unassigned-variable csp) ($csp? . -> . (or/c #false (and/c $var? (not/c $avar?)))) - (for/first ([var (in-list ($csp-vars csp))] - #:unless ($avar? var)) - var)) + (match (unassigned-vars csp) + [(? empty?) #false] + [xs (first xs)])) + +(define/contract (argmin-random-tie proc xs) + (procedure? (non-empty-listof any/c) . -> . any/c) + (define ordered-xs (sort xs < #:key proc)) + (first ((if (current-shuffle) shuffle values) + (takef ordered-xs (λ (x) (= (proc (car ordered-xs)) (proc x))))))) -(check-equal? (first-unassigned-variable ($csp (list (+var 'a (range 3)) (+var 'b (range 3))) null)) - (+var 'a (range 3))) -(check-equal? (first-unassigned-variable ($csp (list (+avar 'a (range 3)) (+var 'b (range 3))) null)) - (+var 'b (range 3))) -(check-false (first-unassigned-variable ($csp (list (+avar 'a (range 3)) (+avar 'b (range 3))) null))) +(define/contract (minimum-remaining-values csp) + ($csp? . -> . (or/c #false (and/c $var? (not/c $avar?)))) + (struct $mrv-rec (var num) #:transparent) + (match (unassigned-vars csp) + [(? empty?) #false] + [xs (argmin-random-tie (λ (var) (length ($var-domain var))) xs)])) (define first-domain-value values) @@ -88,109 +100,83 @@ (define/contract (forward-check csp aname) ($csp? $var-name? . -> . $csp?) (define aval (first ($csp-vals csp aname))) - (define (filter-vals var) - (match-define ($var name vals past conflicts) var) - (match (($csp-constraints csp) . relating . (list aname name)) - [(? empty?) var] - [constraints - (define new-vals - (for/list ([val (in-list vals)] - #:when (for/and ([constraint (in-list constraints)]) - (let ([proc ($constraint-proc constraint)]) - (if (eq? name (first ($constraint-names constraint))) - (proc val aval) - (proc aval val))))) - val)) - (unless (pair? new-vals) - (raise ($conflict past))) - (+var name new-vals (cons aname past) conflicts)])) - - ($csp - (for/list ([var (in-list ($csp-vars csp))]) - (if ($avar? var) - var - (filter-vals var))) - ($csp-constraints csp))) - -(check-equal? - ;; no forward checking when no constraints - ($csp-vars (forward-check ($csp (list (+avar 'a '(1)) (+var 'b (range 2))) null) 'a)) - (list (+avar 'a '(1)) (+var 'b '(0 1)))) - -(check-equal? - ($csp-vars (forward-check (forward-check ($csp (list (+avar 'a '(1)) (+avar 'b '(0)) (+var 'c '(0 1 2))) - (list ($constraint '(a c) (negate =)) - ($constraint '(b c) (negate =)))) 'a) 'b)) - (list (+avar 'a '(1)) (+avar 'b '(0) '()) (+var 'c '(2) '(b a)))) - -(check-equal? - ;; no inconsistency: b≠c not checked when fc is relative to a - ($csp-vars (forward-check ($csp (list (+avar 'a '(1)) (+var 'b (range 2)) (+var 'c '(0))) - (list ($constraint '(a b) (negate =)) - ($constraint '(b c) (negate =)))) 'a)) - (list (+avar 'a '(1)) (+var 'b '(0) '(a)) (+var 'c '(0)))) - -(check-equal? - ;; no inconsistency: a≠b not checked when fc ignores a, which is already assigned - ($csp-vars (forward-check ($csp (list (+avar 'a '(1)) (+avar 'b '(1)) (+var 'c (range 2))) - (list ($constraint '(a b) (negate =)) - ($constraint '(b c) (negate =)))) 'b)) - (list (+avar 'a '(1)) (+avar 'b '(1)) (+var 'c '(0) '(b)))) - -(check-exn $conflict? - (λ () ($csp-vars (forward-check ($csp (list (+avar 'a '(1)) - (+var 'b '(1))) - (list ($constraint '(a b) (negate =)))) 'a)))) - - -(check-equal? ($csp-vars (forward-check ($csp (list (+avar 'a (range 3)) - (+var 'b (range 3))) - (list ($constraint '(a b) <) - ($constraint '(a b) <) - ($constraint '(a b) <))) 'a)) - (list (+avar 'a '(0 1 2)) (+var 'b '(1 2) '(a)))) - + (define (check-var var) + (match var + [(? $avar?) var] + [($var name vals past) + (match (($csp-constraints csp) . relating . (list aname name)) + [(? empty?) var] + [constraints + (define new-vals + (for/list ([val (in-list vals)] + #:when (for/and ([constraint (in-list constraints)]) + (let ([proc ($constraint-proc constraint)]) + (if (eq? name (first ($constraint-names constraint))) + (proc val aval) + (proc aval val))))) + val)) + (+var name new-vals (cons aname past))])])) + (define checked-vars (map check-var ($csp-vars csp))) + ;; conflict-set will be empty if there are no empty domains + (define conflict-set (for*/list ([var (in-list checked-vars)] + #:when (empty? ($var-domain var)) + [name (in-list ($var-past var))]) + name)) + ;; for conflict-directed backjumping it's essential to forward-check ALL vars + ;; (even after an empty domain is generated) and combine their conflicts + ;; so we can discover the *most recent past var* that could be the culprit. + ;; If we just bail out at the first conflict, we may backjump too far based on its history + ;; (and thereby miss parts of the search tree) + (when (pair? conflict-set) + (raise ($backtrack conflict-set))) + ($csp checked-vars ($csp-constraints csp))) (define/contract (backtracking-solver csp - #:select-variable [select-unassigned-variable (or (current-select-variable) first-unassigned-variable)] + #:select-variable [select-unassigned-variable + (or (current-select-variable) first-unassigned-variable)] #:order-values [order-domain-values (or (current-order-values) first-domain-value)] #:inference [inference (or (current-inference) no-inference)]) (($csp?) (#:select-variable procedure? #:order-values procedure? #:inference procedure?) . ->* . generator?) (generator () - (let backtrack ([csp csp]) + (let loop ([csp csp]) (match (select-unassigned-variable csp) [#false (yield csp)] - [($var name vals _ _) + [($var name domain _) + (define (wants-backtrack? exn) + (and ($backtrack? exn) (memq name ($backtrack-names exn)))) (for/fold ([conflicts null] - #:result (void conflicts)) - ([val (in-list (order-domain-values vals))]) - (with-handlers ([$conflict? - (λ (c) - (match c - [($conflict names) (cond - [(empty? names) conflicts] - [(memq name names) - (append conflicts (remq name names))] - [else (raise c)])]))]) - (let* ([csp (assign-val csp name val)] - [csp (inference csp name)]) - (backtrack csp)) - conflicts))])))) + #:result (void)) + ([val (in-list (order-domain-values domain))]) + (with-handlers ([wants-backtrack? + (λ (bt) (append conflicts (remq name ($backtrack-names bt))))]) + (define csp-with-assignment (assign-val csp name val)) + (loop (inference csp-with-assignment name))) + conflicts)])))) + +(define/contract (solution-consistent? solution) + ($csp? . -> . boolean?) + (for/and ([c (in-list ($csp-constraints solution))]) + (apply ($constraint-proc c) (for*/list ([name (in-list ($constraint-names c))] + [var (in-list ($csp-vars solution))] + #:when (eq? name ($var-name var))) + (first ($var-domain var)))))) (define/contract (solve* csp #:finish-proc [finish-proc $csp-vars] #:solver [solver (or (current-solver) backtracking-solver)] #:count [max-solutions +inf.0]) - (($csp?) (#:finish-proc procedure? #:solver generator? #:count integer?) . ->* . (listof any/c)) + (($csp?) (#:finish-proc procedure? #:solver procedure? #:count integer?) . ->* . (listof any/c)) (for/list ([solution (in-producer (solver csp) (void))] [idx (in-range max-solutions)]) + (unless (solution-consistent? solution) + (raise (list 'wtf solution))) (finish-proc solution))) (define/contract (solve csp #:finish-proc [finish-proc $csp-vars] #:solver [solver (or (current-solver) backtracking-solver)]) - (($csp?) (#:finish-proc procedure? #:solver generator?) . ->* . (or/c #false any/c)) + (($csp?) (#:finish-proc procedure? #:solver procedure?) . ->* . (or/c #false any/c)) (match (solve* csp #:finish-proc finish-proc #:solver solver #:count 1) [(list solution) solution] [else #false])) @@ -198,27 +184,3 @@ (define (<> a b) (not (= a b))) (define (neq? a b) (not (eq? a b))) -(check-equal? - (parameterize ([current-inference forward-check]) - (length (solve* ($csp (list (+var 'x (range 3)) - (+var 'y (range 3)) - (+var 'z (range 3))) - (list ($constraint '(x y) <>) - ($constraint '(x z) <>) - ($constraint '(y z) <>)))))) 6) - -(parameterize ([current-inference forward-check]) - (define vds (for/list ([k '(wa nsw t q nt v sa)]) - (+var k '(red green blue)))) - (define cs (list - ($constraint '(wa nt) neq?) - ($constraint '(wa sa) neq?) - ($constraint '(nt sa) neq?) - ($constraint '(nt q) neq?) - ($constraint '(q sa) neq?) - ($constraint '(q nsw) neq?) - ($constraint '(nsw sa) neq?) - ($constraint '(nsw v) neq?) - ($constraint '(v sa) neq?))) - (define csp ($csp vds cs)) - (check-equal? (time (length (solve* csp))) 18)) \ No newline at end of file From ff193429e5055efe7884a03cf3ca2999ead0fadf Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Fri, 19 Oct 2018 13:47:44 -0700 Subject: [PATCH 152/246] more --- csp/hacs-map.rkt | 4 +++- csp/hacs-test.rkt | 49 +++++++++++++++++++++++------------------------ csp/hacs.rkt | 48 +++++++++++++++++++++++----------------------- 3 files changed, 51 insertions(+), 50 deletions(-) diff --git a/csp/hacs-map.rkt b/csp/hacs-map.rkt index f843dafc..1a2e930d 100644 --- a/csp/hacs-map.rkt +++ b/csp/hacs-map.rkt @@ -5,7 +5,7 @@ (define (map-coloring-csp colors neighbors) (define variables (remove-duplicates (flatten neighbors) eq?)) (define vds (for/list ([var (in-list variables)]) - ($var var colors null))) + ($var var colors))) (define cs (for*/list ([neighbor neighbors] [target (cdr neighbor)]) ($constraint (list (car neighbor) target) neq?))) @@ -23,6 +23,8 @@ (current-inference forward-check) (current-select-variable minimum-remaining-values) +(current-order-values shuffle) + (define aus (map-coloring-csp (parse-colors "RGB") (parse-neighbors "SA: WA NT Q NSW V; NT: WA Q; NSW: Q V; T: "))) diff --git a/csp/hacs-test.rkt b/csp/hacs-test.rkt index 94f2aad3..873b81d6 100644 --- a/csp/hacs-test.rkt +++ b/csp/hacs-test.rkt @@ -1,62 +1,61 @@ #lang debug racket (require "hacs.rkt" rackunit) -(check-equal? (first-unassigned-variable ($csp (list (+var 'a (range 3)) (+var 'b (range 3))) null)) - (+var 'a (range 3))) -(check-equal? (first-unassigned-variable ($csp (list (+avar 'a (range 3)) (+var 'b (range 3))) null)) - (+var 'b (range 3))) -(check-false (first-unassigned-variable ($csp (list (+avar 'a (range 3)) (+avar 'b (range 3))) null))) + +(check-equal? (first-unassigned-variable ($csp (list ($var 'a (range 3)) ($var 'b (range 3))) null)) + ($var 'a (range 3))) +(check-equal? (first-unassigned-variable ($csp (list ($avar 'a (range 3)) ($var 'b (range 3))) null)) + ($var 'b (range 3))) +(check-false (first-unassigned-variable ($csp (list ($avar 'a (range 3)) ($avar 'b (range 3))) null))) (check-equal? ;; no forward checking when no constraints - ($csp-vars (forward-check ($csp (list (+avar 'a '(1)) (+var 'b (range 2))) null) 'a)) - (list (+avar 'a '(1)) (+var 'b '(0 1)))) + ($csp-vars (forward-check ($csp (list ($avar 'a '(1)) ($var 'b (range 2))) null) 'a)) + (list ($avar 'a '(1)) ($var 'b '(0 1)))) (check-equal? - ($csp-vars (forward-check (forward-check ($csp (list (+avar 'a '(1)) (+avar 'b '(0)) (+var 'c '(0 1 2))) + ($csp-vars (forward-check (forward-check ($csp (list ($avar 'a '(1)) ($avar 'b '(0)) ($var 'c '(0 1 2))) (list ($constraint '(a c) (negate =)) ($constraint '(b c) (negate =)))) 'a) 'b)) - (list (+avar 'a '(1)) (+avar 'b '(0) '()) (+var 'c '(2) '(b a)))) + (list ($avar 'a '(1)) ($avar 'b '(0)) ($cvar 'c '(2) '(b a)))) (check-equal? ;; no inconsistency: b≠c not checked when fc is relative to a - ($csp-vars (forward-check ($csp (list (+avar 'a '(1)) (+var 'b (range 2)) (+var 'c '(0))) + ($csp-vars (forward-check ($csp (list ($avar 'a '(1)) ($var 'b (range 2)) ($var 'c '(0))) (list ($constraint '(a b) (negate =)) ($constraint '(b c) (negate =)))) 'a)) - (list (+avar 'a '(1)) (+var 'b '(0) '(a)) (+var 'c '(0)))) + (list ($avar 'a '(1)) ($cvar 'b '(0) '(a)) ($var 'c '(0)))) (check-equal? ;; no inconsistency: a≠b not checked when fc ignores a, which is already assigned - ($csp-vars (forward-check ($csp (list (+avar 'a '(1)) (+avar 'b '(1)) (+var 'c (range 2))) + ($csp-vars (forward-check ($csp (list ($avar 'a '(1)) ($avar 'b '(1)) ($var 'c (range 2))) (list ($constraint '(a b) (negate =)) ($constraint '(b c) (negate =)))) 'b)) - (list (+avar 'a '(1)) (+avar 'b '(1)) (+var 'c '(0) '(b)))) + (list ($avar 'a '(1)) ($avar 'b '(1)) ($cvar 'c '(0) '(b)))) (check-exn $backtrack? - (λ () ($csp-vars (forward-check ($csp (list (+avar 'a '(1)) - (+var 'b '(1))) + (λ () ($csp-vars (forward-check ($csp (list ($avar 'a '(1)) + ($var 'b '(1))) (list ($constraint '(a b) (negate =)))) 'a)))) -(check-equal? ($csp-vars (forward-check ($csp (list (+avar 'a (range 3)) - (+var 'b (range 3))) - (list ($constraint '(a b) <) - ($constraint '(a b) <) - ($constraint '(a b) <))) 'a)) - (list (+avar 'a '(0 1 2)) (+var 'b '(1 2) '(a)))) +(check-equal? ($csp-vars (forward-check ($csp (list ($var 'a '(0)) + ($var 'b (range 3))) + (list ($constraint '(a b) <))) 'a)) + (list ($var 'a '(0)) ($cvar 'b '(1 2) '(a)))) (check-equal? (parameterize ([current-inference forward-check]) - (length (solve* ($csp (list (+var 'x (range 3)) - (+var 'y (range 3)) - (+var 'z (range 3))) + (length (solve* ($csp (list ($var 'x (range 3)) + ($var 'y (range 3)) + ($var 'z (range 3))) (list ($constraint '(x y) <>) ($constraint '(x z) <>) ($constraint '(y z) <>)))))) 6) (parameterize ([current-inference forward-check]) (define vds (for/list ([k '(wa nt nsw q t v sa)]) - (+var k '(red green blue)))) + ($var k '(red green blue)))) (define cs (list ($constraint '(wa nt) neq?) ($constraint '(wa sa) neq?) diff --git a/csp/hacs.rkt b/csp/hacs.rkt index 210bc391..644264ed 100644 --- a/csp/hacs.rkt +++ b/csp/hacs.rkt @@ -5,14 +5,13 @@ (struct $csp ([vars #:mutable] [constraints #:mutable]) #:transparent) (struct $constraint (names proc) #:transparent) -(struct $var (name domain past) #:transparent) -(define (+var name vals [past null]) - ($var name vals past)) - + +(struct $var (name domain) #:transparent) (define $var-name? symbol?) + +(struct $cvar $var (past) #:transparent) (struct $avar $var () #:transparent) -(define (+avar name vals [past null]) - ($avar name vals past)) + (struct inconsistency-signal (csp) #:transparent) (struct $backtrack (names) #:transparent) @@ -42,25 +41,16 @@ ($var-domain ($csp-var csp name))) (define order-domain-values values) + (define/contract (assign-val csp name val) ($csp? $var-name? any/c . -> . $csp?) ($csp (for/list ([var ($csp-vars csp)]) (if (eq? name ($var-name var)) - (+avar name (list val) ($var-past var)) + ($avar name (list val)) var)) ($csp-constraints csp))) -(define/contract (update-conflicts csp name conflicts) - ($csp? $var-name? (listof $var-name?) . -> . $csp?) - ($csp - (for/list ([var ($csp-vars csp)]) - (match var - [($var (? (λ (x) (eq? x name))) vals past) - (+avar name vals past conflicts)] - [else var])) - ($csp-constraints csp))) - (define (unassigned-vars csp) (for/list ([var (in-list ($csp-vars csp))] #:unless ($avar? var)) @@ -102,8 +92,10 @@ (define aval (first ($csp-vals csp aname))) (define (check-var var) (match var - [(? $avar?) var] - [($var name vals past) + ;; don't check against assigned vars, or the reference var + ;; (which is probably assigned but maybe not) + [(? (λ (x) (or ($avar? x) (eq? ($var-name x) aname)))) var] + [($var name vals) (match (($csp-constraints csp) . relating . (list aname name)) [(? empty?) var] [constraints @@ -115,12 +107,14 @@ (proc val aval) (proc aval val))))) val)) - (+var name new-vals (cons aname past))])])) + ($cvar name new-vals (cons aname (if ($cvar? var) + ($cvar-past var) + null)))])])) (define checked-vars (map check-var ($csp-vars csp))) ;; conflict-set will be empty if there are no empty domains (define conflict-set (for*/list ([var (in-list checked-vars)] #:when (empty? ($var-domain var)) - [name (in-list ($var-past var))]) + [name (in-list ($cvar-past var))]) name)) ;; for conflict-directed backjumping it's essential to forward-check ALL vars ;; (even after an empty domain is generated) and combine their conflicts @@ -142,7 +136,7 @@ (let loop ([csp csp]) (match (select-unassigned-variable csp) [#false (yield csp)] - [($var name domain _) + [($var name domain) (define (wants-backtrack? exn) (and ($backtrack? exn) (memq name ($backtrack-names exn)))) (for/fold ([conflicts null] @@ -162,8 +156,14 @@ #:when (eq? name ($var-name var))) (first ($var-domain var)))))) +(define/contract ($csp-assocs csp) + ($csp? . -> . (listof (cons/c $var-name? any/c))) + (for/list ([var (in-list ($csp-vars csp))]) + (match var + [($var name domain) (cons name (first domain))]))) + (define/contract (solve* csp - #:finish-proc [finish-proc $csp-vars] + #:finish-proc [finish-proc $csp-assocs] #:solver [solver (or (current-solver) backtracking-solver)] #:count [max-solutions +inf.0]) (($csp?) (#:finish-proc procedure? #:solver procedure? #:count integer?) . ->* . (listof any/c)) @@ -174,7 +174,7 @@ (finish-proc solution))) (define/contract (solve csp - #:finish-proc [finish-proc $csp-vars] + #:finish-proc [finish-proc $csp-assocs] #:solver [solver (or (current-solver) backtracking-solver)]) (($csp?) (#:finish-proc procedure? #:solver procedure?) . ->* . (or/c #false any/c)) (match (solve* csp #:finish-proc finish-proc #:solver solver #:count 1) From aba89019396e3b305566342cd77ac199b934074e Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Fri, 19 Oct 2018 18:25:26 -0700 Subject: [PATCH 153/246] whip it --- csp/{test-etc.rkt => csp-test-etc.rkt} | 0 ...est-problems.rkt => csp-test-problems.rkt} | 0 csp/{test.rkt => csp-test.rkt} | 0 csp/hacs-map.rkt | 1 - csp/hacs-test-workbench.rkt | 17 ++ csp/hacs-test.rkt | 14 +- csp/hacs.rkt | 237 +++++++++++++++--- 7 files changed, 228 insertions(+), 41 deletions(-) rename csp/{test-etc.rkt => csp-test-etc.rkt} (100%) rename csp/{test-problems.rkt => csp-test-problems.rkt} (100%) rename csp/{test.rkt => csp-test.rkt} (100%) create mode 100644 csp/hacs-test-workbench.rkt diff --git a/csp/test-etc.rkt b/csp/csp-test-etc.rkt similarity index 100% rename from csp/test-etc.rkt rename to csp/csp-test-etc.rkt diff --git a/csp/test-problems.rkt b/csp/csp-test-problems.rkt similarity index 100% rename from csp/test-problems.rkt rename to csp/csp-test-problems.rkt diff --git a/csp/test.rkt b/csp/csp-test.rkt similarity index 100% rename from csp/test.rkt rename to csp/csp-test.rkt diff --git a/csp/hacs-map.rkt b/csp/hacs-map.rkt index 1a2e930d..f0c77ef0 100644 --- a/csp/hacs-map.rkt +++ b/csp/hacs-map.rkt @@ -20,7 +20,6 @@ (car tail) "")))))))) - (current-inference forward-check) (current-select-variable minimum-remaining-values) (current-order-values shuffle) diff --git a/csp/hacs-test-workbench.rkt b/csp/hacs-test-workbench.rkt new file mode 100644 index 00000000..2a17f32e --- /dev/null +++ b/csp/hacs-test-workbench.rkt @@ -0,0 +1,17 @@ +#lang debug racket +(require sugar "hacs.rkt") + +(current-inference forward-check) +(current-select-variable mrv) +(current-order-values shuffle) +(current-shuffle #true) + +(define xsum (make-csp)) +(add-vars! xsum '(l1 l2 l3 l4 r1 r2 r3 r4 x) (range 1 10)) +(add-pairwise-constraint! xsum < '(l1 l2 l3 l4)) +(add-pairwise-constraint! xsum < '(r1 r2 r3 r4)) +(add-constraint! xsum (λ (l1 l2 l3 l4 x) (= 27 (+ l1 l2 l3 l4 x))) '(l1 l2 l3 l4 x)) +(add-constraint! xsum (λ (r1 r2 r3 r4 x) (= 27 (+ r1 r2 r3 r4 x))) '(r1 r2 r3 r4 x)) +(add-pairwise-constraint! xsum alldiff= '(l1 l2 l3 l4 r1 r2 r3 r4 x)) + +(time (solve xsum)) diff --git a/csp/hacs-test.rkt b/csp/hacs-test.rkt index 873b81d6..1569e09a 100644 --- a/csp/hacs-test.rkt +++ b/csp/hacs-test.rkt @@ -67,4 +67,16 @@ ($constraint '(nsw v) neq?) ($constraint '(v sa) neq?))) (define csp ($csp vds cs)) - (check-equal? (length (solve* csp)) 18)) \ No newline at end of file + (check-equal? (length (solve* csp)) 18)) + + +(define quarters (make-csp)) +(add-vars! quarters '(dollars quarters) (range 26)) +(add-constraint! quarters (λ (d q) (= 26 (+ d q))) '(dollars quarters)) +(add-constraint! quarters (λ (d q) (= 17 (+ d (* 0.25 q)))) '(dollars quarters)) +(check-equal? (time (solve quarters)) + '((dollars . 14) (quarters . 12))) + + + +#;(check-equal? (length (time (solve* xsum))) 8) diff --git a/csp/hacs.rkt b/csp/hacs.rkt index 644264ed..0598d01d 100644 --- a/csp/hacs.rkt +++ b/csp/hacs.rkt @@ -2,16 +2,76 @@ (require racket/generator) (provide (all-defined-out)) +(define-syntax-rule (in-cartesian x) + (in-generator (let ([argss x]) + (let loop ([argss argss][acc empty]) + (if (null? argss) + (yield (reverse acc)) + (for ([arg (in-list (car argss))]) + (loop (cdr argss) (cons arg acc)))))))) + (struct $csp ([vars #:mutable] [constraints #:mutable]) #:transparent) -(struct $constraint (names proc) #:transparent) +(struct $constraint (names proc) #:transparent + #:property prop:procedure + (λ (constraint csp) + (unless ($csp? csp) + (raise-argument-error '$constraint-proc "$csp" csp)) + ;; apply proc in many-to-many style + (for/and ([args (in-cartesian (map (λ (cname) ($csp-vals csp cname)) ($constraint-names constraint)))]) + (apply ($constraint-proc constraint) args)))) (struct $var (name domain) #:transparent) (define $var-name? symbol?) +(define $var-vals $var-domain) (struct $cvar $var (past) #:transparent) (struct $avar $var () #:transparent) + +(define (make-csp [vds null] [constraints null]) + ($csp vds constraints)) + +(define/contract (add-vars! csp names-or-procedure [vals-or-procedure empty]) + (($csp? (or/c (listof $var-name?) procedure?)) ((or/c (listof any/c) procedure?)) . ->* . void?) + (for/fold ([vars ($csp-vars csp)] + #:result (set-$csp-vars! csp vars)) + ([name (in-list (if (procedure? names-or-procedure) + (names-or-procedure) + names-or-procedure))]) + (when (memq name (map $var-name vars)) + (raise-argument-error 'add-vars! "var that doesn't already exist" name)) + (append vars (list ($var name + (if (procedure? vals-or-procedure) + (vals-or-procedure) + vals-or-procedure)))))) + +(define/contract (add-var! csp name [vals-or-procedure empty]) + (($csp? $var-name?) ((or/c (listof any/c) procedure?)) . ->* . void?) + (add-vars! csp (list name) vals-or-procedure)) + +(define/contract (add-constraints! csp proc namess [proc-name #false]) + (($csp? procedure? (listof (listof $var-name?))) ((or/c #false $var-name?)) . ->* . void?) + (set-$csp-constraints! csp (append ($csp-constraints csp) + (for/list ([names (in-list namess)]) + (for ([name (in-list names)]) + (check-name-in-csp! 'add-constraints! csp name)) + ($constraint names (if proc-name + (procedure-rename proc proc-name) + proc)))))) + +(define/contract (add-pairwise-constraint! csp proc var-names [proc-name #false]) + (($csp? procedure? (listof $var-name?)) ($var-name?) . ->* . void?) + (add-constraints! csp proc (combinations var-names 2) proc-name)) + +(define/contract (add-constraint! csp proc var-names [proc-name #false]) + (($csp? procedure? (listof $var-name?)) ($var-name?) . ->* . void?) + (add-constraints! csp proc (list var-names) proc-name)) + +(define/contract (alldiff= x y) + (any/c any/c . -> . boolean?) + (not (= x y))) + (struct inconsistency-signal (csp) #:transparent) (struct $backtrack (names) #:transparent) @@ -33,7 +93,7 @@ (check-name-in-csp! '$csp-var csp name) (for/first ([var (in-list ($csp-vars csp))] #:when (eq? name ($var-name var))) - var)) + var)) (define/contract ($csp-vals csp name) ($csp? $var-name? . -> . (listof any/c)) @@ -42,19 +102,67 @@ (define order-domain-values values) +(define/contract (assigned-name? csp name) + ($csp? $var-name? . -> . boolean?) + (and (memq name (map $var-name (filter $avar? ($csp-vars csp)))) #true)) + +(define (reduce-arity proc pattern) + (unless (match (procedure-arity proc) + [(arity-at-least val) (<= val (length pattern))] + [(? number? val) (= val (length pattern))]) + (raise-argument-error 'reduce-arity (format "list of length ~a, same as procedure arity" (procedure-arity proc)) pattern)) + (define reduced-arity-name (string->symbol (format "reduced-arity-~a" (object-name proc)))) + (define-values (id-names vals) (partition symbol? pattern)) + (define new-arity (length id-names)) + (procedure-rename + (λ xs + (unless (= (length xs) new-arity) + (apply raise-arity-error reduced-arity-name new-arity xs)) + (apply proc (for/fold ([acc empty] + [xs xs] + [vals vals] + #:result (reverse acc)) + ([pat-item (in-list pattern)]) + (if (symbol? pat-item) + (values (cons (car xs) acc) (cdr xs) vals) + (values (cons (car vals) acc) xs (cdr vals)))))) + reduced-arity-name)) + +(define/contract (reduce-constraint-arity csp [minimum-arity 3]) + (($csp?) ((or/c #false exact-nonnegative-integer?)) . ->* . $csp?) + (let ([assigned-name? (curry assigned-name? csp)]) + (define (partially-assigned? constraint) + (ormap assigned-name? ($constraint-names constraint))) + ($csp ($csp-vars csp) + (for/list ([constraint (in-list ($csp-constraints csp))]) + (cond + [(and (if minimum-arity (<= minimum-arity (constraint-arity constraint)) #true) + (partially-assigned? constraint)) + (match-define ($constraint cnames proc) constraint) + ($constraint (filter-not assigned-name? cnames) + ;; pattern is mix of values and symbols (indicating variables to persist) + (let ([reduce-arity-pattern (for/list ([cname (in-list cnames)]) + (if (assigned-name? cname) + (first ($csp-vals csp cname)) + cname))]) + (reduce-arity proc reduce-arity-pattern)))] + [else constraint]))))) + (define/contract (assign-val csp name val) ($csp? $var-name? any/c . -> . $csp?) - ($csp - (for/list ([var ($csp-vars csp)]) - (if (eq? name ($var-name var)) - ($avar name (list val)) - var)) - ($csp-constraints csp))) - -(define (unassigned-vars csp) + (define assigned-csp ($csp + (for/list ([var ($csp-vars csp)]) + (if (eq? name ($var-name var)) + ($avar name (list val)) + var)) + ($csp-constraints csp))) + (reduce-constraint-arity assigned-csp)) + +(define/contract (unassigned-vars csp) + ($csp? . -> . (listof (and/c $var? (not/c $avar?)))) (for/list ([var (in-list ($csp-vars csp))] #:unless ($avar? var)) - var)) + var)) (define/contract (first-unassigned-variable csp) ($csp? . -> . (or/c #false (and/c $var? (not/c $avar?)))) @@ -70,22 +178,40 @@ (define/contract (minimum-remaining-values csp) ($csp? . -> . (or/c #false (and/c $var? (not/c $avar?)))) - (struct $mrv-rec (var num) #:transparent) (match (unassigned-vars csp) [(? empty?) #false] [xs (argmin-random-tie (λ (var) (length ($var-domain var))) xs)])) +(define mrv minimum-remaining-values) + +(define/contract (var-degree csp var) + ($csp? $var? . -> . exact-nonnegative-integer?) + (for/sum ([constraint (in-list ($csp-constraints csp))] + #:when (memq ($var-name var) ($constraint-names constraint))) + 1)) + +(define/contract (blended-variable-selector csp) + ($csp? . -> . (or/c #false (and/c $var? (not/c $avar?)))) + (define uvars (unassigned-vars csp)) + (cond + [(empty? uvars) #false] + [(findf singleton-var? uvars)] + [else (first (let* ([uvars-by-mrv (sort uvars < #:key (λ (var) (length ($var-domain var))))] + [uvars-by-degree (sort uvars-by-mrv > #:key (λ (var) (var-degree csp var)))]) + uvars-by-degree))])) + (define first-domain-value values) (define (no-inference csp name) csp) -(define/contract (relating constraints names) +(define/contract (relating-only constraints names) ((listof $constraint?) (listof $var-name?) . -> . (listof $constraint?)) (for*/list ([constraint (in-list constraints)] [cnames (in-value ($constraint-names constraint))] - #:when (for/and ([name (in-list names)]) - (memq name cnames))) - constraint)) + #:when (and (= (length names) (length cnames)) + (for/and ([name (in-list names)]) + (memq name cnames)))) + constraint)) (define/contract (forward-check csp aname) ($csp? $var-name? . -> . $csp?) @@ -96,17 +222,17 @@ ;; (which is probably assigned but maybe not) [(? (λ (x) (or ($avar? x) (eq? ($var-name x) aname)))) var] [($var name vals) - (match (($csp-constraints csp) . relating . (list aname name)) + (match (($csp-constraints csp) . relating-only . (list aname name)) [(? empty?) var] [constraints (define new-vals (for/list ([val (in-list vals)] #:when (for/and ([constraint (in-list constraints)]) - (let ([proc ($constraint-proc constraint)]) - (if (eq? name (first ($constraint-names constraint))) - (proc val aval) - (proc aval val))))) - val)) + (let ([proc ($constraint-proc constraint)]) + (if (eq? name (first ($constraint-names constraint))) + (proc val aval) + (proc aval val))))) + val)) ($cvar name new-vals (cons aname (if ($cvar? var) ($cvar-past var) null)))])])) @@ -115,7 +241,7 @@ (define conflict-set (for*/list ([var (in-list checked-vars)] #:when (empty? ($var-domain var)) [name (in-list ($cvar-past var))]) - name)) + name)) ;; for conflict-directed backjumping it's essential to forward-check ALL vars ;; (even after an empty domain is generated) and combine their conflicts ;; so we can discover the *most recent past var* that could be the culprit. @@ -123,7 +249,45 @@ ;; (and thereby miss parts of the search tree) (when (pair? conflict-set) (raise ($backtrack conflict-set))) - ($csp checked-vars ($csp-constraints csp))) + ;; Discard constraints that have produced singleton domains + ;; (they have no further use) + (define nonsingleton-constraints + (for/list ([constraint (in-list ($csp-constraints csp))] + #:unless (and + (= 2 (constraint-arity constraint)) ; binary constraint + (memq aname ($constraint-names constraint)) ; includes target name + (let ([other-name (first (remq aname ($constraint-names constraint)))]) ; and something else + (= (length ($csp-vals csp other-name)) 1)))) ; that has only one value + constraint)) + ($csp checked-vars nonsingleton-constraints)) + +(define/contract (constraint-checkable? c names) + ($constraint? (listof $var-name?) . -> . boolean?) + (and (for/and ([cname (in-list ($constraint-names c))]) + (memq cname names)) + #true)) + +(define/contract (constraint-arity constraint) + ($constraint? . -> . exact-nonnegative-integer?) + (length ($constraint-names constraint))) + +(define (singleton-var? var) + (= 1 (length ($var-domain var)))) + +(define/contract (check-constraints csp) + ($csp? . -> . $csp?) + ;; this time, we're not limited to assigned variables + ;; (that is, vars that have been deliberately assigned in the backtrack process thus far) + ;; we also want to use "singleton" vars (that is, vars that have been reduced to a single domain value by forward checking) + (define singleton-varnames (for/list ([var (in-list ($csp-vars csp))] + #:when (singleton-var? var)) + ($var-name var))) + (define-values (checkable-constraints other-constraints) + (partition (λ (c) (constraint-checkable? c singleton-varnames)) ($csp-constraints csp))) + (for ([constraint (in-list (sort checkable-constraints < #:key constraint-arity))] + #:unless (constraint csp)) + (raise ($backtrack null))) + ($csp ($csp-vars csp) other-constraints)) (define/contract (backtracking-solver csp @@ -138,29 +302,26 @@ [#false (yield csp)] [($var name domain) (define (wants-backtrack? exn) - (and ($backtrack? exn) (memq name ($backtrack-names exn)))) + (and ($backtrack? exn) (or (let ([btns ($backtrack-names exn)]) + (or (empty? btns) (memq name btns)))))) (for/fold ([conflicts null] #:result (void)) ([val (in-list (order-domain-values domain))]) (with-handlers ([wants-backtrack? (λ (bt) (append conflicts (remq name ($backtrack-names bt))))]) - (define csp-with-assignment (assign-val csp name val)) - (loop (inference csp-with-assignment name))) + (let* ([csp (assign-val csp name val)] + [csp (inference csp name)] + [csp (check-constraints csp)]) + (loop csp))) conflicts)])))) -(define/contract (solution-consistent? solution) - ($csp? . -> . boolean?) - (for/and ([c (in-list ($csp-constraints solution))]) - (apply ($constraint-proc c) (for*/list ([name (in-list ($constraint-names c))] - [var (in-list ($csp-vars solution))] - #:when (eq? name ($var-name var))) - (first ($var-domain var)))))) + (define/contract ($csp-assocs csp) ($csp? . -> . (listof (cons/c $var-name? any/c))) (for/list ([var (in-list ($csp-vars csp))]) - (match var - [($var name domain) (cons name (first domain))]))) + (match var + [($var name domain) (cons name (first domain))]))) (define/contract (solve* csp #:finish-proc [finish-proc $csp-assocs] @@ -169,9 +330,7 @@ (($csp?) (#:finish-proc procedure? #:solver procedure? #:count integer?) . ->* . (listof any/c)) (for/list ([solution (in-producer (solver csp) (void))] [idx (in-range max-solutions)]) - (unless (solution-consistent? solution) - (raise (list 'wtf solution))) - (finish-proc solution))) + (finish-proc solution))) (define/contract (solve csp #:finish-proc [finish-proc $csp-assocs] From 5efc1406ff719cb10fcf33f491747ed70d6d567b Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Fri, 19 Oct 2018 22:15:19 -0700 Subject: [PATCH 154/246] how do you start --- csp/hacs-test-workbench.rkt | 120 +- csp/hacs-test.rkt | 80 +- csp/hacs.rkt | 134 +- csp/port2/python-constraint-master/.gitignore | 60 - .../python-constraint-master/.travis.yml | 21 - csp/port2/python-constraint-master/LICENSE | 23 - csp/port2/python-constraint-master/README.rst | 159 -- .../constraint/__init__.py | 1461 ----------------- .../constraint/compat.py | 14 - .../constraint/version.py | 8 - .../examples/__init__.py | 0 .../examples/abc/__init__.py | 0 .../examples/abc/abc.py | 37 - .../examples/coins/__init__.py | 0 .../examples/coins/coins.py | 36 - .../examples/crosswords/__init__.py | 0 .../examples/crosswords/crosswords.py | 154 -- .../examples/crosswords/large.mask | 27 - .../examples/crosswords/medium.mask | 19 - .../examples/crosswords/python.mask | 8 - .../examples/crosswords/small.mask | 8 - .../examples/einstein/__init__.py | 0 .../examples/einstein/einstein.py | 209 --- .../examples/queens/__init__.py | 0 .../examples/queens/queens.py | 54 - .../examples/rooks/__init__.py | 0 .../examples/rooks/rooks.py | 57 - .../examples/studentdesks/__init__.py | 0 .../examples/studentdesks/studentdesks.py | 48 - .../examples/sudoku/__init__.py | 0 .../examples/sudoku/sudoku.py | 71 - .../examples/wordmath/__init__.py | 0 .../examples/wordmath/seisseisdoze.py | 39 - .../examples/wordmath/sendmoremoney.py | 42 - .../examples/wordmath/twotwofour.py | 37 - .../examples/xsum/__init__.py | 0 .../examples/xsum/xsum.py | 48 - csp/port2/python-constraint-master/setup.cfg | 9 - csp/port2/python-constraint-master/setup.py | 123 -- .../tests/test_constraint.py | 91 - .../tests/test_solvers.py | 17 - .../tests/test_some_not_in_set.py | 102 -- 42 files changed, 274 insertions(+), 3042 deletions(-) delete mode 100755 csp/port2/python-constraint-master/.gitignore delete mode 100755 csp/port2/python-constraint-master/.travis.yml delete mode 100755 csp/port2/python-constraint-master/LICENSE delete mode 100755 csp/port2/python-constraint-master/README.rst delete mode 100755 csp/port2/python-constraint-master/constraint/__init__.py delete mode 100755 csp/port2/python-constraint-master/constraint/compat.py delete mode 100755 csp/port2/python-constraint-master/constraint/version.py delete mode 100755 csp/port2/python-constraint-master/examples/__init__.py delete mode 100755 csp/port2/python-constraint-master/examples/abc/__init__.py delete mode 100755 csp/port2/python-constraint-master/examples/abc/abc.py delete mode 100755 csp/port2/python-constraint-master/examples/coins/__init__.py delete mode 100755 csp/port2/python-constraint-master/examples/coins/coins.py delete mode 100755 csp/port2/python-constraint-master/examples/crosswords/__init__.py delete mode 100755 csp/port2/python-constraint-master/examples/crosswords/crosswords.py delete mode 100755 csp/port2/python-constraint-master/examples/crosswords/large.mask delete mode 100755 csp/port2/python-constraint-master/examples/crosswords/medium.mask delete mode 100755 csp/port2/python-constraint-master/examples/crosswords/python.mask delete mode 100755 csp/port2/python-constraint-master/examples/crosswords/small.mask delete mode 100755 csp/port2/python-constraint-master/examples/einstein/__init__.py delete mode 100755 csp/port2/python-constraint-master/examples/einstein/einstein.py delete mode 100755 csp/port2/python-constraint-master/examples/queens/__init__.py delete mode 100755 csp/port2/python-constraint-master/examples/queens/queens.py delete mode 100755 csp/port2/python-constraint-master/examples/rooks/__init__.py delete mode 100755 csp/port2/python-constraint-master/examples/rooks/rooks.py delete mode 100755 csp/port2/python-constraint-master/examples/studentdesks/__init__.py delete mode 100755 csp/port2/python-constraint-master/examples/studentdesks/studentdesks.py delete mode 100755 csp/port2/python-constraint-master/examples/sudoku/__init__.py delete mode 100755 csp/port2/python-constraint-master/examples/sudoku/sudoku.py delete mode 100755 csp/port2/python-constraint-master/examples/wordmath/__init__.py delete mode 100755 csp/port2/python-constraint-master/examples/wordmath/seisseisdoze.py delete mode 100755 csp/port2/python-constraint-master/examples/wordmath/sendmoremoney.py delete mode 100755 csp/port2/python-constraint-master/examples/wordmath/twotwofour.py delete mode 100755 csp/port2/python-constraint-master/examples/xsum/__init__.py delete mode 100755 csp/port2/python-constraint-master/examples/xsum/xsum.py delete mode 100755 csp/port2/python-constraint-master/setup.cfg delete mode 100755 csp/port2/python-constraint-master/setup.py delete mode 100755 csp/port2/python-constraint-master/tests/test_constraint.py delete mode 100755 csp/port2/python-constraint-master/tests/test_solvers.py delete mode 100755 csp/port2/python-constraint-master/tests/test_some_not_in_set.py diff --git a/csp/hacs-test-workbench.rkt b/csp/hacs-test-workbench.rkt index 2a17f32e..d592c496 100644 --- a/csp/hacs-test-workbench.rkt +++ b/csp/hacs-test-workbench.rkt @@ -2,16 +2,118 @@ (require sugar "hacs.rkt") (current-inference forward-check) -(current-select-variable mrv) +(current-select-variable mrv-degree-hybrid) (current-order-values shuffle) (current-shuffle #true) -(define xsum (make-csp)) -(add-vars! xsum '(l1 l2 l3 l4 r1 r2 r3 r4 x) (range 1 10)) -(add-pairwise-constraint! xsum < '(l1 l2 l3 l4)) -(add-pairwise-constraint! xsum < '(r1 r2 r3 r4)) -(add-constraint! xsum (λ (l1 l2 l3 l4 x) (= 27 (+ l1 l2 l3 l4 x))) '(l1 l2 l3 l4 x)) -(add-constraint! xsum (λ (r1 r2 r3 r4 x) (= 27 (+ r1 r2 r3 r4 x))) '(r1 r2 r3 r4 x)) -(add-pairwise-constraint! xsum alldiff= '(l1 l2 l3 l4 r1 r2 r3 r4 x)) -(time (solve xsum)) +#| +# There are no tricks, just pure logic, so good luck and don't give up. +# +# 1. In a street there are five houses, painted five different colours. +# 2. In each house lives a person of different nationality +# 3. These five homeowners each drink a different kind of beverage, smoke +# different brand of cigar and keep a different pet. +# +# THE QUESTION: WHO OWNS THE zebra? +# +# HINTS +# +# 1. The englishman lives in a red house. +# 2. The spaniard keeps dogs as pets. +# 5. The owner of the Green house drinks coffee. +# 3. The ukrainian drinks tea. +# 4. The Green house is on the left of the ivory house. +# 6. The person who smokes oldgold rears snails. +# 7. The owner of the Yellow house smokes kools. +# 8. The man living in the centre house drinks milk. +# 9. The Norwegian lives in the first house. +# 10. The man who smokes chesterfields lives next to the one who keeps foxes. +# 11. The man who keeps horses lives next to the man who smokes kools. +# 12. The man who smokes luckystrike drinks orangejuice. +# 13. The japanese smokes parliaments. +# 14. The Norwegian lives next to the blue house. +# 15. The man who smokes chesterfields has a neighbour who drinks water. +|# + +(define (sym . args) (string->symbol (apply format args))) + +(define zebra (make-csp)) + +(define ns (map (curry sym "nationality-~a") (range 5))) +(define cs (map (curry sym "color-~a") (range 5))) +(define ds (map (curry sym "drink-~a") (range 5))) +(define ss (map (curry sym "smoke-~a") (range 5))) +(define ps (map (curry sym "pet-~a") (range 5))) + +(add-vars! zebra ns '(englishman spaniard ukrainian norwegian japanese)) +(add-vars! zebra cs '(red ivory green yellow blue)) +(add-vars! zebra ds '(tea coffee milk orange-juice water)) +(add-vars! zebra ss '(oldgold kools chesterfields luckystrike parliaments)) +(add-vars! zebra ps '(dogs snails foxes horses zebra)) + +(for ([vars (list ns cs ds ss ps)]) + (add-pairwise-constraint! zebra neq? vars)) + +(define (paired-with lval left rval right) + (add-constraint! zebra (λ (left right) (or (not (eq? left lval)) (eq? rval right))) (list left right))) + +(define (paired-with* lval lefts rval rights) + (for ([left lefts][right rights]) + (paired-with lval left rval right))) + +;# 1. The englishman lives in a red house. +('englishman ns . paired-with* . 'red cs) + +;# 2. The spaniard keeps dogs as pets. +('spaniard ns . paired-with* . 'dogs ps) + +;# 5. The owner of the Green house drinks coffee. +('green cs . paired-with* . 'coffee ds) + +;# 3. The ukrainian drinks tea. +('ukrainian ns . paired-with* . 'tea ds) + +;# 4. The Green house is on the left of the ivory house. +('green (drop-right cs 1) . paired-with* . 'ivory (drop cs 1)) +(add-constraint! zebra (curry neq? 'ivory) (list 'color-0)) +(add-constraint! zebra (curry neq? 'green) (list 'color-4)) + +;# 6. The person who smokes oldgold rears snails. +('oldgold ss . paired-with* . 'snails ps) + +;# 7. The owner of the Yellow house smokes kools. +('yellow cs . paired-with* . 'kools ss) + +;# 8. The man living in the centre house drinks milk. +(add-constraint! zebra (λ (d) (eq? d 'milk)) (list 'drink-2)) + +;# 9. The Norwegian lives in the first house. +(add-constraint! zebra (λ (x) (eq? x 'norwegian)) (list 'nationality-0)) + +(define (next-to lval lefts rval rights) + (lval (drop-right lefts 1) . paired-with* . rval (drop rights 1)) + (lval (drop lefts 1) . paired-with* . rval (drop-right rights 1))) + +;# 10. The man who smokes chesterfields lives next to the one who keeps foxes. +('chesterfields ss . next-to . 'foxes ps) + +;# 11. The man who keeps horses lives next to the man who smokes kools. +;('horses ps . next-to . 'kools ss) + +;# 12. The man who smokes luckystrike drinks orangejuice. +('luckystrike ss . paired-with* . 'orange-juice ds) + +;# 13. The japanese smokes parliaments. +('japanese ns . paired-with* . 'parliaments ss) + +;# 14. The Norwegian lives next to the blue house. +;('norwegian ns . next-to . 'water ds) + +;# 15. The man who smokes chesterfields has a neighbour who drinks water. +;('chesterfields ss . next-to . 'water ds) + +(define (finish x) + (apply map list (slice-at x 5))) + +(map finish (list (time (solve zebra)))) \ No newline at end of file diff --git a/csp/hacs-test.rkt b/csp/hacs-test.rkt index 1569e09a..02c07af4 100644 --- a/csp/hacs-test.rkt +++ b/csp/hacs-test.rkt @@ -1,6 +1,10 @@ #lang debug racket (require "hacs.rkt" rackunit) +(current-inference forward-check) +(current-select-variable mrv-degree-hybrid) +(current-order-values shuffle) +(current-shuffle #true) (check-equal? (first-unassigned-variable ($csp (list ($var 'a (range 3)) ($var 'b (range 3))) null)) ($var 'a (range 3))) @@ -78,5 +82,77 @@ '((dollars . 14) (quarters . 12))) - -#;(check-equal? (length (time (solve* xsum))) 8) +;; xsum +#| +# Reorganize the following numbers in a way that each line of +# 5 numbers sum to 27. +# +# 1 6 +# 2 7 +# 3 +# 8 4 +# 9 5 +# +|# +(define xsum (make-csp)) +(add-vars! xsum '(l1 l2 l3 l4 r1 r2 r3 r4 x) (range 1 10)) +(add-pairwise-constraint! xsum < '(l1 l2 l3 l4)) +(add-pairwise-constraint! xsum < '(r1 r2 r3 r4)) +(add-constraint! xsum (λ (l1 l2 l3 l4 x) (= 27 (+ l1 l2 l3 l4 x))) '(l1 l2 l3 l4 x)) +(add-constraint! xsum (λ (r1 r2 r3 r4 x) (= 27 (+ r1 r2 r3 r4 x))) '(r1 r2 r3 r4 x)) +(add-pairwise-constraint! xsum alldiff= '(l1 l2 l3 l4 r1 r2 r3 r4 x)) + +(check-equal? (length (time (solve* xsum))) 8) + + + +;; send more money problem +#| +# Assign equal values to equal letters, and different values to +# different letters, in a way that satisfies the following sum: +# +# SEND +# + MORE +# ------ +# MONEY +|# + +(define (word-value . xs) + (for/sum ([(x idx) (in-indexed (reverse xs))]) + (* x (expt 10 idx)))) + +(define smm (make-csp)) +(add-vars! smm '(s e n d m o r y) (λ () (range 10))) +(add-constraint! smm positive? '(s)) +(add-constraint! smm positive? '(m)) +(add-constraint! smm (λ (d e y) (= (modulo (+ d e) 10) y)) '(d e y)) +(add-constraint! smm (λ (n d r e y) + (= (modulo (+ (word-value n d) (word-value r e)) 100) + (word-value e y))) '(n d r e y)) +(add-constraint! smm (λ (e n d o r y) + (= (modulo (+ (word-value e n d) (word-value o r e)) 1000) (word-value n e y))) '(e n d o r y)) +(add-constraint! smm (λ (s e n d m o r y) + (= (+ (word-value s e n d) (word-value m o r e)) + (word-value m o n e y))) '(s e n d m o r y)) +(add-pairwise-constraint! smm alldiff= '(s e n d m o r y)) +(check-equal? (time (solve smm)) '((s . 9) (e . 5) (n . 6) (d . 7) (m . 1) (o . 0) (r . 8) (y . 2))) + + +;; queens problem +;; place queens on chessboard so they do not intersect +(define queens (make-csp)) +(define qs (for/list ([q 8]) (string->symbol (format "q~a" q)))) +(define rows (range (length qs))) +(add-vars! queens qs rows) +(define (q-col q) (string->number (string-trim (symbol->string q) "q"))) +(for* ([qs (in-combinations qs 2)]) + (match-define (list qa qb) qs) + (match-define (list qa-col qb-col) (map q-col qs)) + (add-constraint! queens + (λ (qa-row qb-row) + (and + (not (= (abs (- qa-row qb-row)) (abs (- qa-col qb-col)))) ; same diagonal? + (not (= qa-row qb-row)))) ; same row? + (list qa qb))) + +(check-equal? 92 (length (time (solve* queens)))) \ No newline at end of file diff --git a/csp/hacs.rkt b/csp/hacs.rkt index 0598d01d..db0fa941 100644 --- a/csp/hacs.rkt +++ b/csp/hacs.rkt @@ -8,7 +8,7 @@ (if (null? argss) (yield (reverse acc)) (for ([arg (in-list (car argss))]) - (loop (cdr argss) (cons arg acc)))))))) + (loop (cdr argss) (cons arg acc)))))))) (struct $csp ([vars #:mutable] [constraints #:mutable]) #:transparent) @@ -19,7 +19,7 @@ (raise-argument-error '$constraint-proc "$csp" csp)) ;; apply proc in many-to-many style (for/and ([args (in-cartesian (map (λ (cname) ($csp-vals csp cname)) ($constraint-names constraint)))]) - (apply ($constraint-proc constraint) args)))) + (apply ($constraint-proc constraint) args)))) (struct $var (name domain) #:transparent) (define $var-name? symbol?) @@ -28,7 +28,6 @@ (struct $cvar $var (past) #:transparent) (struct $avar $var () #:transparent) - (define (make-csp [vds null] [constraints null]) ($csp vds constraints)) @@ -54,11 +53,11 @@ (($csp? procedure? (listof (listof $var-name?))) ((or/c #false $var-name?)) . ->* . void?) (set-$csp-constraints! csp (append ($csp-constraints csp) (for/list ([names (in-list namess)]) - (for ([name (in-list names)]) - (check-name-in-csp! 'add-constraints! csp name)) - ($constraint names (if proc-name - (procedure-rename proc proc-name) - proc)))))) + (for ([name (in-list names)]) + (check-name-in-csp! 'add-constraints! csp name)) + ($constraint names (if proc-name + (procedure-rename proc proc-name) + proc)))))) (define/contract (add-pairwise-constraint! csp proc var-names [proc-name #false]) (($csp? procedure? (listof $var-name?)) ($var-name?) . ->* . void?) @@ -93,7 +92,7 @@ (check-name-in-csp! '$csp-var csp name) (for/first ([var (in-list ($csp-vars csp))] #:when (eq? name ($var-name var))) - var)) + var)) (define/contract ($csp-vals csp name) ($csp? $var-name? . -> . (listof any/c)) @@ -135,34 +134,34 @@ (ormap assigned-name? ($constraint-names constraint))) ($csp ($csp-vars csp) (for/list ([constraint (in-list ($csp-constraints csp))]) - (cond - [(and (if minimum-arity (<= minimum-arity (constraint-arity constraint)) #true) - (partially-assigned? constraint)) - (match-define ($constraint cnames proc) constraint) - ($constraint (filter-not assigned-name? cnames) - ;; pattern is mix of values and symbols (indicating variables to persist) - (let ([reduce-arity-pattern (for/list ([cname (in-list cnames)]) - (if (assigned-name? cname) - (first ($csp-vals csp cname)) - cname))]) - (reduce-arity proc reduce-arity-pattern)))] - [else constraint]))))) + (cond + [(and (if minimum-arity (<= minimum-arity (constraint-arity constraint)) #true) + (partially-assigned? constraint)) + (match-define ($constraint cnames proc) constraint) + ($constraint (filter-not assigned-name? cnames) + ;; pattern is mix of values and symbols (indicating variables to persist) + (let ([reduce-arity-pattern (for/list ([cname (in-list cnames)]) + (if (assigned-name? cname) + (first ($csp-vals csp cname)) + cname))]) + (reduce-arity proc reduce-arity-pattern)))] + [else constraint]))))) (define/contract (assign-val csp name val) ($csp? $var-name? any/c . -> . $csp?) (define assigned-csp ($csp (for/list ([var ($csp-vars csp)]) - (if (eq? name ($var-name var)) - ($avar name (list val)) - var)) + (if (eq? name ($var-name var)) + ($avar name (list val)) + var)) ($csp-constraints csp))) - (reduce-constraint-arity assigned-csp)) + assigned-csp) (define/contract (unassigned-vars csp) ($csp? . -> . (listof (and/c $var? (not/c $avar?)))) (for/list ([var (in-list ($csp-vars csp))] #:unless ($avar? var)) - var)) + var)) (define/contract (first-unassigned-variable csp) ($csp? . -> . (or/c #false (and/c $var? (not/c $avar?)))) @@ -188,7 +187,7 @@ ($csp? $var? . -> . exact-nonnegative-integer?) (for/sum ([constraint (in-list ($csp-constraints csp))] #:when (memq ($var-name var) ($constraint-names constraint))) - 1)) + 1)) (define/contract (blended-variable-selector csp) ($csp? . -> . (or/c #false (and/c $var? (not/c $avar?)))) @@ -199,6 +198,26 @@ [else (first (let* ([uvars-by-mrv (sort uvars < #:key (λ (var) (length ($var-domain var))))] [uvars-by-degree (sort uvars-by-mrv > #:key (λ (var) (var-degree csp var)))]) uvars-by-degree))])) + +(define/contract (remaining-values var) + ($var? . -> . exact-nonnegative-integer?) + (length ($var-vals var))) + +(define/contract (mrv-degree-hybrid csp) + ($csp? . -> . (or/c #f $var?)) + (define uvars (unassigned-vars csp)) + (cond + [(empty? uvars) #false] + [else + ;; minimum remaining values (MRV) rule + (define mrv-arg (argmin remaining-values uvars)) + (match (filter (λ (var) (= (remaining-values mrv-arg) (remaining-values var))) uvars) + [(list winning-uvar) winning-uvar] + [(list mrv-uvars ...) + ;; use degree as tiebreaker for mrv + (define max-degree-arg (argmax (λ (var) (var-degree csp var)) mrv-uvars)) + ;; use random tiebreaker for degree + (first (shuffle (filter (λ (var) (= (var-degree csp max-degree-arg) (var-degree csp var))) mrv-uvars)))])])) (define first-domain-value values) @@ -210,8 +229,8 @@ [cnames (in-value ($constraint-names constraint))] #:when (and (= (length names) (length cnames)) (for/and ([name (in-list names)]) - (memq name cnames)))) - constraint)) + (memq name cnames)))) + constraint)) (define/contract (forward-check csp aname) ($csp? $var-name? . -> . $csp?) @@ -228,11 +247,11 @@ (define new-vals (for/list ([val (in-list vals)] #:when (for/and ([constraint (in-list constraints)]) - (let ([proc ($constraint-proc constraint)]) - (if (eq? name (first ($constraint-names constraint))) - (proc val aval) - (proc aval val))))) - val)) + (let ([proc ($constraint-proc constraint)]) + (if (eq? name (first ($constraint-names constraint))) + (proc val aval) + (proc aval val))))) + val)) ($cvar name new-vals (cons aname (if ($cvar? var) ($cvar-past var) null)))])])) @@ -241,7 +260,7 @@ (define conflict-set (for*/list ([var (in-list checked-vars)] #:when (empty? ($var-domain var)) [name (in-list ($cvar-past var))]) - name)) + name)) ;; for conflict-directed backjumping it's essential to forward-check ALL vars ;; (even after an empty domain is generated) and combine their conflicts ;; so we can discover the *most recent past var* that could be the culprit. @@ -253,18 +272,18 @@ ;; (they have no further use) (define nonsingleton-constraints (for/list ([constraint (in-list ($csp-constraints csp))] - #:unless (and - (= 2 (constraint-arity constraint)) ; binary constraint - (memq aname ($constraint-names constraint)) ; includes target name - (let ([other-name (first (remq aname ($constraint-names constraint)))]) ; and something else - (= (length ($csp-vals csp other-name)) 1)))) ; that has only one value - constraint)) + #:unless (and + (= 2 (constraint-arity constraint)) ; binary constraint + (memq aname ($constraint-names constraint)) ; includes target name + (let ([other-name (first (remq aname ($constraint-names constraint)))]) ; and something else + (= (length ($csp-vals csp other-name)) 1)))) ; that has only one value + constraint)) ($csp checked-vars nonsingleton-constraints)) (define/contract (constraint-checkable? c names) ($constraint? (listof $var-name?) . -> . boolean?) (and (for/and ([cname (in-list ($constraint-names c))]) - (memq cname names)) + (memq cname names)) #true)) (define/contract (constraint-arity constraint) @@ -281,14 +300,30 @@ ;; we also want to use "singleton" vars (that is, vars that have been reduced to a single domain value by forward checking) (define singleton-varnames (for/list ([var (in-list ($csp-vars csp))] #:when (singleton-var? var)) - ($var-name var))) + ($var-name var))) (define-values (checkable-constraints other-constraints) (partition (λ (c) (constraint-checkable? c singleton-varnames)) ($csp-constraints csp))) (for ([constraint (in-list (sort checkable-constraints < #:key constraint-arity))] #:unless (constraint csp)) - (raise ($backtrack null))) + (raise ($backtrack null))) ($csp ($csp-vars csp) other-constraints)) +(define/contract (make-nodes-consistent csp) + ($csp? . -> . $csp?) + ;; todo: why does this function make searches so much slower? + ($csp + (for/list ([var (in-list ($csp-vars csp))]) + (match-define ($var name vals) var) + (define procs (for*/list ([constraint (in-list ($csp-constraints csp))] + [cnames (in-value ($constraint-names constraint))] + #:when (and (= 1 (length cnames)) (eq? name (car cnames)))) + ($constraint-proc constraint))) + ($var name + (for*/fold ([vals vals]) + ([proc (in-list procs)]) + (filter proc vals)))) + ($csp-constraints csp))) + (define/contract (backtracking-solver csp #:select-variable [select-unassigned-variable @@ -310,18 +345,19 @@ (with-handlers ([wants-backtrack? (λ (bt) (append conflicts (remq name ($backtrack-names bt))))]) (let* ([csp (assign-val csp name val)] + ;; reduce constraints before inference, + ;; to create more forward-checkable (binary) constraints + [csp (reduce-constraint-arity csp)] [csp (inference csp name)] [csp (check-constraints csp)]) (loop csp))) conflicts)])))) - - (define/contract ($csp-assocs csp) ($csp? . -> . (listof (cons/c $var-name? any/c))) (for/list ([var (in-list ($csp-vars csp))]) - (match var - [($var name domain) (cons name (first domain))]))) + (match var + [($var name domain) (cons name (first domain))]))) (define/contract (solve* csp #:finish-proc [finish-proc $csp-assocs] @@ -330,7 +366,7 @@ (($csp?) (#:finish-proc procedure? #:solver procedure? #:count integer?) . ->* . (listof any/c)) (for/list ([solution (in-producer (solver csp) (void))] [idx (in-range max-solutions)]) - (finish-proc solution))) + (finish-proc solution))) (define/contract (solve csp #:finish-proc [finish-proc $csp-assocs] diff --git a/csp/port2/python-constraint-master/.gitignore b/csp/port2/python-constraint-master/.gitignore deleted file mode 100755 index b102207f..00000000 --- a/csp/port2/python-constraint-master/.gitignore +++ /dev/null @@ -1,60 +0,0 @@ -# Byte-compiled / optimized / DLL files -__pycache__/ -*.py[cod] - -# C extensions -*.so - -# Distribution / packaging -.Python -env/ -build/ -develop-eggs/ -dist/ -downloads/ -eggs/ -.eggs/ -lib/ -lib64/ -parts/ -sdist/ -var/ -*.egg-info/ -.installed.cfg -*.egg - -# PyInstaller -# Usually these files are written by a python script from a template -# before PyInstaller builds the exe, so as to inject date/other infos into it. -*.manifest -*.spec - -# Installer logs -pip-log.txt -pip-delete-this-directory.txt - -# Unit test / coverage reports -htmlcov/ -.tox/ -.coverage -.coverage.* -.cache -nosetests.xml -coverage.xml -*,cover - -# Translations -*.mo -*.pot - -# Django stuff: -*.log - -# Sphinx documentation -docs/_build/ - -# PyBuilder -target/ - -# PyCharm / Intellij -.idea/ diff --git a/csp/port2/python-constraint-master/.travis.yml b/csp/port2/python-constraint-master/.travis.yml deleted file mode 100755 index 2bf2b8a3..00000000 --- a/csp/port2/python-constraint-master/.travis.yml +++ /dev/null @@ -1,21 +0,0 @@ -language: python -python: - - "2.7" - - "3.3" - - "3.4" - - "3.5" - - "3.6" - -# command to install dependencies -install: - - "pip install -qq flake8" - - "pip install coveralls --quiet" - - "pip install ." - -# command to run tests -script: - - nosetests -s -v --with-coverage --cover-package=constraint - - flake8 --ignore E501 constraint examples tests - -after_success: - - coveralls diff --git a/csp/port2/python-constraint-master/LICENSE b/csp/port2/python-constraint-master/LICENSE deleted file mode 100755 index 1551a23a..00000000 --- a/csp/port2/python-constraint-master/LICENSE +++ /dev/null @@ -1,23 +0,0 @@ -Copyright (c) 2005-2014 - Gustavo Niemeyer - -All rights reserved. - -Redistribution and use in source and binary forms, with or without -modification, are permitted provided that the following conditions are met: - -1. Redistributions of source code must retain the above copyright notice, this - list of conditions and the following disclaimer. -2. Redistributions in binary form must reproduce the above copyright notice, - this list of conditions and the following disclaimer in the documentation - and/or other materials provided with the distribution. - -THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND -ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED -WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE -DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR -ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES -(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; -LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND -ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT -(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS -SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/csp/port2/python-constraint-master/README.rst b/csp/port2/python-constraint-master/README.rst deleted file mode 100755 index 564e46a5..00000000 --- a/csp/port2/python-constraint-master/README.rst +++ /dev/null @@ -1,159 +0,0 @@ -|Build Status| |Code Health| |Code Coverage| - -python-constraint -================= - -Introduction ------------- -The Python constraint module offers solvers for `Constraint Satisfaction Problems (CSPs) `_ over finite domains in simple and pure Python. CSP is class of problems which may be represented in terms of variables (a, b, ...), domains (a in [1, 2, 3], ...), and constraints (a < b, ...). - -Examples --------- - -Basics -~~~~~~ - -This interactive Python session demonstrates the module basic operation: - -.. code-block:: python - - >>> from constraint import * - >>> problem = Problem() - >>> problem.addVariable("a", [1,2,3]) - >>> problem.addVariable("b", [4,5,6]) - >>> problem.getSolutions() - [{'a': 3, 'b': 6}, {'a': 3, 'b': 5}, {'a': 3, 'b': 4}, - {'a': 2, 'b': 6}, {'a': 2, 'b': 5}, {'a': 2, 'b': 4}, - {'a': 1, 'b': 6}, {'a': 1, 'b': 5}, {'a': 1, 'b': 4}] - - >>> problem.addConstraint(lambda a, b: a*2 == b, - ("a", "b")) - >>> problem.getSolutions() - [{'a': 3, 'b': 6}, {'a': 2, 'b': 4}] - - >>> problem = Problem() - >>> problem.addVariables(["a", "b"], [1, 2, 3]) - >>> problem.addConstraint(AllDifferentConstraint()) - >>> problem.getSolutions() - [{'a': 3, 'b': 2}, {'a': 3, 'b': 1}, {'a': 2, 'b': 3}, - {'a': 2, 'b': 1}, {'a': 1, 'b': 2}, {'a': 1, 'b': 3}] - -Rooks problem -~~~~~~~~~~~~~ - -The following example solves the classical Eight Rooks problem: - -.. code-block:: python - - >>> problem = Problem() - >>> numpieces = 8 - >>> cols = range(numpieces) - >>> rows = range(numpieces) - >>> problem.addVariables(cols, rows) - >>> for col1 in cols: - ... for col2 in cols: - ... if col1 < col2: - ... problem.addConstraint(lambda row1, row2: row1 != row2, - ... (col1, col2)) - >>> solutions = problem.getSolutions() - >>> solutions - >>> solutions - [{0: 7, 1: 6, 2: 5, 3: 4, 4: 3, 5: 2, 6: 1, 7: 0}, - {0: 7, 1: 6, 2: 5, 3: 4, 4: 3, 5: 2, 6: 0, 7: 1}, - {0: 7, 1: 6, 2: 5, 3: 4, 4: 3, 5: 1, 6: 2, 7: 0}, - {0: 7, 1: 6, 2: 5, 3: 4, 4: 3, 5: 1, 6: 0, 7: 2}, - ... - {0: 7, 1: 5, 2: 3, 3: 6, 4: 2, 5: 1, 6: 4, 7: 0}, - {0: 7, 1: 5, 2: 3, 3: 6, 4: 1, 5: 2, 6: 0, 7: 4}, - {0: 7, 1: 5, 2: 3, 3: 6, 4: 1, 5: 2, 6: 4, 7: 0}, - {0: 7, 1: 5, 2: 3, 3: 6, 4: 1, 5: 4, 6: 2, 7: 0}, - {0: 7, 1: 5, 2: 3, 3: 6, 4: 1, 5: 4, 6: 0, 7: 2}, - ...] - - -Magic squares -~~~~~~~~~~~~~ - -This example solves a 4x4 magic square: - -.. code-block:: python - - >>> problem = Problem() - >>> problem.addVariables(range(0, 16), range(1, 16 + 1)) - >>> problem.addConstraint(AllDifferentConstraint(), range(0, 16)) - >>> problem.addConstraint(ExactSumConstraint(34), [0, 5, 10, 15]) - >>> problem.addConstraint(ExactSumConstraint(34), [3, 6, 9, 12]) - >>> for row in range(4): - ... problem.addConstraint(ExactSumConstraint(34), - [row * 4 + i for i in range(4)]) - >>> for col in range(4): - ... problem.addConstraint(ExactSumConstraint(34), - [col + 4 * i for i in range(4)]) - >>> solutions = problem.getSolutions() - -Features --------- - -The following solvers are available: - -- Backtracking solver -- Recursive backtracking solver -- Minimum conflicts solver - - -.. role:: python(code) - :language: python - -Predefined constraint types currently available: - -- :python:`FunctionConstraint` -- :python:`AllDifferentConstraint` -- :python:`AllEqualConstraint` -- :python:`ExactSumConstraint` -- :python:`MaxSumConstraint` -- :python:`MinSumConstraint` -- :python:`InSetConstraint` -- :python:`NotInSetConstraint` -- :python:`SomeInSetConstraint` -- :python:`SomeNotInSetConstraint` - -API documentation ------------------ -Documentation for the module is available at: http://labix.org/doc/constraint/ - -Download and install --------------------- - -.. code-block:: shell - - $ pip install python-constraint - -Roadmap -------- - -This GitHub organization and repository is a global effort to help to -maintain python-constraint which was written by Gustavo Niemeyer -and originaly located at https://labix.org/python-constraint - -- Create some unit tests - DONE -- Enable continuous integration - DONE -- Port to Python 3 (Python 2 being also supported) - DONE -- Respect Style Guide for Python Code (PEP8) - DONE -- Improve code coverage writting more unit tests - ToDo -- Move doc to Sphinx or MkDocs - https://readthedocs.org/ - ToDo - -Contact -------- -- `Gustavo Niemeyer `_ -- `Sébastien Celles `_ - -But it's probably better to `open an issue `_. - - -.. |Build Status| image:: https://travis-ci.org/python-constraint/python-constraint.svg?branch=master - :target: https://travis-ci.org/python-constraint/python-constraint -.. |Code Health| image:: https://landscape.io/github/python-constraint/python-constraint/master/landscape.svg?style=flat - :target: https://landscape.io/github/python-constraint/python-constraint/master - :alt: Code Health -.. |Code Coverage| image:: https://coveralls.io/repos/github/python-constraint/python-constraint/badge.svg - :target: https://coveralls.io/github/python-constraint/python-constraint diff --git a/csp/port2/python-constraint-master/constraint/__init__.py b/csp/port2/python-constraint-master/constraint/__init__.py deleted file mode 100755 index 7932aa33..00000000 --- a/csp/port2/python-constraint-master/constraint/__init__.py +++ /dev/null @@ -1,1461 +0,0 @@ -#!/usr/bin/python -# -# Copyright (c) 2005-2014 - Gustavo Niemeyer -# -# All rights reserved. -# -# Redistribution and use in source and binary forms, with or without -# modification, are permitted provided that the following conditions are met: -# -# 1. Redistributions of source code must retain the above copyright notice, this -# list of conditions and the following disclaimer. -# 2. Redistributions in binary form must reproduce the above copyright notice, -# this list of conditions and the following disclaimer in the documentation -# and/or other materials provided with the distribution. -# -# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" -# AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE -# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE -# DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE -# FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL -# DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR -# SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER -# CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, -# OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE -# OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -""" -@var Unassigned: Helper object instance representing unassigned values - -@sort: Problem, Variable, Domain -@group Solvers: Solver, - BacktrackingSolver, - RecursiveBacktrackingSolver, - MinConflictsSolver -@group Constraints: Constraint, - FunctionConstraint, - AllDifferentConstraint, - AllEqualConstraint, - MaxSumConstraint, - ExactSumConstraint, - MinSumConstraint, - InSetConstraint, - NotInSetConstraint, - SomeInSetConstraint, - SomeNotInSetConstraint -""" - -from __future__ import absolute_import, division, print_function - - -from .version import (__author__, __copyright__, __credits__, __license__, # noqa - __version__, __email__, __status__, __url__) # noqa - -import random -import copy -from .compat import xrange - -__all__ = ["Problem", "Variable", "Domain", "Unassigned", - "Solver", "BacktrackingSolver", "RecursiveBacktrackingSolver", - "MinConflictsSolver", "Constraint", "FunctionConstraint", - "AllDifferentConstraint", "AllEqualConstraint", "MaxSumConstraint", - "ExactSumConstraint", "MinSumConstraint", "InSetConstraint", - "NotInSetConstraint", "SomeInSetConstraint", - "SomeNotInSetConstraint"] - - -class Problem(object): - """ - Class used to define a problem and retrieve solutions - """ - - def __init__(self, solver=None): - """ - @param solver: Problem solver used to find solutions - (default is L{BacktrackingSolver}) - @type solver: instance of a L{Solver} subclass - """ - self._solver = solver or BacktrackingSolver() - self._constraints = [] - self._variables = {} - - def reset(self): - """ - Reset the current problem definition - - Example: - - >>> problem = Problem() - >>> problem.addVariable("a", [1, 2]) - >>> problem.reset() - >>> problem.getSolution() - >>> - """ - del self._constraints[:] - self._variables.clear() - - def setSolver(self, solver): - """ - Change the problem solver currently in use - - Example: - - >>> solver = BacktrackingSolver() - >>> problem = Problem(solver) - >>> problem.getSolver() is solver - True - - @param solver: New problem solver - @type solver: instance of a C{Solver} subclass - """ - self._solver = solver - - def getSolver(self): - """ - Obtain the problem solver currently in use - - Example: - - >>> solver = BacktrackingSolver() - >>> problem = Problem(solver) - >>> problem.getSolver() is solver - True - - @return: Solver currently in use - @rtype: instance of a L{Solver} subclass - """ - return self._solver - - def addVariable(self, variable, domain): - """ - Add a variable to the problem - - Example: - - >>> problem = Problem() - >>> problem.addVariable("a", [1, 2]) - >>> problem.getSolution() in ({'a': 1}, {'a': 2}) - True - - @param variable: Object representing a problem variable - @type variable: hashable object - @param domain: Set of items defining the possible values that - the given variable may assume - @type domain: list, tuple, or instance of C{Domain} - """ - if variable in self._variables: - msg = "Tried to insert duplicated variable %s" % repr(variable) - raise ValueError(msg) - if hasattr(domain, '__getitem__'): - domain = Domain(domain) - elif isinstance(domain, Domain): - domain = copy.copy(domain) - else: - msg = "Domains must be instances of subclasses of the Domain class" - raise TypeError(msg) - if not domain: - raise ValueError("Domain is empty") - self._variables[variable] = domain - - def addVariables(self, variables, domain): - """ - Add one or more variables to the problem - - Example: - - >>> problem = Problem() - >>> problem.addVariables(["a", "b"], [1, 2, 3]) - >>> solutions = problem.getSolutions() - >>> len(solutions) - 9 - >>> {'a': 3, 'b': 1} in solutions - True - - @param variables: Any object containing a sequence of objects - represeting problem variables - @type variables: sequence of hashable objects - @param domain: Set of items defining the possible values that - the given variables may assume - @type domain: list, tuple, or instance of C{Domain} - """ - for variable in variables: - self.addVariable(variable, domain) - - def addConstraint(self, constraint, variables=None): - """ - Add a constraint to the problem - - Example: - - >>> problem = Problem() - >>> problem.addVariables(["a", "b"], [1, 2, 3]) - >>> problem.addConstraint(lambda a, b: b == a+1, ["a", "b"]) - >>> solutions = problem.getSolutions() - >>> - - @param constraint: Constraint to be included in the problem - @type constraint: instance a L{Constraint} subclass or a - function to be wrapped by L{FunctionConstraint} - @param variables: Variables affected by the constraint (default to - all variables). Depending on the constraint type - the order may be important. - @type variables: set or sequence of variables - """ - if not isinstance(constraint, Constraint): - if callable(constraint): - constraint = FunctionConstraint(constraint) - else: - msg = "Constraints must be instances of subclasses "\ - "of the Constraint class" - raise ValueError(msg) - self._constraints.append((constraint, variables)) - - def getSolution(self): - """ - Find and return a solution to the problem - - Example: - - >>> problem = Problem() - >>> problem.getSolution() is None - True - >>> problem.addVariables(["a"], [42]) - >>> problem.getSolution() - {'a': 42} - - @return: Solution for the problem - @rtype: dictionary mapping variables to values - """ - domains, constraints, vconstraints = self._getArgs() - if not domains: - return None - return self._solver.getSolution(domains, constraints, vconstraints) - - def getSolutions(self): - """ - Find and return all solutions to the problem - - Example: - - >>> problem = Problem() - >>> problem.getSolutions() == [] - True - >>> problem.addVariables(["a"], [42]) - >>> problem.getSolutions() - [{'a': 42}] - - @return: All solutions for the problem - @rtype: list of dictionaries mapping variables to values - """ - domains, constraints, vconstraints = self._getArgs() - if not domains: - return [] - return self._solver.getSolutions(domains, constraints, vconstraints) - - def getSolutionIter(self): - """ - Return an iterator to the solutions of the problem - - Example: - - >>> problem = Problem() - >>> list(problem.getSolutionIter()) == [] - True - >>> problem.addVariables(["a"], [42]) - >>> iter = problem.getSolutionIter() - >>> next(iter) - {'a': 42} - >>> next(iter) - Traceback (most recent call last): - File "", line 1, in ? - StopIteration - """ - domains, constraints, vconstraints = self._getArgs() - if not domains: - return iter(()) - return self._solver.getSolutionIter(domains, constraints, - vconstraints) - - def _getArgs(self): - domains = self._variables.copy() - allvariables = domains.keys() - constraints = [] - for constraint, variables in self._constraints: - if not variables: - variables = list(allvariables) - constraints.append((constraint, variables)) - vconstraints = {} - for variable in domains: - vconstraints[variable] = [] - for constraint, variables in constraints: - for variable in variables: - vconstraints[variable].append((constraint, variables)) - for constraint, variables in constraints[:]: - constraint.preProcess(variables, domains, - constraints, vconstraints) - for domain in domains.values(): - domain.resetState() - if not domain: - return None, None, None - # doArc8(getArcs(domains, constraints), domains, {}) - return domains, constraints, vconstraints - -# ---------------------------------------------------------------------- -# Solvers -# ---------------------------------------------------------------------- - - -def getArcs(domains, constraints): - """ - Return a dictionary mapping pairs (arcs) of constrained variables - - @attention: Currently unused. - """ - arcs = {} - for x in constraints: - constraint, variables = x - if len(variables) == 2: - variable1, variable2 = variables - arcs.setdefault(variable1, {})\ - .setdefault(variable2, [])\ - .append(x) - arcs.setdefault(variable2, {})\ - .setdefault(variable1, [])\ - .append(x) - return arcs - - -def doArc8(arcs, domains, assignments): - """ - Perform the ARC-8 arc checking algorithm and prune domains - - @attention: Currently unused. - """ - check = dict.fromkeys(domains, True) - while check: - variable, _ = check.popitem() - if variable not in arcs or variable in assignments: - continue - domain = domains[variable] - arcsvariable = arcs[variable] - for othervariable in arcsvariable: - arcconstraints = arcsvariable[othervariable] - if othervariable in assignments: - otherdomain = [assignments[othervariable]] - else: - otherdomain = domains[othervariable] - if domain: - # changed = False - for value in domain[:]: - assignments[variable] = value - if otherdomain: - for othervalue in otherdomain: - assignments[othervariable] = othervalue - for constraint, variables in arcconstraints: - if not constraint(variables, domains, - assignments, True): - break - else: - # All constraints passed. Value is safe. - break - else: - # All othervalues failed. Kill value. - domain.hideValue(value) - # changed = True - del assignments[othervariable] - del assignments[variable] - # if changed: - # check.update(dict.fromkeys(arcsvariable)) - if not domain: - return False - return True - - -class Solver(object): - """ - Abstract base class for solvers - - @sort: getSolution, getSolutions, getSolutionIter - """ - - def getSolution(self, domains, constraints, vconstraints): - """ - Return one solution for the given problem - - @param domains: Dictionary mapping variables to their domains - @type domains: dict - @param constraints: List of pairs of (constraint, variables) - @type constraints: list - @param vconstraints: Dictionary mapping variables to a list of - constraints affecting the given variables. - @type vconstraints: dict - """ - msg = "%s is an abstract class" % self.__class__.__name__ - raise NotImplementedError(msg) - - def getSolutions(self, domains, constraints, vconstraints): - """ - Return all solutions for the given problem - - @param domains: Dictionary mapping variables to domains - @type domains: dict - @param constraints: List of pairs of (constraint, variables) - @type constraints: list - @param vconstraints: Dictionary mapping variables to a list of - constraints affecting the given variables. - @type vconstraints: dict - """ - msg = "%s provides only a single solution" % self.__class__.__name__ - raise NotImplementedError(msg) - - def getSolutionIter(self, domains, constraints, vconstraints): - """ - Return an iterator for the solutions of the given problem - - @param domains: Dictionary mapping variables to domains - @type domains: dict - @param constraints: List of pairs of (constraint, variables) - @type constraints: list - @param vconstraints: Dictionary mapping variables to a list of - constraints affecting the given variables. - @type vconstraints: dict - """ - msg = "%s doesn't provide iteration" % self.__class__.__name__ - raise NotImplementedError(msg) - - -class BacktrackingSolver(Solver): - """ - Problem solver with backtracking capabilities - - Examples: - - >>> result = [[('a', 1), ('b', 2)], - ... [('a', 1), ('b', 3)], - ... [('a', 2), ('b', 3)]] - - >>> problem = Problem(BacktrackingSolver()) - >>> problem.addVariables(["a", "b"], [1, 2, 3]) - >>> problem.addConstraint(lambda a, b: b > a, ["a", "b"]) - - >>> solution = problem.getSolution() - >>> sorted(solution.items()) in result - True - - >>> for solution in problem.getSolutionIter(): - ... sorted(solution.items()) in result - True - True - True - - >>> for solution in problem.getSolutions(): - ... sorted(solution.items()) in result - True - True - True - """ - - def __init__(self, forwardcheck=True): - """ - @param forwardcheck: If false forward checking will not be requested - to constraints while looking for solutions - (default is true) - @type forwardcheck: bool - """ - self._forwardcheck = forwardcheck - - def getSolutionIter(self, domains, constraints, vconstraints): - forwardcheck = self._forwardcheck - assignments = {} - - queue = [] - - while True: - - # Mix the Degree and Minimum Remaing Values (MRV) heuristics - lst = [(-len(vconstraints[variable]), - len(domains[variable]), variable) for variable in domains] - lst.sort() - for item in lst: - if item[-1] not in assignments: - # Found unassigned variable - variable = item[-1] - values = domains[variable][:] - if forwardcheck: - pushdomains = [domains[x] for x in domains - if x not in assignments and x != variable] - else: - pushdomains = None - break - else: - # No unassigned variables. We've got a solution. Go back - # to last variable, if there's one. - yield assignments.copy() - if not queue: - return - variable, values, pushdomains = queue.pop() - if pushdomains: - for domain in pushdomains: - domain.popState() - - while True: - # We have a variable. Do we have any values left? - if not values: - # No. Go back to last variable, if there's one. - del assignments[variable] - while queue: - variable, values, pushdomains = queue.pop() - if pushdomains: - for domain in pushdomains: - domain.popState() - if values: - break - del assignments[variable] - else: - return - - # Got a value. Check it. - assignments[variable] = values.pop() - - if pushdomains: - for domain in pushdomains: - domain.pushState() - - for constraint, variables in vconstraints[variable]: - if not constraint(variables, domains, assignments, - pushdomains): - # Value is not good. - break - else: - break - - if pushdomains: - for domain in pushdomains: - domain.popState() - - # Push state before looking for next variable. - queue.append((variable, values, pushdomains)) - - raise RuntimeError("Can't happen") - - def getSolution(self, domains, constraints, vconstraints): - iter = self.getSolutionIter(domains, constraints, vconstraints) - try: - return next(iter) - except StopIteration: - return None - - def getSolutions(self, domains, constraints, vconstraints): - return list(self.getSolutionIter(domains, constraints, vconstraints)) - - -class RecursiveBacktrackingSolver(Solver): - """ - Recursive problem solver with backtracking capabilities - - Examples: - - >>> result = [[('a', 1), ('b', 2)], - ... [('a', 1), ('b', 3)], - ... [('a', 2), ('b', 3)]] - - >>> problem = Problem(RecursiveBacktrackingSolver()) - >>> problem.addVariables(["a", "b"], [1, 2, 3]) - >>> problem.addConstraint(lambda a, b: b > a, ["a", "b"]) - - >>> solution = problem.getSolution() - >>> sorted(solution.items()) in result - True - - >>> for solution in problem.getSolutions(): - ... sorted(solution.items()) in result - True - True - True - - >>> problem.getSolutionIter() - Traceback (most recent call last): - ... - NotImplementedError: RecursiveBacktrackingSolver doesn't provide iteration - """ - - def __init__(self, forwardcheck=True): - """ - @param forwardcheck: If false forward checking will not be requested - to constraints while looking for solutions - (default is true) - @type forwardcheck: bool - """ - self._forwardcheck = forwardcheck - - def recursiveBacktracking(self, solutions, domains, vconstraints, - assignments, single): - - # Mix the Degree and Minimum Remaing Values (MRV) heuristics - lst = [(-len(vconstraints[variable]), - len(domains[variable]), variable) for variable in domains] - lst.sort() - for item in lst: - if item[-1] not in assignments: - # Found an unassigned variable. Let's go. - break - else: - # No unassigned variables. We've got a solution. - solutions.append(assignments.copy()) - return solutions - - variable = item[-1] - assignments[variable] = None - - forwardcheck = self._forwardcheck - if forwardcheck: - pushdomains = [domains[x] for x in domains if x not in assignments] - else: - pushdomains = None - - for value in domains[variable]: - assignments[variable] = value - if pushdomains: - for domain in pushdomains: - domain.pushState() - for constraint, variables in vconstraints[variable]: - if not constraint(variables, domains, assignments, - pushdomains): - # Value is not good. - break - else: - # Value is good. Recurse and get next variable. - self.recursiveBacktracking(solutions, domains, vconstraints, - assignments, single) - if solutions and single: - return solutions - if pushdomains: - for domain in pushdomains: - domain.popState() - del assignments[variable] - return solutions - - def getSolution(self, domains, constraints, vconstraints): - solutions = self.recursiveBacktracking([], domains, vconstraints, - {}, True) - return solutions and solutions[0] or None - - def getSolutions(self, domains, constraints, vconstraints): - return self.recursiveBacktracking([], domains, vconstraints, - {}, False) - - -class MinConflictsSolver(Solver): - """ - Problem solver based on the minimum conflicts theory - - Examples: - - >>> result = [[('a', 1), ('b', 2)], - ... [('a', 1), ('b', 3)], - ... [('a', 2), ('b', 3)]] - - >>> problem = Problem(MinConflictsSolver()) - >>> problem.addVariables(["a", "b"], [1, 2, 3]) - >>> problem.addConstraint(lambda a, b: b > a, ["a", "b"]) - - >>> solution = problem.getSolution() - >>> sorted(solution.items()) in result - True - - >>> problem.getSolutions() - Traceback (most recent call last): - ... - NotImplementedError: MinConflictsSolver provides only a single solution - - >>> problem.getSolutionIter() - Traceback (most recent call last): - ... - NotImplementedError: MinConflictsSolver doesn't provide iteration - """ - - def __init__(self, steps=1000): - """ - @param steps: Maximum number of steps to perform before giving up - when looking for a solution (default is 1000) - @type steps: int - """ - self._steps = steps - - def getSolution(self, domains, constraints, vconstraints): - assignments = {} - # Initial assignment - for variable in domains: - assignments[variable] = random.choice(domains[variable]) - for _ in xrange(self._steps): - conflicted = False - lst = list(domains.keys()) - random.shuffle(lst) - for variable in lst: - # Check if variable is not in conflict - for constraint, variables in vconstraints[variable]: - if not constraint(variables, domains, assignments): - break - else: - continue - # Variable has conflicts. Find values with less conflicts. - mincount = len(vconstraints[variable]) - minvalues = [] - for value in domains[variable]: - assignments[variable] = value - count = 0 - for constraint, variables in vconstraints[variable]: - if not constraint(variables, domains, assignments): - count += 1 - if count == mincount: - minvalues.append(value) - elif count < mincount: - mincount = count - del minvalues[:] - minvalues.append(value) - # Pick a random one from these values. - assignments[variable] = random.choice(minvalues) - conflicted = True - if not conflicted: - return assignments - return None - -# ---------------------------------------------------------------------- -# Variables -# ---------------------------------------------------------------------- - - -class Variable(object): - """ - Helper class for variable definition - - Using this class is optional, since any hashable object, - including plain strings and integers, may be used as variables. - """ - - def __init__(self, name): - """ - @param name: Generic variable name for problem-specific purposes - @type name: string - """ - self.name = name - - def __repr__(self): - return self.name - - -Unassigned = Variable("Unassigned") - -# ---------------------------------------------------------------------- -# Domains -# ---------------------------------------------------------------------- - - -class Domain(list): - """ - Class used to control possible values for variables - - When list or tuples are used as domains, they are automatically - converted to an instance of that class. - """ - - def __init__(self, set): - """ - @param set: Set of values that the given variables may assume - @type set: set of objects comparable by equality - """ - list.__init__(self, set) - self._hidden = [] - self._states = [] - - def resetState(self): - """ - Reset to the original domain state, including all possible values - """ - self.extend(self._hidden) - del self._hidden[:] - del self._states[:] - - def pushState(self): - """ - Save current domain state - - Variables hidden after that call are restored when that state - is popped from the stack. - """ - self._states.append(len(self)) - - def popState(self): - """ - Restore domain state from the top of the stack - - Variables hidden since the last popped state are then available - again. - """ - diff = self._states.pop() - len(self) - if diff: - self.extend(self._hidden[-diff:]) - del self._hidden[-diff:] - - def hideValue(self, value): - """ - Hide the given value from the domain - - After that call the given value won't be seen as a possible value - on that domain anymore. The hidden value will be restored when the - previous saved state is popped. - - @param value: Object currently available in the domain - """ - list.remove(self, value) - self._hidden.append(value) - -# ---------------------------------------------------------------------- -# Constraints -# ---------------------------------------------------------------------- - - -class Constraint(object): - """ - Abstract base class for constraints - """ - - def __call__(self, variables, domains, assignments, forwardcheck=False): - """ - Perform the constraint checking - - If the forwardcheck parameter is not false, besides telling if - the constraint is currently broken or not, the constraint - implementation may choose to hide values from the domains of - unassigned variables to prevent them from being used, and thus - prune the search space. - - @param variables: Variables affected by that constraint, in the - same order provided by the user - @type variables: sequence - @param domains: Dictionary mapping variables to their domains - @type domains: dict - @param assignments: Dictionary mapping assigned variables to their - current assumed value - @type assignments: dict - @param forwardcheck: Boolean value stating whether forward checking - should be performed or not - @return: Boolean value stating if this constraint is currently - broken or not - @rtype: bool - """ - return True - - def preProcess(self, variables, domains, constraints, vconstraints): - """ - Preprocess variable domains - - This method is called before starting to look for solutions, - and is used to prune domains with specific constraint logic - when possible. For instance, any constraints with a single - variable may be applied on all possible values and removed, - since they may act on individual values even without further - knowledge about other assignments. - - @param variables: Variables affected by that constraint, in the - same order provided by the user - @type variables: sequence - @param domains: Dictionary mapping variables to their domains - @type domains: dict - @param constraints: List of pairs of (constraint, variables) - @type constraints: list - @param vconstraints: Dictionary mapping variables to a list of - constraints affecting the given variables. - @type vconstraints: dict - """ - if len(variables) == 1: - variable = variables[0] - domain = domains[variable] - for value in domain[:]: - if not self(variables, domains, {variable: value}): - domain.remove(value) - constraints.remove((self, variables)) - vconstraints[variable].remove((self, variables)) - - def forwardCheck(self, variables, domains, assignments, - _unassigned=Unassigned): - """ - Helper method for generic forward checking - - Currently, this method acts only when there's a single - unassigned variable. - - @param variables: Variables affected by that constraint, in the - same order provided by the user - @type variables: sequence - @param domains: Dictionary mapping variables to their domains - @type domains: dict - @param assignments: Dictionary mapping assigned variables to their - current assumed value - @type assignments: dict - @return: Boolean value stating if this constraint is currently - broken or not - @rtype: bool - """ - unassignedvariable = _unassigned - for variable in variables: - if variable not in assignments: - if unassignedvariable is _unassigned: - unassignedvariable = variable - else: - break - else: - if unassignedvariable is not _unassigned: - # Remove from the unassigned variable domain's all - # values which break our variable's constraints. - domain = domains[unassignedvariable] - if domain: - for value in domain[:]: - assignments[unassignedvariable] = value - if not self(variables, domains, assignments): - domain.hideValue(value) - del assignments[unassignedvariable] - if not domain: - return False - return True - - -class FunctionConstraint(Constraint): - """ - Constraint which wraps a function defining the constraint logic - - Examples: - - >>> problem = Problem() - >>> problem.addVariables(["a", "b"], [1, 2]) - >>> def func(a, b): - ... return b > a - >>> problem.addConstraint(func, ["a", "b"]) - >>> problem.getSolution() - {'a': 1, 'b': 2} - - >>> problem = Problem() - >>> problem.addVariables(["a", "b"], [1, 2]) - >>> def func(a, b): - ... return b > a - >>> problem.addConstraint(FunctionConstraint(func), ["a", "b"]) - >>> problem.getSolution() - {'a': 1, 'b': 2} - """ - - def __init__(self, func, assigned=True): - """ - @param func: Function wrapped and queried for constraint logic - @type func: callable object - @param assigned: Whether the function may receive unassigned - variables or not - @type assigned: bool - """ - self._func = func - self._assigned = assigned - - def __call__(self, variables, domains, assignments, forwardcheck=False, - _unassigned=Unassigned): - parms = [assignments.get(x, _unassigned) for x in variables] - missing = parms.count(_unassigned) - if missing: - return ((self._assigned or self._func(*parms)) and - (not forwardcheck or missing != 1 or - self.forwardCheck(variables, domains, assignments))) - return self._func(*parms) - - -class AllDifferentConstraint(Constraint): - """ - Constraint enforcing that values of all given variables are different - - Example: - - >>> problem = Problem() - >>> problem.addVariables(["a", "b"], [1, 2]) - >>> problem.addConstraint(AllDifferentConstraint()) - >>> sorted(sorted(x.items()) for x in problem.getSolutions()) - [[('a', 1), ('b', 2)], [('a', 2), ('b', 1)]] - """ - - def __call__(self, variables, domains, assignments, forwardcheck=False, - _unassigned=Unassigned): - seen = {} - for variable in variables: - value = assignments.get(variable, _unassigned) - if value is not _unassigned: - if value in seen: - return False - seen[value] = True - if forwardcheck: - for variable in variables: - if variable not in assignments: - domain = domains[variable] - for value in seen: - if value in domain: - domain.hideValue(value) - if not domain: - return False - return True - - -class AllEqualConstraint(Constraint): - """ - Constraint enforcing that values of all given variables are equal - - Example: - - >>> problem = Problem() - >>> problem.addVariables(["a", "b"], [1, 2]) - >>> problem.addConstraint(AllEqualConstraint()) - >>> sorted(sorted(x.items()) for x in problem.getSolutions()) - [[('a', 1), ('b', 1)], [('a', 2), ('b', 2)]] - """ - - def __call__(self, variables, domains, assignments, forwardcheck=False, - _unassigned=Unassigned): - singlevalue = _unassigned - for variable in variables: - value = assignments.get(variable, _unassigned) - if singlevalue is _unassigned: - singlevalue = value - elif value is not _unassigned and value != singlevalue: - return False - if forwardcheck and singlevalue is not _unassigned: - for variable in variables: - if variable not in assignments: - domain = domains[variable] - if singlevalue not in domain: - return False - for value in domain[:]: - if value != singlevalue: - domain.hideValue(value) - return True - - -class MaxSumConstraint(Constraint): - """ - Constraint enforcing that values of given variables sum up to - a given amount - - Example: - - >>> problem = Problem() - >>> problem.addVariables(["a", "b"], [1, 2]) - >>> problem.addConstraint(MaxSumConstraint(3)) - >>> sorted(sorted(x.items()) for x in problem.getSolutions()) - [[('a', 1), ('b', 1)], [('a', 1), ('b', 2)], [('a', 2), ('b', 1)]] - """ - - def __init__(self, maxsum, multipliers=None): - """ - @param maxsum: Value to be considered as the maximum sum - @type maxsum: number - @param multipliers: If given, variable values will be multiplied by - the given factors before being summed to be checked - @type multipliers: sequence of numbers - """ - self._maxsum = maxsum - self._multipliers = multipliers - - def preProcess(self, variables, domains, constraints, vconstraints): - Constraint.preProcess(self, variables, domains, - constraints, vconstraints) - multipliers = self._multipliers - maxsum = self._maxsum - if multipliers: - for variable, multiplier in zip(variables, multipliers): - domain = domains[variable] - for value in domain[:]: - if value * multiplier > maxsum: - domain.remove(value) - else: - for variable in variables: - domain = domains[variable] - for value in domain[:]: - if value > maxsum: - domain.remove(value) - - def __call__(self, variables, domains, assignments, forwardcheck=False): - multipliers = self._multipliers - maxsum = self._maxsum - sum = 0 - if multipliers: - for variable, multiplier in zip(variables, multipliers): - if variable in assignments: - sum += assignments[variable] * multiplier - if type(sum) is float: - sum = round(sum, 10) - if sum > maxsum: - return False - if forwardcheck: - for variable, multiplier in zip(variables, multipliers): - if variable not in assignments: - domain = domains[variable] - for value in domain[:]: - if sum + value * multiplier > maxsum: - domain.hideValue(value) - if not domain: - return False - else: - for variable in variables: - if variable in assignments: - sum += assignments[variable] - if type(sum) is float: - sum = round(sum, 10) - if sum > maxsum: - return False - if forwardcheck: - for variable in variables: - if variable not in assignments: - domain = domains[variable] - for value in domain[:]: - if sum + value > maxsum: - domain.hideValue(value) - if not domain: - return False - return True - - -class ExactSumConstraint(Constraint): - """ - Constraint enforcing that values of given variables sum exactly - to a given amount - - Example: - - >>> problem = Problem() - >>> problem.addVariables(["a", "b"], [1, 2]) - >>> problem.addConstraint(ExactSumConstraint(3)) - >>> sorted(sorted(x.items()) for x in problem.getSolutions()) - [[('a', 1), ('b', 2)], [('a', 2), ('b', 1)]] - """ - - def __init__(self, exactsum, multipliers=None): - """ - @param exactsum: Value to be considered as the exact sum - @type exactsum: number - @param multipliers: If given, variable values will be multiplied by - the given factors before being summed to be checked - @type multipliers: sequence of numbers - """ - self._exactsum = exactsum - self._multipliers = multipliers - - def preProcess(self, variables, domains, constraints, vconstraints): - Constraint.preProcess(self, variables, domains, - constraints, vconstraints) - multipliers = self._multipliers - exactsum = self._exactsum - if multipliers: - for variable, multiplier in zip(variables, multipliers): - domain = domains[variable] - for value in domain[:]: - if value * multiplier > exactsum: - domain.remove(value) - else: - for variable in variables: - domain = domains[variable] - for value in domain[:]: - if value > exactsum: - domain.remove(value) - - def __call__(self, variables, domains, assignments, forwardcheck=False): - multipliers = self._multipliers - exactsum = self._exactsum - sum = 0 - missing = False - if multipliers: - for variable, multiplier in zip(variables, multipliers): - if variable in assignments: - sum += assignments[variable] * multiplier - else: - missing = True - if type(sum) is float: - sum = round(sum, 10) - if sum > exactsum: - return False - if forwardcheck and missing: - for variable, multiplier in zip(variables, multipliers): - if variable not in assignments: - domain = domains[variable] - for value in domain[:]: - if sum + value * multiplier > exactsum: - domain.hideValue(value) - if not domain: - return False - else: - for variable in variables: - if variable in assignments: - sum += assignments[variable] - else: - missing = True - if type(sum) is float: - sum = round(sum, 10) - if sum > exactsum: - return False - if forwardcheck and missing: - for variable in variables: - if variable not in assignments: - domain = domains[variable] - for value in domain[:]: - if sum + value > exactsum: - domain.hideValue(value) - if not domain: - return False - if missing: - return sum <= exactsum - else: - return sum == exactsum - - -class MinSumConstraint(Constraint): - """ - Constraint enforcing that values of given variables sum at least - to a given amount - - Example: - - >>> problem = Problem() - >>> problem.addVariables(["a", "b"], [1, 2]) - >>> problem.addConstraint(MinSumConstraint(3)) - >>> sorted(sorted(x.items()) for x in problem.getSolutions()) - [[('a', 1), ('b', 2)], [('a', 2), ('b', 1)], [('a', 2), ('b', 2)]] - """ - - def __init__(self, minsum, multipliers=None): - """ - @param minsum: Value to be considered as the minimum sum - @type minsum: number - @param multipliers: If given, variable values will be multiplied by - the given factors before being summed to be checked - @type multipliers: sequence of numbers - """ - self._minsum = minsum - self._multipliers = multipliers - - def __call__(self, variables, domains, assignments, forwardcheck=False): - for variable in variables: - if variable not in assignments: - return True - else: - multipliers = self._multipliers - minsum = self._minsum - sum = 0 - if multipliers: - for variable, multiplier in zip(variables, multipliers): - sum += assignments[variable] * multiplier - else: - for variable in variables: - sum += assignments[variable] - if type(sum) is float: - sum = round(sum, 10) - return sum >= minsum - - -class InSetConstraint(Constraint): - """ - Constraint enforcing that values of given variables are present in - the given set - - Example: - - >>> problem = Problem() - >>> problem.addVariables(["a", "b"], [1, 2]) - >>> problem.addConstraint(InSetConstraint([1])) - >>> sorted(sorted(x.items()) for x in problem.getSolutions()) - [[('a', 1), ('b', 1)]] - """ - - def __init__(self, set): - """ - @param set: Set of allowed values - @type set: set - """ - self._set = set - - def __call__(self, variables, domains, assignments, forwardcheck=False): - # preProcess() will remove it. - raise RuntimeError("Can't happen") - - def preProcess(self, variables, domains, constraints, vconstraints): - set = self._set - for variable in variables: - domain = domains[variable] - for value in domain[:]: - if value not in set: - domain.remove(value) - vconstraints[variable].remove((self, variables)) - constraints.remove((self, variables)) - - -class NotInSetConstraint(Constraint): - """ - Constraint enforcing that values of given variables are not present in - the given set - - Example: - - >>> problem = Problem() - >>> problem.addVariables(["a", "b"], [1, 2]) - >>> problem.addConstraint(NotInSetConstraint([1])) - >>> sorted(sorted(x.items()) for x in problem.getSolutions()) - [[('a', 2), ('b', 2)]] - """ - - def __init__(self, set): - """ - @param set: Set of disallowed values - @type set: set - """ - self._set = set - - def __call__(self, variables, domains, assignments, forwardcheck=False): - # preProcess() will remove it. - raise RuntimeError("Can't happen") - - def preProcess(self, variables, domains, constraints, vconstraints): - set = self._set - for variable in variables: - domain = domains[variable] - for value in domain[:]: - if value in set: - domain.remove(value) - vconstraints[variable].remove((self, variables)) - constraints.remove((self, variables)) - - -class SomeInSetConstraint(Constraint): - """ - Constraint enforcing that at least some of the values of given - variables must be present in a given set - - Example: - - >>> problem = Problem() - >>> problem.addVariables(["a", "b"], [1, 2]) - >>> problem.addConstraint(SomeInSetConstraint([1])) - >>> sorted(sorted(x.items()) for x in problem.getSolutions()) - [[('a', 1), ('b', 1)], [('a', 1), ('b', 2)], [('a', 2), ('b', 1)]] - """ - - def __init__(self, set, n=1, exact=False): - """ - @param set: Set of values to be checked - @type set: set - @param n: Minimum number of assigned values that should be present - in set (default is 1) - @type n: int - @param exact: Whether the number of assigned values which are - present in set must be exactly C{n} - @type exact: bool - """ - self._set = set - self._n = n - self._exact = exact - - def __call__(self, variables, domains, assignments, forwardcheck=False): - set = self._set - missing = 0 - found = 0 - for variable in variables: - if variable in assignments: - found += assignments[variable] in set - else: - missing += 1 - if missing: - if self._exact: - if not (found <= self._n <= missing + found): - return False - else: - if self._n > missing + found: - return False - if forwardcheck and self._n - found == missing: - # All unassigned variables must be assigned to - # values in the set. - for variable in variables: - if variable not in assignments: - domain = domains[variable] - for value in domain[:]: - if value not in set: - domain.hideValue(value) - if not domain: - return False - else: - if self._exact: - if found != self._n: - return False - else: - if found < self._n: - return False - return True - - -class SomeNotInSetConstraint(Constraint): - """ - Constraint enforcing that at least some of the values of given - variables must not be present in a given set - - Example: - - >>> problem = Problem() - >>> problem.addVariables(["a", "b"], [1, 2]) - >>> problem.addConstraint(SomeNotInSetConstraint([1])) - >>> sorted(sorted(x.items()) for x in problem.getSolutions()) - [[('a', 1), ('b', 2)], [('a', 2), ('b', 1)], [('a', 2), ('b', 2)]] - """ - - def __init__(self, set, n=1, exact=False): - """ - @param set: Set of values to be checked - @type set: set - @param n: Minimum number of assigned values that should not be present - in set (default is 1) - @type n: int - @param exact: Whether the number of assigned values which are - not present in set must be exactly C{n} - @type exact: bool - """ - self._set = set - self._n = n - self._exact = exact - - def __call__(self, variables, domains, assignments, forwardcheck=False): - set = self._set - missing = 0 - found = 0 - for variable in variables: - if variable in assignments: - found += assignments[variable] not in set - else: - missing += 1 - if missing: - if self._exact: - if not (found <= self._n <= missing + found): - return False - else: - if self._n > missing + found: - return False - if forwardcheck and self._n - found == missing: - # All unassigned variables must be assigned to - # values not in the set. - for variable in variables: - if variable not in assignments: - domain = domains[variable] - for value in domain[:]: - if value in set: - domain.hideValue(value) - if not domain: - return False - else: - if self._exact: - if found != self._n: - return False - else: - if found < self._n: - return False - return True - - -if __name__ == "__main__": - import doctest - doctest.testmod() diff --git a/csp/port2/python-constraint-master/constraint/compat.py b/csp/port2/python-constraint-master/constraint/compat.py deleted file mode 100755 index ef31a009..00000000 --- a/csp/port2/python-constraint-master/constraint/compat.py +++ /dev/null @@ -1,14 +0,0 @@ -#!/usr/bin/env python -# -*- coding: utf-8 -*- - -import sys - -PY2 = sys.version_info[0] == 2 -PY3 = (sys.version_info[0] >= 3) - -if PY3: - string_types = str - xrange = range -else: - string_types = basestring # noqa - xrange = xrange diff --git a/csp/port2/python-constraint-master/constraint/version.py b/csp/port2/python-constraint-master/constraint/version.py deleted file mode 100755 index af97862e..00000000 --- a/csp/port2/python-constraint-master/constraint/version.py +++ /dev/null @@ -1,8 +0,0 @@ -__author__ = "Gustavo Niemeyer" -__copyright__ = "Copyright (c) 2005-2014 - Gustavo Niemeyer " -__credits__ = ["Sebastien Celles"] -__license__ = "" -__version__ = "1.3.1" -__email__ = "gustavo@niemeyer.net" -__status__ = "Development" -__url__ = 'https://github.com/python-constraint/python-constraint' diff --git a/csp/port2/python-constraint-master/examples/__init__.py b/csp/port2/python-constraint-master/examples/__init__.py deleted file mode 100755 index e69de29b..00000000 diff --git a/csp/port2/python-constraint-master/examples/abc/__init__.py b/csp/port2/python-constraint-master/examples/abc/__init__.py deleted file mode 100755 index e69de29b..00000000 diff --git a/csp/port2/python-constraint-master/examples/abc/abc.py b/csp/port2/python-constraint-master/examples/abc/abc.py deleted file mode 100755 index 27b72906..00000000 --- a/csp/port2/python-constraint-master/examples/abc/abc.py +++ /dev/null @@ -1,37 +0,0 @@ -#!/usr/bin/python -# -# What's the minimum value for: -# -# ABC -# ------- -# A+B+C -# -# From http://www.umassd.edu/mathcontest/abc.cfm -# -from constraint import Problem - - -def solve(): - problem = Problem() - problem.addVariables("abc", range(1, 10)) - problem.getSolutions() - minvalue = 999 / (9 * 3) - minsolution = {} - for solution in problem.getSolutions(): - a = solution["a"] - b = solution["b"] - c = solution["c"] - value = (a * 100 + b * 10 + c) / (a + b + c) - if value < minvalue: - minsolution = solution - return minvalue, minsolution - - -def main(): - minvalue, minsolution = solve() - print(minvalue) - print(minsolution) - - -if __name__ == "__main__": - main() diff --git a/csp/port2/python-constraint-master/examples/coins/__init__.py b/csp/port2/python-constraint-master/examples/coins/__init__.py deleted file mode 100755 index e69de29b..00000000 diff --git a/csp/port2/python-constraint-master/examples/coins/coins.py b/csp/port2/python-constraint-master/examples/coins/coins.py deleted file mode 100755 index 98c2b62d..00000000 --- a/csp/port2/python-constraint-master/examples/coins/coins.py +++ /dev/null @@ -1,36 +0,0 @@ -#!/usr/bin/python -# -# 100 coins must sum to $5.00 -# -# That's kind of a country-specific problem, since depending on the -# country there are different values for coins. Here is presented -# the solution for a given set. -# -from constraint import Problem, ExactSumConstraint -import sys - - -def solve(): - problem = Problem() - total = 5.00 - variables = ("0.01", "0.05", "0.10", "0.50", "1.00") - values = [float(x) for x in variables] - for variable, value in zip(variables, values): - problem.addVariable(variable, range(int(total / value))) - problem.addConstraint(ExactSumConstraint(total, values), variables) - problem.addConstraint(ExactSumConstraint(100)) - solutions = problem.getSolutionIter() - return solutions, variables - - -def main(): - solutions, variables = solve() - for i, solution in enumerate(solutions): - sys.stdout.write("%03d -> " % (i + 1)) - for variable in variables: - sys.stdout.write("%s:%d " % (variable, solution[variable])) - sys.stdout.write("\n") - - -if __name__ == "__main__": - main() diff --git a/csp/port2/python-constraint-master/examples/crosswords/__init__.py b/csp/port2/python-constraint-master/examples/crosswords/__init__.py deleted file mode 100755 index e69de29b..00000000 diff --git a/csp/port2/python-constraint-master/examples/crosswords/crosswords.py b/csp/port2/python-constraint-master/examples/crosswords/crosswords.py deleted file mode 100755 index df0fce61..00000000 --- a/csp/port2/python-constraint-master/examples/crosswords/crosswords.py +++ /dev/null @@ -1,154 +0,0 @@ -#!/usr/bin/python -from constraint import Problem, AllDifferentConstraint -import random -import sys - -MINLEN = 3 - - -def main(puzzle, lines): - puzzle = puzzle.rstrip().splitlines() - while puzzle and not puzzle[0]: - del puzzle[0] - - # Extract horizontal words - horizontal = [] - word = [] - predefined = {} - for row in range(len(puzzle)): - for col in range(len(puzzle[row])): - char = puzzle[row][col] - if not char.isspace(): - word.append((row, col)) - if char != "#": - predefined[row, col] = char - elif word: - if len(word) > MINLEN: - horizontal.append(word[:]) - del word[:] - if word: - if len(word) > MINLEN: - horizontal.append(word[:]) - del word[:] - - # Extract vertical words - vertical = [] - validcol = True - col = 0 - while validcol: - validcol = False - for row in range(len(puzzle)): - if col >= len(puzzle[row]): - if word: - if len(word) > MINLEN: - vertical.append(word[:]) - del word[:] - else: - validcol = True - char = puzzle[row][col] - if not char.isspace(): - word.append((row, col)) - if char != "#": - predefined[row, col] = char - elif word: - if len(word) > MINLEN: - vertical.append(word[:]) - del word[:] - if word: - if len(word) > MINLEN: - vertical.append(word[:]) - del word[:] - col += 1 - - # hnames = ["h%d" % i for i in range(len(horizontal))] - # vnames = ["v%d" % i for i in range(len(vertical))] - - # problem = Problem(MinConflictsSolver()) - problem = Problem() - - for hi, hword in enumerate(horizontal): - for vi, vword in enumerate(vertical): - for hchar in hword: - if hchar in vword: - hci = hword.index(hchar) - vci = vword.index(hchar) - problem.addConstraint(lambda hw, vw, hci=hci, vci=vci: - hw[hci] == vw[vci], - ("h%d" % hi, "v%d" % vi)) - - for char, letter in predefined.items(): - for hi, hword in enumerate(horizontal): - if char in hword: - hci = hword.index(char) - problem.addConstraint(lambda hw, hci=hci, letter=letter: - hw[hci] == letter, ("h%d" % hi,)) - for vi, vword in enumerate(vertical): - if char in vword: - vci = vword.index(char) - problem.addConstraint(lambda vw, vci=vci, letter=letter: - vw[vci] == letter, ("v%d" % vi,)) - - wordsbylen = {} - for hword in horizontal: - wordsbylen[len(hword)] = [] - for vword in vertical: - wordsbylen[len(vword)] = [] - - for line in lines: - line = line.strip() - ll = len(line) - if ll in wordsbylen: - wordsbylen[ll].append(line.upper()) - - for hi, hword in enumerate(horizontal): - words = wordsbylen[len(hword)] - random.shuffle(words) - problem.addVariable("h%d" % hi, words) - for vi, vword in enumerate(vertical): - words = wordsbylen[len(vword)] - random.shuffle(words) - problem.addVariable("v%d" % vi, words) - - problem.addConstraint(AllDifferentConstraint()) - - solution = problem.getSolution() - if not solution: - print("No solution found!") - - maxcol = 0 - maxrow = 0 - for hword in horizontal: - for row, col in hword: - if row > maxrow: - maxrow = row - if col > maxcol: - maxcol = col - for vword in vertical: - for row, col in vword: - if row > maxrow: - maxrow = row - if col > maxcol: - maxcol = col - - matrix = [] - for row in range(maxrow + 1): - matrix.append([" "] * (maxcol + 1)) - - for variable in solution: - if variable[0] == "v": - word = vertical[int(variable[1:])] - else: - word = horizontal[int(variable[1:])] - for (row, col), char in zip(word, solution[variable]): - matrix[row][col] = char - - for row in range(maxrow + 1): - for col in range(maxcol + 1): - sys.stdout.write(matrix[row][col]) - sys.stdout.write("\n") - - -if __name__ == "__main__": - if len(sys.argv) != 3: - sys.exit("Usage: crosswords.py ") - main(open(sys.argv[1]).read(), open(sys.argv[2])) diff --git a/csp/port2/python-constraint-master/examples/crosswords/large.mask b/csp/port2/python-constraint-master/examples/crosswords/large.mask deleted file mode 100755 index ba5364c8..00000000 --- a/csp/port2/python-constraint-master/examples/crosswords/large.mask +++ /dev/null @@ -1,27 +0,0 @@ - -# ######## # -# # # # # -######## # # -# # # # # -# # ######## -# # # # # # -######## # # -# # # # # # - # # # -######## # # - # # # # # - # ######## - # # # # # - # # ######## - # # # # # # - # # ######## - # # # # -######## # # - # # # # # # - # # # # # # - ######## # # - # # # # - # ######## - # # # # -######## # # - diff --git a/csp/port2/python-constraint-master/examples/crosswords/medium.mask b/csp/port2/python-constraint-master/examples/crosswords/medium.mask deleted file mode 100755 index 3332a097..00000000 --- a/csp/port2/python-constraint-master/examples/crosswords/medium.mask +++ /dev/null @@ -1,19 +0,0 @@ - - # -######### -# # # -# # ###### -# # # -# # # # -# # # # -######## # -# # # - # # # - ######### - # # # - ######### - # # # - # # -####### - # - diff --git a/csp/port2/python-constraint-master/examples/crosswords/python.mask b/csp/port2/python-constraint-master/examples/crosswords/python.mask deleted file mode 100755 index fe5a5767..00000000 --- a/csp/port2/python-constraint-master/examples/crosswords/python.mask +++ /dev/null @@ -1,8 +0,0 @@ - P - Y -####T#### - # H # - # O # -####N # - # # -######### diff --git a/csp/port2/python-constraint-master/examples/crosswords/small.mask b/csp/port2/python-constraint-master/examples/crosswords/small.mask deleted file mode 100755 index 0e43ff78..00000000 --- a/csp/port2/python-constraint-master/examples/crosswords/small.mask +++ /dev/null @@ -1,8 +0,0 @@ - # - # -######### - # # - # # # # -##### # # - # # # -######### diff --git a/csp/port2/python-constraint-master/examples/einstein/__init__.py b/csp/port2/python-constraint-master/examples/einstein/__init__.py deleted file mode 100755 index e69de29b..00000000 diff --git a/csp/port2/python-constraint-master/examples/einstein/einstein.py b/csp/port2/python-constraint-master/examples/einstein/einstein.py deleted file mode 100755 index 2ce6e45b..00000000 --- a/csp/port2/python-constraint-master/examples/einstein/einstein.py +++ /dev/null @@ -1,209 +0,0 @@ -#!/usr/bin/python -# -# ALBERT EINSTEIN'S RIDDLE -# -# ARE YOU IN THE TOP 2% OF INTELLIGENT PEOPLE IN THE WORLD? -# SOLVE THE RIDDLE AND FIND OUT. -# -# There are no tricks, just pure logic, so good luck and don't give up. -# -# 1. In a street there are five houses, painted five different colours. -# 2. In each house lives a person of different nationality -# 3. These five homeowners each drink a different kind of beverage, smoke -# different brand of cigar and keep a different pet. -# -# THE QUESTION: WHO OWNS THE FISH? -# -# HINTS -# -# 1. The Brit lives in a red house. -# 2. The Swede keeps dogs as pets. -# 3. The Dane drinks tea. -# 4. The Green house is on the left of the White house. -# 5. The owner of the Green house drinks coffee. -# 6. The person who smokes Pall Mall rears birds. -# 7. The owner of the Yellow house smokes Dunhill. -# 8. The man living in the centre house drinks milk. -# 9. The Norwegian lives in the first house. -# 10. The man who smokes Blends lives next to the one who keeps cats. -# 11. The man who keeps horses lives next to the man who smokes Dunhill. -# 12. The man who smokes Blue Master drinks beer. -# 13. The German smokes Prince. -# 14. The Norwegian lives next to the blue house. -# 15. The man who smokes Blends has a neighbour who drinks water. -# -# ALBERT EINSTEIN WROTE THIS RIDDLE EARLY DURING THE 19th CENTURY. HE -# SAID THAT 98% OF THE WORLD POPULATION WOULD NOT BE ABLE TO SOLVE IT. - -from constraint import Problem, AllDifferentConstraint - -# Check http://www.csc.fi/oppaat/f95/python/talot.py - - -def solve(): - problem = Problem() - for i in range(1, 6): - problem.addVariable("color%d" % i, - ["red", "white", "green", "yellow", "blue"]) - problem.addVariable("nationality%d" % i, - ["brit", "swede", "dane", "norwegian", "german"]) - problem.addVariable("drink%d" % i, - ["tea", "coffee", "milk", "beer", "water"]) - problem.addVariable("smoke%d" % i, - ["pallmall", "dunhill", "blends", - "bluemaster", "prince"]) - problem.addVariable("pet%d" % i, - ["dogs", "birds", "cats", "horses", "fish"]) - - problem.addConstraint(AllDifferentConstraint(), - ["color%d" % i for i in range(1, 6)]) - problem.addConstraint(AllDifferentConstraint(), - ["nationality%d" % i for i in range(1, 6)]) - problem.addConstraint(AllDifferentConstraint(), - ["drink%d" % i for i in range(1, 6)]) - problem.addConstraint(AllDifferentConstraint(), - ["smoke%d" % i for i in range(1, 6)]) - problem.addConstraint(AllDifferentConstraint(), - ["pet%d" % i for i in range(1, 6)]) - - for i in range(1, 6): - - # Hint 1 - problem.addConstraint(lambda nationality, color: - nationality != "brit" or color == "red", - ("nationality%d" % i, "color%d" % i)) - - # Hint 2 - problem.addConstraint(lambda nationality, pet: - nationality != "swede" or pet == "dogs", - ("nationality%d" % i, "pet%d" % i)) - - # Hint 3 - problem.addConstraint(lambda nationality, drink: - nationality != "dane" or drink == "tea", - ("nationality%d" % i, "drink%d" % i)) - - # Hint 4 - if i < 5: - problem.addConstraint(lambda colora, colorb: - colora != "green" or colorb == "white", - ("color%d" % i, "color%d" % (i + 1))) - else: - problem.addConstraint(lambda color: color != "green", - ("color%d" % i,)) - - # Hint 5 - problem.addConstraint(lambda color, drink: - color != "green" or drink == "coffee", - ("color%d" % i, "drink%d" % i)) - - # Hint 6 - problem.addConstraint(lambda smoke, pet: - smoke != "pallmall" or pet == "birds", - ("smoke%d" % i, "pet%d" % i)) - - # Hint 7 - problem.addConstraint(lambda color, smoke: - color != "yellow" or smoke == "dunhill", - ("color%d" % i, "smoke%d" % i)) - - # Hint 8 - if i == 3: - problem.addConstraint(lambda drink: drink == "milk", - ("drink%d" % i,)) - - # Hint 9 - if i == 1: - problem.addConstraint(lambda nationality: - nationality == "norwegian", - ("nationality%d" % i,)) - - # Hint 10 - if 1 < i < 5: - problem.addConstraint(lambda smoke, peta, petb: - smoke != "blends" or peta == "cats" or - petb == "cats", - ("smoke%d" % i, "pet%d" % (i - 1), - "pet%d" % (i + 1))) - else: - problem.addConstraint(lambda smoke, pet: - smoke != "blends" or pet == "cats", - ("smoke%d" % i, - "pet%d" % (i == 1 and 2 or 4))) - - # Hint 11 - if 1 < i < 5: - problem.addConstraint(lambda pet, smokea, smokeb: - pet != "horses" or smokea == "dunhill" or - smokeb == "dunhill", - ("pet%d" % i, "smoke%d" % (i - 1), - "smoke%d" % (i + 1))) - else: - problem.addConstraint(lambda pet, smoke: - pet != "horses" or smoke == "dunhill", - ("pet%d" % i, - "smoke%d" % (i == 1 and 2 or 4))) - - # Hint 12 - problem.addConstraint(lambda smoke, drink: - smoke != "bluemaster" or drink == "beer", - ("smoke%d" % i, "drink%d" % i)) - - # Hint 13 - problem.addConstraint(lambda nationality, smoke: - nationality != "german" or smoke == "prince", - ("nationality%d" % i, "smoke%d" % i)) - - # Hint 14 - if 1 < i < 5: - problem.addConstraint(lambda nationality, colora, colorb: - nationality != "norwegian" or - colora == "blue" or colorb == "blue", - ("nationality%d" % i, "color%d" % (i - 1), - "color%d" % (i + 1))) - else: - problem.addConstraint(lambda nationality, color: - nationality != "norwegian" or - color == "blue", - ("nationality%d" % i, - "color%d" % (i == 1 and 2 or 4))) - - # Hint 15 - if 1 < i < 5: - problem.addConstraint(lambda smoke, drinka, drinkb: - smoke != "blends" or - drinka == "water" or drinkb == "water", - ("smoke%d" % i, "drink%d" % (i - 1), - "drink%d" % (i + 1))) - else: - problem.addConstraint(lambda smoke, drink: - smoke != "blends" or drink == "water", - ("smoke%d" % i, - "drink%d" % (i == 1 and 2 or 4))) - - solutions = problem.getSolutions() - return solutions - - -def showSolution(solution): - for i in range(1, 6): - print("House %d" % i) - print("--------") - print("Nationality: %s" % solution["nationality%d" % i]) - print("Color: %s" % solution["color%d" % i]) - print("Drink: %s" % solution["drink%d" % i]) - print("Smoke: %s" % solution["smoke%d" % i]) - print("Pet: %s" % solution["pet%d" % i]) - print("") - - -def main(): - solutions = solve() - print("Found %d solution(s)!" % len(solutions)) - print("") - for solution in solutions: - showSolution(solution) - - -if __name__ == "__main__": - main() diff --git a/csp/port2/python-constraint-master/examples/queens/__init__.py b/csp/port2/python-constraint-master/examples/queens/__init__.py deleted file mode 100755 index e69de29b..00000000 diff --git a/csp/port2/python-constraint-master/examples/queens/queens.py b/csp/port2/python-constraint-master/examples/queens/queens.py deleted file mode 100755 index 88aa5651..00000000 --- a/csp/port2/python-constraint-master/examples/queens/queens.py +++ /dev/null @@ -1,54 +0,0 @@ -#!/usr/bin/python -# -# http://mathworld.wolfram.com/QueensProblem.html -# -from constraint import Problem -import sys - - -def solve(): - problem = Problem() - size = 8 - cols = range(size) - rows = range(size) - problem.addVariables(cols, rows) - for col1 in cols: - for col2 in cols: - if col1 < col2: - problem.addConstraint(lambda row1, row2, col1=col1, col2=col2: - abs(row1 - row2) != abs(col1 - col2) and - row1 != row2, (col1, col2)) - solutions = problem.getSolutions() - return solutions, size - - -def showSolution(solution, size): - sys.stdout.write(" %s \n" % ("-" * ((size * 4) - 1))) - for i in range(size): - sys.stdout.write(" |") - for j in range(size): - if solution[j] == i: - sys.stdout.write(" %d |" % j) - else: - sys.stdout.write(" |") - sys.stdout.write("\n") - if i != size - 1: - sys.stdout.write(" |%s|\n" % ("-" * ((size * 4) - 1))) - sys.stdout.write(" %s \n" % ("-" * ((size * 4) - 1))) - - -def main(show=False): - solutions, size = solve() - print("Found %d solution(s)!" % len(solutions)) - if show: - for solution in solutions: - showSolution(solution, size) - - -if __name__ == "__main__": - show = False - if len(sys.argv) == 2 and sys.argv[1] == "-s": - show = True - elif len(sys.argv) != 1: - sys.exit("Usage: queens.py [-s]") - main(show) diff --git a/csp/port2/python-constraint-master/examples/rooks/__init__.py b/csp/port2/python-constraint-master/examples/rooks/__init__.py deleted file mode 100755 index e69de29b..00000000 diff --git a/csp/port2/python-constraint-master/examples/rooks/rooks.py b/csp/port2/python-constraint-master/examples/rooks/rooks.py deleted file mode 100755 index a7979019..00000000 --- a/csp/port2/python-constraint-master/examples/rooks/rooks.py +++ /dev/null @@ -1,57 +0,0 @@ -#!/usr/bin/python -# -# http://mathworld.wolfram.com/RooksProblem.html -# -from constraint import Problem -import sys - - -def factorial(x): - return x == 1 or factorial(x - 1) * x - - -def solve(size): - problem = Problem() - cols = range(size) - rows = range(size) - problem.addVariables(cols, rows) - for col1 in cols: - for col2 in cols: - if col1 < col2: - problem.addConstraint(lambda row1, row2: row1 != row2, - (col1, col2)) - solutions = problem.getSolutions() - return solutions - - -def main(show=False): - size = 8 - solutions = solve(size) - print("Found %d solution(s)!" % len(solutions)) - if show: - for solution in solutions: - showSolution(solution, size) - - -def showSolution(solution, size): - sys.stdout.write(" %s \n" % ("-" * ((size * 4) - 1))) - for i in range(size): - sys.stdout.write(" |") - for j in range(size): - if solution[j] == i: - sys.stdout.write(" %d |" % j) - else: - sys.stdout.write(" |") - sys.stdout.write("\n") - if i != size - 1: - sys.stdout.write(" |%s|\n" % ("-" * ((size * 4) - 1))) - sys.stdout.write(" %s \n" % ("-" * ((size * 4) - 1))) - - -if __name__ == "__main__": - show = False - if len(sys.argv) == 2 and sys.argv[1] == "-s": - show = True - elif len(sys.argv) != 1: - sys.exit("Usage: rooks.py [-s]") - main(show) diff --git a/csp/port2/python-constraint-master/examples/studentdesks/__init__.py b/csp/port2/python-constraint-master/examples/studentdesks/__init__.py deleted file mode 100755 index e69de29b..00000000 diff --git a/csp/port2/python-constraint-master/examples/studentdesks/studentdesks.py b/csp/port2/python-constraint-master/examples/studentdesks/studentdesks.py deleted file mode 100755 index a2978ec9..00000000 --- a/csp/port2/python-constraint-master/examples/studentdesks/studentdesks.py +++ /dev/null @@ -1,48 +0,0 @@ -#!/usr/bin/python -# -# http://home.chello.no/~dudley/ -# -from constraint import Problem, AllDifferentConstraint, SomeInSetConstraint -import sys - -STUDENTDESKS = [[0, 1, 0, 0, 0, 0], - [0, 2, 3, 4, 5, 6], - [0, 7, 8, 9, 10, 0], - [0, 11, 12, 13, 14, 0], - [15, 16, 17, 18, 19, 0], - [0, 0, 0, 0, 20, 0]] - - -def solve(): - problem = Problem() - problem.addVariables(range(1, 21), ["A", "B", "C", "D", "E"]) - problem.addConstraint(SomeInSetConstraint(["A"], 4, True)) - problem.addConstraint(SomeInSetConstraint(["B"], 4, True)) - problem.addConstraint(SomeInSetConstraint(["C"], 4, True)) - problem.addConstraint(SomeInSetConstraint(["D"], 4, True)) - problem.addConstraint(SomeInSetConstraint(["E"], 4, True)) - for row in range(len(STUDENTDESKS) - 1): - for col in range(len(STUDENTDESKS[row]) - 1): - lst = [STUDENTDESKS[row][col], STUDENTDESKS[row][col + 1], - STUDENTDESKS[row + 1][col], STUDENTDESKS[row + 1][col + 1]] - lst = [x for x in lst if x] - problem.addConstraint(AllDifferentConstraint(), lst) - solutions = problem.getSolution() - return solutions - - -def main(): - solutions = solve() - showSolution(solutions) - - -def showSolution(solution): - for row in range(len(STUDENTDESKS)): - for col in range(len(STUDENTDESKS[row])): - id = STUDENTDESKS[row][col] - sys.stdout.write(" %s" % (id and solution[id] or " ")) - sys.stdout.write("\n") - - -if __name__ == "__main__": - main() diff --git a/csp/port2/python-constraint-master/examples/sudoku/__init__.py b/csp/port2/python-constraint-master/examples/sudoku/__init__.py deleted file mode 100755 index e69de29b..00000000 diff --git a/csp/port2/python-constraint-master/examples/sudoku/sudoku.py b/csp/port2/python-constraint-master/examples/sudoku/sudoku.py deleted file mode 100755 index 820c76dd..00000000 --- a/csp/port2/python-constraint-master/examples/sudoku/sudoku.py +++ /dev/null @@ -1,71 +0,0 @@ -# -# Sudoku puzzle solver by by Luigi Poderico (www.poderico.it). -# -import sys -from constraint import Problem, AllDifferentConstraint - - -def solve(): - problem = Problem() - - # Define the variables: 9 rows of 9 variables rangin in 1...9 - for i in range(1, 10): - problem.addVariables(range(i * 10 + 1, i * 10 + 10), range(1, 10)) - - # Each row has different values - for i in range(1, 10): - problem.addConstraint(AllDifferentConstraint(), range(i * 10 + 1, i * 10 + 10)) - - # Each colum has different values - for i in range(1, 10): - problem.addConstraint(AllDifferentConstraint(), range(10 + i, 100 + i, 10)) - - # Each 3x3 box has different values - problem.addConstraint(AllDifferentConstraint(), [11, 12, 13, 21, 22, 23, 31, 32, 33]) - problem.addConstraint(AllDifferentConstraint(), [41, 42, 43, 51, 52, 53, 61, 62, 63]) - problem.addConstraint(AllDifferentConstraint(), [71, 72, 73, 81, 82, 83, 91, 92, 93]) - - problem.addConstraint(AllDifferentConstraint(), [14, 15, 16, 24, 25, 26, 34, 35, 36]) - problem.addConstraint(AllDifferentConstraint(), [44, 45, 46, 54, 55, 56, 64, 65, 66]) - problem.addConstraint(AllDifferentConstraint(), [74, 75, 76, 84, 85, 86, 94, 95, 96]) - - problem.addConstraint(AllDifferentConstraint(), [17, 18, 19, 27, 28, 29, 37, 38, 39]) - problem.addConstraint(AllDifferentConstraint(), [47, 48, 49, 57, 58, 59, 67, 68, 69]) - problem.addConstraint(AllDifferentConstraint(), [77, 78, 79, 87, 88, 89, 97, 98, 99]) - - # Some value is given. - initValue = [[0, 9, 0, 7, 0, 0, 8, 6, 0], - [0, 3, 1, 0, 0, 5, 0, 2, 0], - [8, 0, 6, 0, 0, 0, 0, 0, 0], - [0, 0, 7, 0, 5, 0, 0, 0, 6], - [0, 0, 0, 3, 0, 7, 0, 0, 0], - [5, 0, 0, 0, 1, 0, 7, 0, 0], - [0, 0, 0, 0, 0, 0, 1, 0, 9], - [0, 2, 0, 6, 0, 0, 0, 5, 0], - [0, 5, 4, 0, 0, 8, 0, 7, 0]] - - for i in range(1, 10): - for j in range(1, 10): - if initValue[i - 1][j - 1] != 0: - problem.addConstraint(lambda var, val=initValue[i - 1][j - 1]: - var == val, (i * 10 + j,)) - - # Get the solutions. - solutions = problem.getSolutions() - return solutions - - -def main(): - solutions = solve() - # Print the solutions - for solution in solutions: - for i in range(1, 10): - for j in range(1, 10): - index = i * 10 + j - sys.stdout.write("%s " % solution[index]) - print("") - print("") - - -if __name__ == "__main__": - main() diff --git a/csp/port2/python-constraint-master/examples/wordmath/__init__.py b/csp/port2/python-constraint-master/examples/wordmath/__init__.py deleted file mode 100755 index e69de29b..00000000 diff --git a/csp/port2/python-constraint-master/examples/wordmath/seisseisdoze.py b/csp/port2/python-constraint-master/examples/wordmath/seisseisdoze.py deleted file mode 100755 index 22776db0..00000000 --- a/csp/port2/python-constraint-master/examples/wordmath/seisseisdoze.py +++ /dev/null @@ -1,39 +0,0 @@ -#!/usr/bin/python -# -# Assign equal values to equal letters, and different values to -# different letters, in a way that satisfies the following sum: -# -# SEIS -# + SEIS -# ------ -# DOZE -# -from constraint import Problem, AllDifferentConstraint - - -def solve(): - problem = Problem() - problem.addVariables("seidoz", range(10)) - problem.addConstraint(lambda s, e: (2 * s) % 10 == e, "se") - problem.addConstraint(lambda i, s, z, e: ((10 * 2 * i) + (2 * s)) % 100 == - z * 10 + e, "isze") - problem.addConstraint(lambda s, e, i, d, o, z: - 2 * (s * 1000 + e * 100 + i * 10 + s) == - d * 1000 + o * 100 + z * 10 + e, "seidoz") - problem.addConstraint(lambda s: s != 0, "s") - problem.addConstraint(lambda d: d != 0, "d") - problem.addConstraint(AllDifferentConstraint()) - solutions = problem.getSolutions() - return solutions - - -def main(): - solutions = solve() - print("SEIS+SEIS=DOZE") - for s in solutions: - print("%(s)d%(e)d%(i)d%(s)s+%(s)d%(e)d%(i)d%(s)d=" - "%(d)d%(o)d%(z)d%(e)d") % s - - -if __name__ == "__main__": - main() diff --git a/csp/port2/python-constraint-master/examples/wordmath/sendmoremoney.py b/csp/port2/python-constraint-master/examples/wordmath/sendmoremoney.py deleted file mode 100755 index 9e9578ec..00000000 --- a/csp/port2/python-constraint-master/examples/wordmath/sendmoremoney.py +++ /dev/null @@ -1,42 +0,0 @@ -#!/usr/bin/python -# -# Assign equal values to equal letters, and different values to -# different letters, in a way that satisfies the following sum: -# -# SEND -# + MORE -# ------ -# MONEY -# -from constraint import Problem, NotInSetConstraint, AllDifferentConstraint - - -def solve(): - problem = Problem() - problem.addVariables("sendmory", range(10)) - problem.addConstraint(lambda d, e, y: (d + e) % 10 == y, "dey") - problem.addConstraint(lambda n, d, r, e, y: (n * 10 + d + r * 10 + e) % 100 == - e * 10 + y, "ndrey") - problem.addConstraint(lambda e, n, d, o, r, y: - (e * 100 + n * 10 + d + o * 100 + r * 10 + e) % 1000 == - n * 100 + e * 10 + y, "endory") - problem.addConstraint(lambda s, e, n, d, m, o, r, y: - 1000 * s + 100 * e + 10 * n + d + 1000 * m + 100 * o + 10 * r + e == - 10000 * m + 1000 * o + 100 * n + 10 * e + y, "sendmory") - problem.addConstraint(NotInSetConstraint([0]), "sm") - problem.addConstraint(AllDifferentConstraint()) - solutions = problem.getSolutions() - return solutions - - -def main(): - solutions = solve() - print("SEND+MORE=MONEY") - for s in solutions: - print("%(s)d%(e)d%(n)d%(d)d+" - "%(m)d%(o)d%(r)d%(e)d=" - "%(m)d%(o)d%(n)d%(e)d%(y)d" % s) - - -if __name__ == "__main__": - main() diff --git a/csp/port2/python-constraint-master/examples/wordmath/twotwofour.py b/csp/port2/python-constraint-master/examples/wordmath/twotwofour.py deleted file mode 100755 index 33e4aabb..00000000 --- a/csp/port2/python-constraint-master/examples/wordmath/twotwofour.py +++ /dev/null @@ -1,37 +0,0 @@ -#!/usr/bin/python -# -# Assign equal values to equal letters, and different values to -# different letters, in a way that satisfies the following sum: -# -# TWO -# + TWO -# ----- -# FOUR -# -from constraint import Problem, AllDifferentConstraint, NotInSetConstraint - - -def solve(): - problem = Problem() - problem.addVariables("twofur", range(10)) - problem.addConstraint(lambda o, r: (2 * o) % 10 == r, "or") - problem.addConstraint(lambda w, o, u, - r: ((10 * 2 * w) + (2 * o)) % 100 == u * 10 + r, "wour") - problem.addConstraint(lambda t, w, o, f, u, r: - 2 * (t * 100 + w * 10 + o) == - f * 1000 + o * 100 + u * 10 + r, "twofur") - problem.addConstraint(NotInSetConstraint([0]), "ft") - problem.addConstraint(AllDifferentConstraint()) - solutions = problem.getSolutions() - return solutions - - -def main(): - solutions = solve() - print("TWO+TWO=FOUR") - for s in solutions: - print("%(t)d%(w)d%(o)d+%(t)d%(w)d%(o)d=%(f)d%(o)d%(u)d%(r)d" % s) - - -if __name__ == "__main__": - main() diff --git a/csp/port2/python-constraint-master/examples/xsum/__init__.py b/csp/port2/python-constraint-master/examples/xsum/__init__.py deleted file mode 100755 index e69de29b..00000000 diff --git a/csp/port2/python-constraint-master/examples/xsum/xsum.py b/csp/port2/python-constraint-master/examples/xsum/xsum.py deleted file mode 100755 index 987438f3..00000000 --- a/csp/port2/python-constraint-master/examples/xsum/xsum.py +++ /dev/null @@ -1,48 +0,0 @@ -#!/usr/bin/python -# -# Reorganize the following numbers in a way that each line of -# 5 numbers sum to 27. -# -# 1 6 -# 2 7 -# 3 -# 8 4 -# 9 5 -# -from constraint import Problem, AllDifferentConstraint - - -def solve(): - problem = Problem() - problem.addVariables("abcdxefgh", range(1, 10)) - problem.addConstraint(lambda a, b, c, d, x: - a < b < c < d and a + b + c + d + x == 27, "abcdx") - problem.addConstraint(lambda e, f, g, h, x: - e < f < g < h and e + f + g + h + x == 27, "efghx") - problem.addConstraint(AllDifferentConstraint()) - solutions = problem.getSolutions() - return solutions - - -def main(): - solutions = solve() - print("Found %d solutions!" % len(solutions)) - showSolutions(solutions) - - -def showSolutions(solutions): - for solution in solutions: - print(""" %d %d - %d %d - %d - %d %d - %d %d -""" % (solution["a"], solution["e"], - solution["b"], solution["f"], - solution["x"], - solution["g"], solution["c"], - solution["h"], solution["d"])) - - -if __name__ == "__main__": - main() diff --git a/csp/port2/python-constraint-master/setup.cfg b/csp/port2/python-constraint-master/setup.cfg deleted file mode 100755 index 5bf04527..00000000 --- a/csp/port2/python-constraint-master/setup.cfg +++ /dev/null @@ -1,9 +0,0 @@ -[bdist_wheel] -universal = 1 - -[bdist_rpm] -doc_files = README.rst -use_bzip2 = 1 - -[sdist] -formats = bztar diff --git a/csp/port2/python-constraint-master/setup.py b/csp/port2/python-constraint-master/setup.py deleted file mode 100755 index 4a597e55..00000000 --- a/csp/port2/python-constraint-master/setup.py +++ /dev/null @@ -1,123 +0,0 @@ -#!/usr/bin/env python -# -*- coding: utf-8 -*- - -from setuptools import setup, find_packages # Always prefer setuptools over distutils -from codecs import open # To use a consistent encoding -from os import path -import io - -NAME = 'python-constraint' -filename = "%s/version.py" % 'constraint' -with open(filename) as f: - exec(f.read()) - -here = path.abspath(path.dirname(__file__)) - -def readme(): - filename = path.join(here, 'README.rst') - with io.open(filename, 'rt', encoding='UTF-8') as f: - return f.read() - -setup( - name=NAME, - - # Versions should comply with PEP440. For a discussion on single-sourcing - # the version across setup.py and the project code, see - # https://packaging.python.org/en/latest/development.html#single-sourcing-the-version - #version='0.0.1', - version=__version__, - - description="python-constraint is a module implementing support "\ - "for handling CSPs (Constraint Solving Problems) over finite domain", - - long_description=readme(), - - # The project's main homepage. - url=__url__, - - # Author details - author=__author__, - author_email=__email__, - - # Choose your license - license=__license__, - - # See https://pypi.python.org/pypi?%3Aaction=list_classifiers - classifiers=[ - # How mature is this project? Common values are - # 3 - Alpha - # 4 - Beta - # 5 - Production/Stable - 'Development Status :: 3 - Alpha', - - # Indicate who your project is intended for - 'Environment :: Console', - #'Topic :: Software Development :: Build Tools', - 'Intended Audience :: Science/Research', - 'Operating System :: OS Independent', - - # Specify the Python versions you support here. In particular, ensure - # that you indicate whether you support Python 2, Python 3 or both. - 'Programming Language :: Cython', - - 'Programming Language :: Python', - #'Programming Language :: Python :: 2', - #'Programming Language :: Python :: 2.6', - 'Programming Language :: Python :: 2.7', - #'Programming Language :: Python :: 3', - #'Programming Language :: Python :: 3.2', - 'Programming Language :: Python :: 3.3', - 'Programming Language :: Python :: 3.4', - 'Programming Language :: Python :: 3.5', - 'Programming Language :: Python :: 3.6', - - 'Topic :: Scientific/Engineering', - - # Pick your license as you wish (should match "license" above) - 'License :: OSI Approved :: BSD License', - - ], - - # What does your project relate to? - keywords='csp constraint solving problems problem solver', - - # You can just specify the packages manually here if your project is - # simple. Or you can use find_packages(). - packages=find_packages(exclude=['contrib', 'docs', 'tests*']), - - # List run-time dependencies here. These will be installed by pip when your - # project is installed. For an analysis of "install_requires" vs pip's - # requirements files see: - # https://packaging.python.org/en/latest/technical.html#install-requires-vs-requirements-files - install_requires=[], - - # List additional groups of dependencies here (e.g. development dependencies). - # You can install these using the following syntax, for example: - # $ pip install -e .[dev,test] - extras_require = { - 'dev': ['check-manifest', 'nose'], - 'test': ['coverage', 'nose'], - }, - - # If there are data files included in your packages that need to be - # installed, specify them here. If using Python 2.6 or less, then these - # have to be included in MANIFEST.in as well. - #package_data={ - # 'sample': ['logging.conf'], - #}, - - # Although 'package_data' is the preferred approach, in some case you may - # need to place data files outside of your packages. - # see http://docs.python.org/3.4/distutils/setupscript.html#installing-additional-files - # In this case, 'data_file' will be installed into '/my_data' - #data_files=[('my_data', ['data/data_file'])], - - # To provide executable scripts, use entry points in preference to the - # "scripts" keyword. Entry points provide cross-platform support and allow - # pip to create the appropriate form of executable for the target platform. - #entry_points={ - # 'console_scripts': [ - # 'sample=sample:main', - # ], - #}, -) diff --git a/csp/port2/python-constraint-master/tests/test_constraint.py b/csp/port2/python-constraint-master/tests/test_constraint.py deleted file mode 100755 index e644bf4b..00000000 --- a/csp/port2/python-constraint-master/tests/test_constraint.py +++ /dev/null @@ -1,91 +0,0 @@ -import constraint - -from examples.abc import abc -from examples.coins import coins -# from examples.crosswords import crosswords -from examples.einstein import einstein -from examples.queens import queens -from examples.rooks import rooks -from examples.studentdesks import studentdesks -# from examples.sudoku import sudoku -# from examples.wordmath import (seisseisdoze, sendmoremoney, twotwofour) -# from examples.xsum import xsum - -import constraint.compat as compat - - -def test_abc(): - solutions = abc.solve() - minvalue, minsolution = solutions - assert minvalue == 37 - assert minsolution == {'a': 1, 'c': 2, 'b': 1} - - -def test_coins(): - solutions = coins.solve() - assert len(solutions) == 2 - - -def test_einstein(): - solutions = einstein.solve() - expected_solutions = [ - { - 'nationality2': 'dane', - 'nationality3': 'brit', - 'nationality1': 'norwegian', - 'nationality4': 'german', - 'nationality5': 'swede', - 'color1': 'yellow', - 'color3': 'red', - 'color2': 'blue', - 'color5': 'white', - 'color4': 'green', - 'drink4': 'coffee', - 'drink5': 'beer', - 'drink1': 'water', - 'drink2': 'tea', - 'drink3': 'milk', - 'smoke5': 'bluemaster', - 'smoke4': 'prince', - 'smoke3': 'pallmall', - 'smoke2': 'blends', - 'smoke1': 'dunhill', - 'pet5': 'dogs', - 'pet4': 'fish', - 'pet1': 'cats', - 'pet3': 'birds', - 'pet2': 'horses' - } - ] - assert solutions == expected_solutions - - -def test_queens(): - solutions, size = queens.solve() - assert size == 8 - for solution in solutions: - queens.showSolution(solution, size) - - -def test_rooks(): - size = 8 - solutions = rooks.solve(size) - assert len(solutions) == rooks.factorial(size) - - -def test_studentdesks(): - solutions = studentdesks.solve() - expected_solutions = {1: 'A', 2: 'E', 3: 'D', 4: 'E', 5: 'D', 6: 'A', 7: 'C', 8: 'B', 9: 'C', 10: 'B', 11: 'E', 12: 'D', 13: 'E', 14: 'D', 15: 'A', 16: 'C', 17: 'B', 18: 'C', 19: 'B', 20: 'A'} - assert solutions == expected_solutions - - -def test_constraint_without_variables(): - problem = constraint.Problem() - problem.addVariable("a", [1, 2, 3]) - problem.addConstraint(lambda a: a * 2 == 6) - solutions = problem.getSolutions() - assert solutions == [{'a': 3}] - - -def test_version(): - assert isinstance(constraint.__version__, compat.string_types) diff --git a/csp/port2/python-constraint-master/tests/test_solvers.py b/csp/port2/python-constraint-master/tests/test_solvers.py deleted file mode 100755 index 1a24d382..00000000 --- a/csp/port2/python-constraint-master/tests/test_solvers.py +++ /dev/null @@ -1,17 +0,0 @@ -from constraint import Problem, MinConflictsSolver - - -def test_min_conflicts_solver(): - problem = Problem(MinConflictsSolver()) - problem.addVariable("x", [0, 1]) - problem.addVariable("y", [0, 1]) - solution = problem.getSolution() - - possible_solutions = [ - {'x': 0, 'y': 0}, - {'x': 0, 'y': 1}, - {'x': 1, 'y': 0}, - {'x': 1, 'y': 1} - ] - - assert solution in possible_solutions diff --git a/csp/port2/python-constraint-master/tests/test_some_not_in_set.py b/csp/port2/python-constraint-master/tests/test_some_not_in_set.py deleted file mode 100755 index 31ac4fc4..00000000 --- a/csp/port2/python-constraint-master/tests/test_some_not_in_set.py +++ /dev/null @@ -1,102 +0,0 @@ -from constraint import Domain, Variable, SomeNotInSetConstraint - - -def test_empty_constraint(): - constrainer = SomeNotInSetConstraint(set()) - v1, v2 = variables = [Variable('v1'), Variable('v2')] - assignments = {v1: 'a', v2: 'b'} - - assert constrainer(variables, {}, assignments) - - -def test_no_overlap(): - constrainer = SomeNotInSetConstraint(set('zy')) - v1, v2 = variables = [Variable('v1'), Variable('v2')] - assignments = {v1: 'a', v2: 'b'} - - assert constrainer(variables, {}, assignments) - - -def test_some_overlap(): - constrainer = SomeNotInSetConstraint(set('b')) - v1, v2 = variables = [Variable('v1'), Variable('v2')] - assignments = {v1: 'a', v2: 'b'} - - assert constrainer(variables, {}, assignments) - - -def test_too_much_overlap(): - constrainer = SomeNotInSetConstraint(set('ab')) - v1, v2 = variables = [Variable('v1'), Variable('v2')] - assignments = {v1: 'a', v2: 'b'} - - assert not constrainer(variables, {}, assignments) - - -def test_exact(): - constrainer = SomeNotInSetConstraint(set('abc'), n=2, exact=True) - v1, v2, v3 = variables = [Variable('v1'), Variable('v2'), Variable('v3')] - - assignments = {v1: 'a', v2: 'y', v3: 'z'} - assert constrainer(variables, {}, assignments) - - assignments = {v1: 'a', v2: 'y'} - assert constrainer(variables, {}, assignments) - - assignments = {v1: 'a', v2: 'b', v3: 'z'} - assert not constrainer(variables, {}, assignments) - - assignments = {v1: 'a', v2: 'b'} - assert not constrainer(variables, {}, assignments) - - assignments = {v1: 'a', v2: 'b', v3: 'c'} - assert not constrainer(variables, {}, assignments) - - assignments = {v1: 'x', v2: 'y', v3: 'z'} - assert not constrainer(variables, {}, assignments) - - -def test_forwardcheck(): - constrainer = SomeNotInSetConstraint(set('abc'), n=2) - v1, v2, v3 = variables = [Variable('v1'), Variable('v2'), Variable('v3')] - - domains = {v1: Domain(['a']), v2: Domain(['b', 'y']), - v3: Domain(['c', 'z'])} - assert constrainer(variables, domains, {v1: 'a'}) - assert ['a'] == list(domains[v1]) - assert ['b', 'y'] == list(domains[v2]) - assert ['c', 'z'] == list(domains[v3]) - - assert constrainer(variables, domains, {v1: 'a'}, True) - assert ['a'] == list(domains[v1]) - assert ['y'] == list(domains[v2]) - assert ['z'] == list(domains[v3]) - - -def test_forwardcheck_empty_domain(): - constrainer = SomeNotInSetConstraint(set('abc')) - v1, v2 = variables = [Variable('v1'), Variable('v2')] - - domains = {v1: Domain(['a']), v2: Domain(['b'])} - assert constrainer(variables, domains, {v1: 'a'}) - assert not constrainer(variables, domains, {v1: 'a'}, True) - - -def test_forwardcheck_exact(): - constrainer = SomeNotInSetConstraint(set('abc'), n=2, exact=True) - v1, v2, v3 = variables = [Variable('v1'), Variable('v2'), Variable('v3')] - assignments = {v1: 'a'} - - domains = {v1: Domain(['a', 'x']), v2: Domain(['b', 'y']), - v3: Domain(['c', 'z'])} - assert constrainer(variables, domains, assignments) - assert constrainer(variables, domains, assignments, True) - assert 'b' not in domains[v2] - assert 'y' in domains[v2] - assert 'c' not in domains[v3] - assert 'z' in domains[v3] - - domains = {v1: Domain(['a', 'x']), v2: Domain(['b', 'y']), - v3: Domain(['c'])} - assert constrainer(variables, domains, assignments) - assert not constrainer(variables, domains, assignments, True) From 5b76a51d652163119f94aaa05db08cea16e241d2 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Fri, 19 Oct 2018 23:20:36 -0700 Subject: [PATCH 155/246] do it again --- csp/hacs-test-workbench.rkt | 116 +------------------------------ csp/hacs-test.rkt | 131 +++++++++++++++++++++++++++++++++++- csp/hacs.rkt | 24 ++++--- 3 files changed, 146 insertions(+), 125 deletions(-) diff --git a/csp/hacs-test-workbench.rkt b/csp/hacs-test-workbench.rkt index d592c496..dad7dcf2 100644 --- a/csp/hacs-test-workbench.rkt +++ b/csp/hacs-test-workbench.rkt @@ -2,118 +2,6 @@ (require sugar "hacs.rkt") (current-inference forward-check) -(current-select-variable mrv-degree-hybrid) +(current-select-variable mrv) (current-order-values shuffle) -(current-shuffle #true) - - -#| -# There are no tricks, just pure logic, so good luck and don't give up. -# -# 1. In a street there are five houses, painted five different colours. -# 2. In each house lives a person of different nationality -# 3. These five homeowners each drink a different kind of beverage, smoke -# different brand of cigar and keep a different pet. -# -# THE QUESTION: WHO OWNS THE zebra? -# -# HINTS -# -# 1. The englishman lives in a red house. -# 2. The spaniard keeps dogs as pets. -# 5. The owner of the Green house drinks coffee. -# 3. The ukrainian drinks tea. -# 4. The Green house is on the left of the ivory house. -# 6. The person who smokes oldgold rears snails. -# 7. The owner of the Yellow house smokes kools. -# 8. The man living in the centre house drinks milk. -# 9. The Norwegian lives in the first house. -# 10. The man who smokes chesterfields lives next to the one who keeps foxes. -# 11. The man who keeps horses lives next to the man who smokes kools. -# 12. The man who smokes luckystrike drinks orangejuice. -# 13. The japanese smokes parliaments. -# 14. The Norwegian lives next to the blue house. -# 15. The man who smokes chesterfields has a neighbour who drinks water. -|# - -(define (sym . args) (string->symbol (apply format args))) - -(define zebra (make-csp)) - -(define ns (map (curry sym "nationality-~a") (range 5))) -(define cs (map (curry sym "color-~a") (range 5))) -(define ds (map (curry sym "drink-~a") (range 5))) -(define ss (map (curry sym "smoke-~a") (range 5))) -(define ps (map (curry sym "pet-~a") (range 5))) - -(add-vars! zebra ns '(englishman spaniard ukrainian norwegian japanese)) -(add-vars! zebra cs '(red ivory green yellow blue)) -(add-vars! zebra ds '(tea coffee milk orange-juice water)) -(add-vars! zebra ss '(oldgold kools chesterfields luckystrike parliaments)) -(add-vars! zebra ps '(dogs snails foxes horses zebra)) - -(for ([vars (list ns cs ds ss ps)]) - (add-pairwise-constraint! zebra neq? vars)) - -(define (paired-with lval left rval right) - (add-constraint! zebra (λ (left right) (or (not (eq? left lval)) (eq? rval right))) (list left right))) - -(define (paired-with* lval lefts rval rights) - (for ([left lefts][right rights]) - (paired-with lval left rval right))) - -;# 1. The englishman lives in a red house. -('englishman ns . paired-with* . 'red cs) - -;# 2. The spaniard keeps dogs as pets. -('spaniard ns . paired-with* . 'dogs ps) - -;# 5. The owner of the Green house drinks coffee. -('green cs . paired-with* . 'coffee ds) - -;# 3. The ukrainian drinks tea. -('ukrainian ns . paired-with* . 'tea ds) - -;# 4. The Green house is on the left of the ivory house. -('green (drop-right cs 1) . paired-with* . 'ivory (drop cs 1)) -(add-constraint! zebra (curry neq? 'ivory) (list 'color-0)) -(add-constraint! zebra (curry neq? 'green) (list 'color-4)) - -;# 6. The person who smokes oldgold rears snails. -('oldgold ss . paired-with* . 'snails ps) - -;# 7. The owner of the Yellow house smokes kools. -('yellow cs . paired-with* . 'kools ss) - -;# 8. The man living in the centre house drinks milk. -(add-constraint! zebra (λ (d) (eq? d 'milk)) (list 'drink-2)) - -;# 9. The Norwegian lives in the first house. -(add-constraint! zebra (λ (x) (eq? x 'norwegian)) (list 'nationality-0)) - -(define (next-to lval lefts rval rights) - (lval (drop-right lefts 1) . paired-with* . rval (drop rights 1)) - (lval (drop lefts 1) . paired-with* . rval (drop-right rights 1))) - -;# 10. The man who smokes chesterfields lives next to the one who keeps foxes. -('chesterfields ss . next-to . 'foxes ps) - -;# 11. The man who keeps horses lives next to the man who smokes kools. -;('horses ps . next-to . 'kools ss) - -;# 12. The man who smokes luckystrike drinks orangejuice. -('luckystrike ss . paired-with* . 'orange-juice ds) - -;# 13. The japanese smokes parliaments. -('japanese ns . paired-with* . 'parliaments ss) - -;# 14. The Norwegian lives next to the blue house. -;('norwegian ns . next-to . 'water ds) - -;# 15. The man who smokes chesterfields has a neighbour who drinks water. -;('chesterfields ss . next-to . 'water ds) - -(define (finish x) - (apply map list (slice-at x 5))) - -(map finish (list (time (solve zebra)))) \ No newline at end of file +(current-shuffle #true) \ No newline at end of file diff --git a/csp/hacs-test.rkt b/csp/hacs-test.rkt index 02c07af4..b13507b9 100644 --- a/csp/hacs-test.rkt +++ b/csp/hacs-test.rkt @@ -1,5 +1,5 @@ #lang debug racket -(require "hacs.rkt" rackunit) +(require "hacs.rkt" rackunit sugar/list) (current-inference forward-check) (current-select-variable mrv-degree-hybrid) @@ -155,4 +155,131 @@ (not (= qa-row qb-row)))) ; same row? (list qa qb))) -(check-equal? 92 (length (time (solve* queens)))) \ No newline at end of file +(check-equal? 92 (length (time (solve* queens)))) + + +#| +# There are no tricks, just pure logic, so good luck and don't give up. +# +# 1. In a street there are five houses, painted five different colours. +# 2. In each house lives a person of different nationality +# 3. These five homeowners each drink a different kind of beverage, smoke +# different brand of cigar and keep a different pet. +# +# THE QUESTION: WHO OWNS THE zebra? +# +# HINTS +# +# 1. The englishman lives in a red house. +# 2. The spaniard keeps dogs as pets. +# 5. The owner of the Green house drinks coffee. +# 3. The ukrainian drinks tea. +# 4. The Green house is on the left of the ivory house. +# 6. The person who smokes oldgold rears snails. +# 7. The owner of the Yellow house smokes kools. +# 8. The man living in the centre house drinks milk. +# 9. The Norwegian lives in the first house. +# 10. The man who smokes chesterfields lives next to the one who keeps foxes. +# 11. The man who keeps horses lives next to the man who smokes kools. +# 12. The man who smokes luckystrike drinks orangejuice. +# 13. The japanese smokes parliaments. +# 14. The Norwegian lives next to the blue house. +# 15. The man who smokes chesterfields has a neighbour who drinks water. +|# + +(define (sym . args) (string->symbol (apply format args))) + +(define zebra (make-csp)) + +(define ns (map (curry sym "nationality-~a") (range 5))) +(define cs (map (curry sym "color-~a") (range 5))) +(define ds (map (curry sym "drink-~a") (range 5))) +(define ss (map (curry sym "smoke-~a") (range 5))) +(define ps (map (curry sym "pet-~a") (range 5))) + +(add-vars! zebra ns '(englishman spaniard ukrainian norwegian japanese)) +(add-vars! zebra cs '(red ivory green yellow blue)) +(add-vars! zebra ds '(tea coffee milk orange-juice water)) +(add-vars! zebra ss '(oldgold kools chesterfields luckystrike parliaments)) +(add-vars! zebra ps '(dogs snails foxes horses zebra)) + +(for ([vars (list ns cs ds ss ps)]) + (add-pairwise-constraint! zebra neq? vars)) + +(define (paired-with lval left rval right) + (add-constraint! zebra (λ (left right) (or (not (eq? left lval)) (eq? rval right))) (list left right))) + +(define (paired-with* lval lefts rval rights) + (for ([left lefts][right rights]) + (paired-with lval left rval right))) + +;# 1. The englishman lives in a red house. +('englishman ns . paired-with* . 'red cs) + +;# 2. The spaniard keeps dogs as pets. +('spaniard ns . paired-with* . 'dogs ps) + +;# 5. The owner of the Green house drinks coffee. +('green cs . paired-with* . 'coffee ds) + +;# 3. The ukrainian drinks tea. +('ukrainian ns . paired-with* . 'tea ds) + +;# 4. The Green house is on the left of the ivory house. +('green (drop-right cs 1) . paired-with* . 'ivory (drop cs 1)) +(add-constraint! zebra (curry neq? 'ivory) (list 'color-0)) +(add-constraint! zebra (curry neq? 'green) (list 'color-4)) + +;# 6. The person who smokes oldgold rears snails. +('oldgold ss . paired-with* . 'snails ps) + +;# 7. The owner of the Yellow house smokes kools. +('yellow cs . paired-with* . 'kools ss) + +;# 8. The man living in the centre house drinks milk. +(add-constraint! zebra (λ (d) (eq? d 'milk)) (list 'drink-2)) + +;# 9. The Norwegian lives in the first house. +(add-constraint! zebra (λ (x) (eq? x 'norwegian)) (list 'nationality-0)) + +(define (next-to lval lefts rval rights) + (for ([righta (drop-right rights 2)] + [left (cdr lefts)] + [rightb (drop rights 2)]) + (add-constraint! zebra (λ (left righta rightb) + (or (not (eq? left lval)) (eq? righta rval) (eq? rval rightb))) + (list left righta rightb))) + (for ([left (list (first lefts) (last lefts))] + [right (list (second rights) (fourth rights))]) + (add-constraint! zebra (λ (left right) (or (not (eq? left lval)) (eq? rval right))) + (list left right)))) + +;# 10. The man who smokes chesterfields lives next to the one who keeps foxes. +('chesterfields ss . next-to . 'foxes ps) + +;# 11. The man who keeps horses lives next to the man who smokes kools. +('horses ps . next-to . 'kools ss) + +;# 12. The man who smokes luckystrike drinks orangejuice. +('luckystrike ss . paired-with* . 'orange-juice ds) + +;# 13. The japanese smokes parliaments. +('japanese ns . paired-with* . 'parliaments ss) + +;# 14. The Norwegian lives next to the blue house. +('norwegian ns . next-to . 'blue cs) + +;# 15. The man who smokes chesterfields has a neighbour who drinks water. +('chesterfields ss . next-to . 'water ds) + +(define (finish x) + (apply map list (slice-at x 5))) + +(equal? (parameterize ([current-select-variable mrv] + [current-shuffle #f]) + (finish (time (solve zebra)))) + '(((nationality-0 . norwegian) (color-0 . yellow) (drink-0 . water) (smoke-0 . kools) (pet-0 . foxes)) + ((nationality-1 . ukrainian) (color-1 . blue) (drink-1 . tea) (smoke-1 . chesterfields) (pet-1 . horses)) + ((nationality-2 . englishman) (color-2 . red) (drink-2 . milk) (smoke-2 . oldgold) (pet-2 . snails)) + ((nationality-3 . japanese) (color-3 . green) (drink-3 . coffee) (smoke-3 . parliaments) (pet-3 . zebra)) + ((nationality-4 . spaniard) (color-4 . ivory) (drink-4 . orange-juice) (smoke-4 . luckystrike) (pet-4 . dogs)))) diff --git a/csp/hacs.rkt b/csp/hacs.rkt index db0fa941..908fc7b5 100644 --- a/csp/hacs.rkt +++ b/csp/hacs.rkt @@ -111,18 +111,19 @@ [(? number? val) (= val (length pattern))]) (raise-argument-error 'reduce-arity (format "list of length ~a, same as procedure arity" (procedure-arity proc)) pattern)) (define reduced-arity-name (string->symbol (format "reduced-arity-~a" (object-name proc)))) - (define-values (id-names vals) (partition symbol? pattern)) + (define-values (boxed-id-names vals) (partition box? pattern)) + (define id-names (map unbox boxed-id-names)) (define new-arity (length id-names)) (procedure-rename (λ xs - (unless (= (length xs) new-arity) + (unless (= (length xs) new-arity) (apply raise-arity-error reduced-arity-name new-arity xs)) (apply proc (for/fold ([acc empty] [xs xs] [vals vals] #:result (reverse acc)) ([pat-item (in-list pattern)]) - (if (symbol? pat-item) + (if (box? pat-item) (values (cons (car xs) acc) (cdr xs) vals) (values (cons (car vals) acc) xs (cdr vals)))))) reduced-arity-name)) @@ -139,11 +140,12 @@ (partially-assigned? constraint)) (match-define ($constraint cnames proc) constraint) ($constraint (filter-not assigned-name? cnames) - ;; pattern is mix of values and symbols (indicating variables to persist) + ;; pattern is mix of values and boxed symbols (indicating variables to persist) + ;; use boxes here as cheap way to distinguish id symbols from value symbols (let ([reduce-arity-pattern (for/list ([cname (in-list cnames)]) (if (assigned-name? cname) (first ($csp-vals csp cname)) - cname))]) + (box cname)))]) (reduce-arity proc reduce-arity-pattern)))] [else constraint]))))) @@ -171,9 +173,11 @@ (define/contract (argmin-random-tie proc xs) (procedure? (non-empty-listof any/c) . -> . any/c) - (define ordered-xs (sort xs < #:key proc)) - (first ((if (current-shuffle) shuffle values) - (takef ordered-xs (λ (x) (= (proc (car ordered-xs)) (proc x))))))) + (let* ([xs (sort xs < #:key proc)] + [xs (takef xs (λ (x) (= (proc (car xs)) (proc x))))] + ;; don't shuffle short lists, not worth it + [xs ((if (current-shuffle) shuffle values) xs)]) + (first xs))) (define/contract (minimum-remaining-values csp) ($csp? . -> . (or/c #false (and/c $var? (not/c $avar?)))) @@ -310,7 +314,7 @@ (define/contract (make-nodes-consistent csp) ($csp? . -> . $csp?) - ;; todo: why does this function make searches so much slower? + ;; todo: why does this function slow down searches? ($csp (for/list ([var (in-list ($csp-vars csp))]) (match-define ($var name vals) var) @@ -353,6 +357,8 @@ (loop csp))) conflicts)])))) +;; todo: min-conflicts solver + (define/contract ($csp-assocs csp) ($csp? . -> . (listof (cons/c $var-name? any/c))) (for/list ([var (in-list ($csp-vars csp))]) From 2d982a5e2e20d2059500af6096c2f7c261a421b9 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Fri, 19 Oct 2018 23:30:42 -0700 Subject: [PATCH 156/246] nits --- csp/aima-smm.rkt | 23 +++++++++++------------ csp/hacs-test.rkt | 2 +- 2 files changed, 12 insertions(+), 13 deletions(-) diff --git a/csp/aima-smm.rkt b/csp/aima-smm.rkt index f0f6cf0e..cdaba300 100644 --- a/csp/aima-smm.rkt +++ b/csp/aima-smm.rkt @@ -21,26 +21,25 @@ (for/list ([pr (in-combinations vs 2)]) ($constraint pr not=))) -(define (smm-func s e n d m o r y) - (= (+ (word-value s e n d) (word-value m o r e)) (word-value m o n e y))) - -(define csp (make-csp vds (append - +(define smm (make-csp vds (append alldiffs (list - ($constraint vs smm-func) ($constraint '(s) positive?) - ($constraint '(m) (λ (x) (= 1 x))) + ($constraint '(m) positive?) ($constraint '(d e y) (λ (d e y) (= (modulo (+ d e) 10) y))) ($constraint '(n d r e y) (λ (n d r e y) (= (modulo (+ (word-value n d) (word-value r e)) 100) (word-value e y)))) ($constraint '(e n d o r y) (λ (e n d o r y) - (= (modulo (+ (word-value e n d) (word-value o r e)) 1000) (word-value n e y)))))))) + (= (modulo (+ (word-value e n d) (word-value o r e)) 1000) (word-value n e y)))) + ($constraint '(s e n d m o r y) (λ (s e n d m o r y) + (= (+ (word-value s e n d) (word-value m o r e)) + (word-value m o n e y)))))))) + (parameterize ([current-select-variable mrv] [current-order-values lcv] [current-inference mac]) - (time (solve csp))) -(nassigns csp) -(nchecks csp) -(reset! csp) \ No newline at end of file + (time (solve smm))) +(nassigns smm) +(nchecks smm) +(reset! smm) \ No newline at end of file diff --git a/csp/hacs-test.rkt b/csp/hacs-test.rkt index b13507b9..db7e4218 100644 --- a/csp/hacs-test.rkt +++ b/csp/hacs-test.rkt @@ -275,7 +275,7 @@ (define (finish x) (apply map list (slice-at x 5))) -(equal? (parameterize ([current-select-variable mrv] +(check-equal? (parameterize ([current-select-variable mrv] [current-shuffle #f]) (finish (time (solve zebra)))) '(((nationality-0 . norwegian) (color-0 . yellow) (drink-0 . water) (smoke-0 . kools) (pet-0 . foxes)) From 8c8c51fe84fb226d3765ab7effa979778e59f0b5 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Sat, 20 Oct 2018 06:54:47 -0700 Subject: [PATCH 157/246] fast --- csp/hacs-test.rkt | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/csp/hacs-test.rkt b/csp/hacs-test.rkt index db7e4218..99d8bfee 100644 --- a/csp/hacs-test.rkt +++ b/csp/hacs-test.rkt @@ -135,7 +135,8 @@ (= (+ (word-value s e n d) (word-value m o r e)) (word-value m o n e y))) '(s e n d m o r y)) (add-pairwise-constraint! smm alldiff= '(s e n d m o r y)) -(check-equal? (time (solve smm)) '((s . 9) (e . 5) (n . 6) (d . 7) (m . 1) (o . 0) (r . 8) (y . 2))) +(check-equal? (parameterize ([current-select-variable mrv-degree-hybrid]) ; todo: why is plain mrv so bad on this problem? + (time (solve smm))) '((s . 9) (e . 5) (n . 6) (d . 7) (m . 1) (o . 0) (r . 8) (y . 2))) ;; queens problem From 667ccecda22d800432d79b50812818807b2ff340 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Sat, 20 Oct 2018 10:06:33 -0700 Subject: [PATCH 158/246] slower --- csp/hacs.rkt | 197 ++++++++++++++++++++++++++++----------------------- 1 file changed, 107 insertions(+), 90 deletions(-) diff --git a/csp/hacs.rkt b/csp/hacs.rkt index 908fc7b5..de2fa88a 100644 --- a/csp/hacs.rkt +++ b/csp/hacs.rkt @@ -12,6 +12,12 @@ (struct $csp ([vars #:mutable] [constraints #:mutable]) #:transparent) +(define csp? $csp?) +(define vars $csp-vars) +(define constraints $csp-constraints) +(define-syntax-rule (in-constraints csp) (in-list ($csp-constraints csp))) +(define-syntax-rule (in-vars csp) (in-list ($csp-vars csp))) + (struct $constraint (names proc) #:transparent #:property prop:procedure (λ (constraint csp) @@ -21,24 +27,29 @@ (for/and ([args (in-cartesian (map (λ (cname) ($csp-vals csp cname)) ($constraint-names constraint)))]) (apply ($constraint-proc constraint) args)))) +(define (make-constraint [names null] [proc values]) + ($constraint names proc)) + (struct $var (name domain) #:transparent) -(define $var-name? symbol?) +(define name? symbol?) (define $var-vals $var-domain) +(define var-name $var-name) (struct $cvar $var (past) #:transparent) (struct $avar $var () #:transparent) +(define assigned-var? $avar?) -(define (make-csp [vds null] [constraints null]) - ($csp vds constraints)) +(define (make-csp [vars null] [constraints null]) + ($csp vars constraints)) (define/contract (add-vars! csp names-or-procedure [vals-or-procedure empty]) - (($csp? (or/c (listof $var-name?) procedure?)) ((or/c (listof any/c) procedure?)) . ->* . void?) + ((csp? (or/c (listof name?) procedure?)) ((or/c (listof any/c) procedure?)) . ->* . void?) (for/fold ([vars ($csp-vars csp)] #:result (set-$csp-vars! csp vars)) ([name (in-list (if (procedure? names-or-procedure) (names-or-procedure) names-or-procedure))]) - (when (memq name (map $var-name vars)) + (when (memq name (map var-name vars)) (raise-argument-error 'add-vars! "var that doesn't already exist" name)) (append vars (list ($var name (if (procedure? vals-or-procedure) @@ -46,25 +57,25 @@ vals-or-procedure)))))) (define/contract (add-var! csp name [vals-or-procedure empty]) - (($csp? $var-name?) ((or/c (listof any/c) procedure?)) . ->* . void?) + ((csp? name?) ((or/c (listof any/c) procedure?)) . ->* . void?) (add-vars! csp (list name) vals-or-procedure)) (define/contract (add-constraints! csp proc namess [proc-name #false]) - (($csp? procedure? (listof (listof $var-name?))) ((or/c #false $var-name?)) . ->* . void?) - (set-$csp-constraints! csp (append ($csp-constraints csp) + ((csp? procedure? (listof (listof name?))) ((or/c #false name?)) . ->* . void?) + (set-$csp-constraints! csp (append (constraints csp) (for/list ([names (in-list namess)]) (for ([name (in-list names)]) (check-name-in-csp! 'add-constraints! csp name)) - ($constraint names (if proc-name - (procedure-rename proc proc-name) - proc)))))) + (make-constraint names (if proc-name + (procedure-rename proc proc-name) + proc)))))) (define/contract (add-pairwise-constraint! csp proc var-names [proc-name #false]) - (($csp? procedure? (listof $var-name?)) ($var-name?) . ->* . void?) + ((csp? procedure? (listof name?)) (name?) . ->* . void?) (add-constraints! csp proc (combinations var-names 2) proc-name)) (define/contract (add-constraint! csp proc var-names [proc-name #false]) - (($csp? procedure? (listof $var-name?)) ($var-name?) . ->* . void?) + ((csp? procedure? (listof name?)) (name?) . ->* . void?) (add-constraints! csp proc (list var-names) proc-name)) (define/contract (alldiff= x y) @@ -74,6 +85,7 @@ (struct inconsistency-signal (csp) #:transparent) (struct $backtrack (names) #:transparent) +(define (backtrack! [names null]) (raise ($backtrack names))) (define current-select-variable (make-parameter #f)) (define current-order-values (make-parameter #f)) @@ -82,28 +94,30 @@ (define current-shuffle (make-parameter #t)) (define/contract (check-name-in-csp! caller csp name) - (symbol? $csp? $var-name? . -> . void?) - (define names (map $var-name ($csp-vars csp))) + (symbol? csp? name? . -> . void?) + (define names (map var-name (vars csp))) (unless (memq name names) (raise-argument-error caller (format "one of these existing csp var names: ~v" names) name))) -(define/contract ($csp-var csp name) - ($csp? $var-name? . -> . $var?) - (check-name-in-csp! '$csp-var csp name) - (for/first ([var (in-list ($csp-vars csp))] - #:when (eq? name ($var-name var))) +(define/contract (csp-var csp name) + (csp? name? . -> . $var?) + (check-name-in-csp! 'csp-var csp name) + (for/first ([var (in-vars csp)] + #:when (eq? name (var-name var))) var)) (define/contract ($csp-vals csp name) - ($csp? $var-name? . -> . (listof any/c)) - (check-name-in-csp! '$csp-vals csp name) - ($var-domain ($csp-var csp name))) + (csp? name? . -> . (listof any/c)) + (check-name-in-csp! 'csp-vals csp name) + ($var-domain (csp-var csp name))) (define order-domain-values values) (define/contract (assigned-name? csp name) - ($csp? $var-name? . -> . boolean?) - (and (memq name (map $var-name (filter $avar? ($csp-vars csp)))) #true)) + (csp? name? . -> . any/c) + (for/first ([var (in-vars csp)] + #:when (assigned-var? var)) + (eq? name (var-name var)))) (define (reduce-arity proc pattern) (unless (match (procedure-arity proc) @@ -112,11 +126,10 @@ (raise-argument-error 'reduce-arity (format "list of length ~a, same as procedure arity" (procedure-arity proc)) pattern)) (define reduced-arity-name (string->symbol (format "reduced-arity-~a" (object-name proc)))) (define-values (boxed-id-names vals) (partition box? pattern)) - (define id-names (map unbox boxed-id-names)) - (define new-arity (length id-names)) + (define new-arity (length boxed-id-names)) (procedure-rename (λ xs - (unless (= (length xs) new-arity) + (unless (= (length xs) new-arity) (apply raise-arity-error reduced-arity-name new-arity xs)) (apply proc (for/fold ([acc empty] [xs xs] @@ -129,47 +142,44 @@ reduced-arity-name)) (define/contract (reduce-constraint-arity csp [minimum-arity 3]) - (($csp?) ((or/c #false exact-nonnegative-integer?)) . ->* . $csp?) + ((csp?) ((or/c #false exact-nonnegative-integer?)) . ->* . csp?) (let ([assigned-name? (curry assigned-name? csp)]) (define (partially-assigned? constraint) (ormap assigned-name? ($constraint-names constraint))) - ($csp ($csp-vars csp) - (for/list ([constraint (in-list ($csp-constraints csp))]) - (cond - [(and (if minimum-arity (<= minimum-arity (constraint-arity constraint)) #true) - (partially-assigned? constraint)) - (match-define ($constraint cnames proc) constraint) - ($constraint (filter-not assigned-name? cnames) - ;; pattern is mix of values and boxed symbols (indicating variables to persist) - ;; use boxes here as cheap way to distinguish id symbols from value symbols - (let ([reduce-arity-pattern (for/list ([cname (in-list cnames)]) - (if (assigned-name? cname) - (first ($csp-vals csp cname)) - (box cname)))]) - (reduce-arity proc reduce-arity-pattern)))] - [else constraint]))))) + (make-csp (vars csp) + (for/list ([constraint (in-constraints csp)]) + (cond + [(and (if minimum-arity (<= minimum-arity (constraint-arity constraint)) #true) + (partially-assigned? constraint)) + (match-define ($constraint cnames proc) constraint) + ($constraint (filter-not assigned-name? cnames) + ;; pattern is mix of values and boxed symbols (indicating variables to persist) + ;; use boxes here as cheap way to distinguish id symbols from value symbols + (let ([reduce-arity-pattern (for/list ([cname (in-list cnames)]) + (if (assigned-name? cname) + (first ($csp-vals csp cname)) + (box cname)))]) + (reduce-arity proc reduce-arity-pattern)))] + [else constraint]))))) (define/contract (assign-val csp name val) - ($csp? $var-name? any/c . -> . $csp?) - (define assigned-csp ($csp - (for/list ([var ($csp-vars csp)]) - (if (eq? name ($var-name var)) - ($avar name (list val)) - var)) - ($csp-constraints csp))) - assigned-csp) + (csp? name? any/c . -> . csp?) + (make-csp + (for/list ([var (vars csp)]) + (if (eq? name (var-name var)) + ($avar name (list val)) + var)) + (constraints csp))) (define/contract (unassigned-vars csp) - ($csp? . -> . (listof (and/c $var? (not/c $avar?)))) - (for/list ([var (in-list ($csp-vars csp))] - #:unless ($avar? var)) - var)) + (csp? . -> . (listof (and/c $var? (not/c assigned-var?)))) + (filter-not assigned-var? (vars csp))) (define/contract (first-unassigned-variable csp) - ($csp? . -> . (or/c #false (and/c $var? (not/c $avar?)))) + (csp? . -> . (or/c #false (and/c $var? (not/c assigned-var?)))) (match (unassigned-vars csp) [(? empty?) #false] - [xs (first xs)])) + [(cons x _) x])) (define/contract (argmin-random-tie proc xs) (procedure? (non-empty-listof any/c) . -> . any/c) @@ -180,21 +190,22 @@ (first xs))) (define/contract (minimum-remaining-values csp) - ($csp? . -> . (or/c #false (and/c $var? (not/c $avar?)))) + (csp? . -> . (or/c #false (and/c $var? (not/c assigned-var?)))) (match (unassigned-vars csp) [(? empty?) #false] [xs (argmin-random-tie (λ (var) (length ($var-domain var))) xs)])) (define mrv minimum-remaining-values) + (define/contract (var-degree csp var) - ($csp? $var? . -> . exact-nonnegative-integer?) - (for/sum ([constraint (in-list ($csp-constraints csp))] - #:when (memq ($var-name var) ($constraint-names constraint))) + (csp? $var? . -> . exact-nonnegative-integer?) + (for/sum ([constraint (in-constraints csp)] + #:when (memq (var-name var) ($constraint-names constraint))) 1)) (define/contract (blended-variable-selector csp) - ($csp? . -> . (or/c #false (and/c $var? (not/c $avar?)))) + (csp? . -> . (or/c #false (and/c $var? (not/c assigned-var?)))) (define uvars (unassigned-vars csp)) (cond [(empty? uvars) #false] @@ -208,7 +219,7 @@ (length ($var-vals var))) (define/contract (mrv-degree-hybrid csp) - ($csp? . -> . (or/c #f $var?)) + (csp? . -> . (or/c #f $var?)) (define uvars (unassigned-vars csp)) (cond [(empty? uvars) #false] @@ -228,7 +239,7 @@ (define (no-inference csp name) csp) (define/contract (relating-only constraints names) - ((listof $constraint?) (listof $var-name?) . -> . (listof $constraint?)) + ((listof $constraint?) (listof name?) . -> . (listof $constraint?)) (for*/list ([constraint (in-list constraints)] [cnames (in-value ($constraint-names constraint))] #:when (and (= (length names) (length cnames)) @@ -236,16 +247,22 @@ (memq name cnames)))) constraint)) +(define (binary-constraint? constraint) + (= 2 (constraint-arity constraint))) + +(define (constraint-relates? constraint name) + (and (memq name ($constraint-names constraint)) #true)) + (define/contract (forward-check csp aname) - ($csp? $var-name? . -> . $csp?) + (csp? name? . -> . csp?) (define aval (first ($csp-vals csp aname))) (define (check-var var) (match var ;; don't check against assigned vars, or the reference var ;; (which is probably assigned but maybe not) - [(? (λ (x) (or ($avar? x) (eq? ($var-name x) aname)))) var] + [(? (λ (x) (or (assigned-var? x) (eq? (var-name x) aname)))) var] [($var name vals) - (match (($csp-constraints csp) . relating-only . (list aname name)) + (match ((constraints csp) . relating-only . (list aname name)) [(? empty?) var] [constraints (define new-vals @@ -259,7 +276,7 @@ ($cvar name new-vals (cons aname (if ($cvar? var) ($cvar-past var) null)))])])) - (define checked-vars (map check-var ($csp-vars csp))) + (define checked-vars (map check-var (vars csp))) ;; conflict-set will be empty if there are no empty domains (define conflict-set (for*/list ([var (in-list checked-vars)] #:when (empty? ($var-domain var)) @@ -271,21 +288,21 @@ ;; If we just bail out at the first conflict, we may backjump too far based on its history ;; (and thereby miss parts of the search tree) (when (pair? conflict-set) - (raise ($backtrack conflict-set))) + (backtrack! conflict-set)) ;; Discard constraints that have produced singleton domains ;; (they have no further use) (define nonsingleton-constraints - (for/list ([constraint (in-list ($csp-constraints csp))] + (for/list ([constraint (in-constraints csp)] #:unless (and - (= 2 (constraint-arity constraint)) ; binary constraint - (memq aname ($constraint-names constraint)) ; includes target name + (binary-constraint? constraint) + (constraint-relates? constraint aname) (let ([other-name (first (remq aname ($constraint-names constraint)))]) ; and something else (= (length ($csp-vals csp other-name)) 1)))) ; that has only one value constraint)) - ($csp checked-vars nonsingleton-constraints)) + (make-csp checked-vars nonsingleton-constraints)) (define/contract (constraint-checkable? c names) - ($constraint? (listof $var-name?) . -> . boolean?) + ($constraint? (listof name?) . -> . boolean?) (and (for/and ([cname (in-list ($constraint-names c))]) (memq cname names)) #true)) @@ -298,27 +315,27 @@ (= 1 (length ($var-domain var)))) (define/contract (check-constraints csp) - ($csp? . -> . $csp?) + (csp? . -> . csp?) ;; this time, we're not limited to assigned variables ;; (that is, vars that have been deliberately assigned in the backtrack process thus far) ;; we also want to use "singleton" vars (that is, vars that have been reduced to a single domain value by forward checking) - (define singleton-varnames (for/list ([var (in-list ($csp-vars csp))] + (define singleton-varnames (for/list ([var (in-vars csp)] #:when (singleton-var? var)) - ($var-name var))) + (var-name var))) (define-values (checkable-constraints other-constraints) - (partition (λ (c) (constraint-checkable? c singleton-varnames)) ($csp-constraints csp))) + (partition (λ (c) (constraint-checkable? c singleton-varnames)) (constraints csp))) (for ([constraint (in-list (sort checkable-constraints < #:key constraint-arity))] #:unless (constraint csp)) - (raise ($backtrack null))) - ($csp ($csp-vars csp) other-constraints)) + (backtrack!)) + (make-csp (vars csp) other-constraints)) (define/contract (make-nodes-consistent csp) - ($csp? . -> . $csp?) + (csp? . -> . csp?) ;; todo: why does this function slow down searches? ($csp - (for/list ([var (in-list ($csp-vars csp))]) + (for/list ([var (in-vars csp)]) (match-define ($var name vals) var) - (define procs (for*/list ([constraint (in-list ($csp-constraints csp))] + (define procs (for*/list ([constraint (in-constraints csp)] [cnames (in-value ($constraint-names constraint))] #:when (and (= 1 (length cnames)) (eq? name (car cnames)))) ($constraint-proc constraint))) @@ -326,7 +343,7 @@ (for*/fold ([vals vals]) ([proc (in-list procs)]) (filter proc vals)))) - ($csp-constraints csp))) + (constraints csp))) (define/contract (backtracking-solver csp @@ -334,7 +351,7 @@ (or (current-select-variable) first-unassigned-variable)] #:order-values [order-domain-values (or (current-order-values) first-domain-value)] #:inference [inference (or (current-inference) no-inference)]) - (($csp?) (#:select-variable procedure? #:order-values procedure? #:inference procedure?) . ->* . generator?) + ((csp?) (#:select-variable procedure? #:order-values procedure? #:inference procedure?) . ->* . generator?) (generator () (let loop ([csp csp]) (match (select-unassigned-variable csp) @@ -360,8 +377,8 @@ ;; todo: min-conflicts solver (define/contract ($csp-assocs csp) - ($csp? . -> . (listof (cons/c $var-name? any/c))) - (for/list ([var (in-list ($csp-vars csp))]) + (csp? . -> . (listof (cons/c name? any/c))) + (for/list ([var (in-vars csp)]) (match var [($var name domain) (cons name (first domain))]))) @@ -369,7 +386,7 @@ #:finish-proc [finish-proc $csp-assocs] #:solver [solver (or (current-solver) backtracking-solver)] #:count [max-solutions +inf.0]) - (($csp?) (#:finish-proc procedure? #:solver procedure? #:count integer?) . ->* . (listof any/c)) + ((csp?) (#:finish-proc procedure? #:solver procedure? #:count integer?) . ->* . (listof any/c)) (for/list ([solution (in-producer (solver csp) (void))] [idx (in-range max-solutions)]) (finish-proc solution))) @@ -377,7 +394,7 @@ (define/contract (solve csp #:finish-proc [finish-proc $csp-assocs] #:solver [solver (or (current-solver) backtracking-solver)]) - (($csp?) (#:finish-proc procedure? #:solver procedure?) . ->* . (or/c #false any/c)) + ((csp?) (#:finish-proc procedure? #:solver procedure?) . ->* . (or/c #false any/c)) (match (solve* csp #:finish-proc finish-proc #:solver solver #:count 1) [(list solution) solution] [else #false])) From fe84a77de5fce221c346b22648f7f08632c22bc3 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Sat, 20 Oct 2018 10:47:26 -0700 Subject: [PATCH 159/246] maybe --- csp/hacs.rkt | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/csp/hacs.rkt b/csp/hacs.rkt index de2fa88a..9766691c 100644 --- a/csp/hacs.rkt +++ b/csp/hacs.rkt @@ -115,7 +115,7 @@ (define/contract (assigned-name? csp name) (csp? name? . -> . any/c) - (for/first ([var (in-vars csp)] + (for/or ([var (in-vars csp)] #:when (assigned-var? var)) (eq? name (var-name var)))) From 60b81a602af165065ecc6b0f9ad9b8f836002e85 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Sat, 20 Oct 2018 10:54:28 -0700 Subject: [PATCH 160/246] misc --- csp/hacs.rkt | 2 -- 1 file changed, 2 deletions(-) diff --git a/csp/hacs.rkt b/csp/hacs.rkt index 9766691c..2c809fb9 100644 --- a/csp/hacs.rkt +++ b/csp/hacs.rkt @@ -185,7 +185,6 @@ (procedure? (non-empty-listof any/c) . -> . any/c) (let* ([xs (sort xs < #:key proc)] [xs (takef xs (λ (x) (= (proc (car xs)) (proc x))))] - ;; don't shuffle short lists, not worth it [xs ((if (current-shuffle) shuffle values) xs)]) (first xs))) @@ -197,7 +196,6 @@ (define mrv minimum-remaining-values) - (define/contract (var-degree csp var) (csp? $var? . -> . exact-nonnegative-integer?) (for/sum ([constraint (in-constraints csp)] From a33946cc48e73884b3228742fa13988c94f788c5 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Sat, 20 Oct 2018 11:32:16 -0700 Subject: [PATCH 161/246] ok --- csp/hacs-test.rkt | 19 +++++++++++-------- csp/hacs.rkt | 46 ++++++++++++++++++++++++++++++---------------- 2 files changed, 41 insertions(+), 24 deletions(-) diff --git a/csp/hacs-test.rkt b/csp/hacs-test.rkt index 99d8bfee..49b2541d 100644 --- a/csp/hacs-test.rkt +++ b/csp/hacs-test.rkt @@ -79,7 +79,7 @@ (add-constraint! quarters (λ (d q) (= 26 (+ d q))) '(dollars quarters)) (add-constraint! quarters (λ (d q) (= 17 (+ d (* 0.25 q)))) '(dollars quarters)) (check-equal? (time (solve quarters)) - '((dollars . 14) (quarters . 12))) + '((dollars . 14) (quarters . 12))) ;; xsum @@ -158,6 +158,9 @@ (check-equal? 92 (length (time (solve* queens)))) +#;(parameterize ([current-solver min-conflicts]) + (solve queens)) + #| # There are no tricks, just pure logic, so good luck and don't give up. @@ -277,10 +280,10 @@ (apply map list (slice-at x 5))) (check-equal? (parameterize ([current-select-variable mrv] - [current-shuffle #f]) - (finish (time (solve zebra)))) - '(((nationality-0 . norwegian) (color-0 . yellow) (drink-0 . water) (smoke-0 . kools) (pet-0 . foxes)) - ((nationality-1 . ukrainian) (color-1 . blue) (drink-1 . tea) (smoke-1 . chesterfields) (pet-1 . horses)) - ((nationality-2 . englishman) (color-2 . red) (drink-2 . milk) (smoke-2 . oldgold) (pet-2 . snails)) - ((nationality-3 . japanese) (color-3 . green) (drink-3 . coffee) (smoke-3 . parliaments) (pet-3 . zebra)) - ((nationality-4 . spaniard) (color-4 . ivory) (drink-4 . orange-juice) (smoke-4 . luckystrike) (pet-4 . dogs)))) + [current-shuffle #f]) + (finish (time (solve zebra)))) + '(((nationality-0 . norwegian) (color-0 . yellow) (drink-0 . water) (smoke-0 . kools) (pet-0 . foxes)) + ((nationality-1 . ukrainian) (color-1 . blue) (drink-1 . tea) (smoke-1 . chesterfields) (pet-1 . horses)) + ((nationality-2 . englishman) (color-2 . red) (drink-2 . milk) (smoke-2 . oldgold) (pet-2 . snails)) + ((nationality-3 . japanese) (color-3 . green) (drink-3 . coffee) (smoke-3 . parliaments) (pet-3 . zebra)) + ((nationality-4 . spaniard) (color-4 . ivory) (drink-4 . orange-juice) (smoke-4 . luckystrike) (pet-4 . dogs)))) diff --git a/csp/hacs.rkt b/csp/hacs.rkt index 2c809fb9..0eafa96b 100644 --- a/csp/hacs.rkt +++ b/csp/hacs.rkt @@ -1,5 +1,5 @@ #lang debug racket -(require racket/generator) +(require racket/generator graph) (provide (all-defined-out)) (define-syntax-rule (in-cartesian x) @@ -30,7 +30,22 @@ (define (make-constraint [names null] [proc values]) ($constraint names proc)) -(struct $var (name domain) #:transparent) +(define constraint-names $constraint-names) +(define constraint? $constraint?) + +(define (csp->graphviz csp) + (define g (csp->graph csp)) + (graphviz g #:colors (coloring/brelaz g))) + +(define (csp->graph csp) + (for*/fold ([g (unweighted-graph/undirected (map var-name (vars csp)))]) + ([constraint (in-constraints csp)] + [edge (in-combinations (constraint-names constraint) 2)]) + (apply add-edge! g edge) + g)) + +(struct $var (name domain) #:transparent) +(define var? $var?) (define name? symbol?) (define $var-vals $var-domain) (define var-name $var-name) @@ -39,7 +54,8 @@ (struct $avar $var () #:transparent) (define assigned-var? $avar?) -(define (make-csp [vars null] [constraints null]) +(define/contract (make-csp [vars null] [constraints null]) + (() ((listof var?) (listof constraint?)) . ->* . csp?) ($csp vars constraints)) (define/contract (add-vars! csp names-or-procedure [vals-or-procedure empty]) @@ -82,8 +98,6 @@ (any/c any/c . -> . boolean?) (not (= x y))) -(struct inconsistency-signal (csp) #:transparent) - (struct $backtrack (names) #:transparent) (define (backtrack! [names null]) (raise ($backtrack names))) @@ -116,10 +130,10 @@ (define/contract (assigned-name? csp name) (csp? name? . -> . any/c) (for/or ([var (in-vars csp)] - #:when (assigned-var? var)) + #:when (assigned-var? var)) (eq? name (var-name var)))) -(define (reduce-arity proc pattern) +(define (reduce-function-arity proc pattern) (unless (match (procedure-arity proc) [(arity-at-least val) (<= val (length pattern))] [(? number? val) (= val (length pattern))]) @@ -159,7 +173,7 @@ (if (assigned-name? cname) (first ($csp-vals csp cname)) (box cname)))]) - (reduce-arity proc reduce-arity-pattern)))] + (reduce-function-arity proc reduce-arity-pattern)))] [else constraint]))))) (define/contract (assign-val csp name val) @@ -249,7 +263,7 @@ (= 2 (constraint-arity constraint))) (define (constraint-relates? constraint name) - (and (memq name ($constraint-names constraint)) #true)) + (memq name ($constraint-names constraint))) (define/contract (forward-check csp aname) (csp? name? . -> . csp?) @@ -294,16 +308,15 @@ #:unless (and (binary-constraint? constraint) (constraint-relates? constraint aname) - (let ([other-name (first (remq aname ($constraint-names constraint)))]) ; and something else - (= (length ($csp-vals csp other-name)) 1)))) ; that has only one value + (let ([other-name (first (remq aname ($constraint-names constraint)))]) + (singleton-var? (csp-var csp other-name))))) constraint)) (make-csp checked-vars nonsingleton-constraints)) (define/contract (constraint-checkable? c names) - ($constraint? (listof name?) . -> . boolean?) - (and (for/and ([cname (in-list ($constraint-names c))]) - (memq cname names)) - #true)) + ($constraint? (listof name?) . -> . any/c) + (for/and ([cname (in-list ($constraint-names c))]) + (memq cname names))) (define/contract (constraint-arity constraint) ($constraint? . -> . exact-nonnegative-integer?) @@ -325,12 +338,13 @@ (for ([constraint (in-list (sort checkable-constraints < #:key constraint-arity))] #:unless (constraint csp)) (backtrack!)) + ;; discard checked constraints, since they have no further reason to live (make-csp (vars csp) other-constraints)) (define/contract (make-nodes-consistent csp) (csp? . -> . csp?) ;; todo: why does this function slow down searches? - ($csp + (make-csp (for/list ([var (in-vars csp)]) (match-define ($var name vals) var) (define procs (for*/list ([constraint (in-constraints csp)] From 7f557f0f016e676c52613c58aab03024f5287614 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Sat, 20 Oct 2018 15:35:39 -0700 Subject: [PATCH 162/246] debug instrumenting --- csp/hacs-test.rkt | 58 +++++++++++-------- csp/hacs.rkt | 139 +++++++++++++++++++++++++++------------------- 2 files changed, 116 insertions(+), 81 deletions(-) diff --git a/csp/hacs-test.rkt b/csp/hacs-test.rkt index 49b2541d..3963f836 100644 --- a/csp/hacs-test.rkt +++ b/csp/hacs-test.rkt @@ -1,5 +1,5 @@ #lang debug racket -(require "hacs.rkt" rackunit sugar/list) +(require "hacs.rkt" rackunit sugar/list sugar/debug) (current-inference forward-check) (current-select-variable mrv-degree-hybrid) @@ -59,7 +59,7 @@ (parameterize ([current-inference forward-check]) (define vds (for/list ([k '(wa nt nsw q t v sa)]) - ($var k '(red green blue)))) + ($var k '(red green blue)))) (define cs (list ($constraint '(wa nt) neq?) ($constraint '(wa sa) neq?) @@ -78,7 +78,7 @@ (add-vars! quarters '(dollars quarters) (range 26)) (add-constraint! quarters (λ (d q) (= 26 (+ d q))) '(dollars quarters)) (add-constraint! quarters (λ (d q) (= 17 (+ d (* 0.25 q)))) '(dollars quarters)) -(check-equal? (time (solve quarters)) +(check-equal? (time-named (solve quarters)) '((dollars . 14) (quarters . 12))) @@ -102,7 +102,7 @@ (add-constraint! xsum (λ (r1 r2 r3 r4 x) (= 27 (+ r1 r2 r3 r4 x))) '(r1 r2 r3 r4 x)) (add-pairwise-constraint! xsum alldiff= '(l1 l2 l3 l4 r1 r2 r3 r4 x)) -(check-equal? (length (time (solve* xsum))) 8) +(check-equal? (length (time-named (solve* xsum))) 8) @@ -119,7 +119,7 @@ (define (word-value . xs) (for/sum ([(x idx) (in-indexed (reverse xs))]) - (* x (expt 10 idx)))) + (* x (expt 10 idx)))) (define smm (make-csp)) (add-vars! smm '(s e n d m o r y) (λ () (range 10))) @@ -136,7 +136,7 @@ (word-value m o n e y))) '(s e n d m o r y)) (add-pairwise-constraint! smm alldiff= '(s e n d m o r y)) (check-equal? (parameterize ([current-select-variable mrv-degree-hybrid]) ; todo: why is plain mrv so bad on this problem? - (time (solve smm))) '((s . 9) (e . 5) (n . 6) (d . 7) (m . 1) (o . 0) (r . 8) (y . 2))) + (time-named (solve smm))) '((s . 9) (e . 5) (n . 6) (d . 7) (m . 1) (o . 0) (r . 8) (y . 2))) ;; queens problem @@ -147,19 +147,19 @@ (add-vars! queens qs rows) (define (q-col q) (string->number (string-trim (symbol->string q) "q"))) (for* ([qs (in-combinations qs 2)]) - (match-define (list qa qb) qs) - (match-define (list qa-col qb-col) (map q-col qs)) - (add-constraint! queens - (λ (qa-row qb-row) - (and - (not (= (abs (- qa-row qb-row)) (abs (- qa-col qb-col)))) ; same diagonal? - (not (= qa-row qb-row)))) ; same row? - (list qa qb))) + (match-define (list qa qb) qs) + (match-define (list qa-col qb-col) (map q-col qs)) + (add-constraint! queens + (λ (qa-row qb-row) + (and + (not (= (abs (- qa-row qb-row)) (abs (- qa-col qb-col)))) ; same diagonal? + (not (= qa-row qb-row)))) ; same row? + (list qa qb))) -(check-equal? 92 (length (time (solve* queens)))) +(check-equal? 92 (length (time-named (solve* queens)))) #;(parameterize ([current-solver min-conflicts]) - (solve queens)) + (solve queens)) #| @@ -208,14 +208,14 @@ (add-vars! zebra ps '(dogs snails foxes horses zebra)) (for ([vars (list ns cs ds ss ps)]) - (add-pairwise-constraint! zebra neq? vars)) + (add-pairwise-constraint! zebra neq? vars)) (define (paired-with lval left rval right) (add-constraint! zebra (λ (left right) (or (not (eq? left lval)) (eq? rval right))) (list left right))) (define (paired-with* lval lefts rval rights) (for ([left lefts][right rights]) - (paired-with lval left rval right))) + (paired-with lval left rval right))) ;# 1. The englishman lives in a red house. ('englishman ns . paired-with* . 'red cs) @@ -250,13 +250,13 @@ (for ([righta (drop-right rights 2)] [left (cdr lefts)] [rightb (drop rights 2)]) - (add-constraint! zebra (λ (left righta rightb) - (or (not (eq? left lval)) (eq? righta rval) (eq? rval rightb))) - (list left righta rightb))) + (add-constraint! zebra (λ (left righta rightb) + (or (not (eq? left lval)) (eq? righta rval) (eq? rval rightb))) + (list left righta rightb))) (for ([left (list (first lefts) (last lefts))] [right (list (second rights) (fourth rights))]) - (add-constraint! zebra (λ (left right) (or (not (eq? left lval)) (eq? rval right))) - (list left right)))) + (add-constraint! zebra (λ (left right) (or (not (eq? left lval)) (eq? rval right))) + (list left right)))) ;# 10. The man who smokes chesterfields lives next to the one who keeps foxes. ('chesterfields ss . next-to . 'foxes ps) @@ -281,9 +281,19 @@ (check-equal? (parameterize ([current-select-variable mrv] [current-shuffle #f]) - (finish (time (solve zebra)))) + (finish (time-named (solve zebra)))) '(((nationality-0 . norwegian) (color-0 . yellow) (drink-0 . water) (smoke-0 . kools) (pet-0 . foxes)) ((nationality-1 . ukrainian) (color-1 . blue) (drink-1 . tea) (smoke-1 . chesterfields) (pet-1 . horses)) ((nationality-2 . englishman) (color-2 . red) (drink-2 . milk) (smoke-2 . oldgold) (pet-2 . snails)) ((nationality-3 . japanese) (color-3 . green) (drink-3 . coffee) (smoke-3 . parliaments) (pet-3 . zebra)) ((nationality-4 . spaniard) (color-4 . ivory) (drink-4 . orange-juice) (smoke-4 . luckystrike) (pet-4 . dogs)))) + +(module+ main + (when-debug + (define-syntax n (λ (stx) #'10)) + (time-avg n (void (solve quarters))) + (time-avg n (void (solve* xsum))) + (time-avg n (void (solve smm))) + (time-avg n (void (solve* queens))) + (time-avg n (void (solve zebra))))) + diff --git a/csp/hacs.rkt b/csp/hacs.rkt index 0eafa96b..dc41594f 100644 --- a/csp/hacs.rkt +++ b/csp/hacs.rkt @@ -2,16 +2,27 @@ (require racket/generator graph) (provide (all-defined-out)) +(define-syntax when-debug + (let () + (define debug #f) + (if debug + (make-rename-transformer #'begin) + (λ (stx) (syntax-case stx () + [(_ . rest) #'(void)]))))) + (define-syntax-rule (in-cartesian x) (in-generator (let ([argss x]) (let loop ([argss argss][acc empty]) (if (null? argss) (yield (reverse acc)) (for ([arg (in-list (car argss))]) - (loop (cdr argss) (cons arg acc)))))))) + (loop (cdr argss) (cons arg acc)))))))) -(struct $csp ([vars #:mutable] - [constraints #:mutable]) #:transparent) +(struct $csp (vars + constraints + [assignments #:auto] + [checks #:auto]) #:mutable #:transparent + #:auto-value 0) (define csp? $csp?) (define vars $csp-vars) (define constraints $csp-constraints) @@ -25,7 +36,7 @@ (raise-argument-error '$constraint-proc "$csp" csp)) ;; apply proc in many-to-many style (for/and ([args (in-cartesian (map (λ (cname) ($csp-vals csp cname)) ($constraint-names constraint)))]) - (apply ($constraint-proc constraint) args)))) + (apply ($constraint-proc constraint) args)))) (define (make-constraint [names null] [proc values]) ($constraint names proc)) @@ -80,11 +91,11 @@ ((csp? procedure? (listof (listof name?))) ((or/c #false name?)) . ->* . void?) (set-$csp-constraints! csp (append (constraints csp) (for/list ([names (in-list namess)]) - (for ([name (in-list names)]) - (check-name-in-csp! 'add-constraints! csp name)) - (make-constraint names (if proc-name - (procedure-rename proc proc-name) - proc)))))) + (for ([name (in-list names)]) + (check-name-in-csp! 'add-constraints! csp name)) + (make-constraint names (if proc-name + (procedure-rename proc proc-name) + proc)))))) (define/contract (add-pairwise-constraint! csp proc var-names [proc-name #false]) ((csp? procedure? (listof name?)) (name?) . ->* . void?) @@ -118,7 +129,7 @@ (check-name-in-csp! 'csp-var csp name) (for/first ([var (in-vars csp)] #:when (eq? name (var-name var))) - var)) + var)) (define/contract ($csp-vals csp name) (csp? name? . -> . (listof any/c)) @@ -131,7 +142,7 @@ (csp? name? . -> . any/c) (for/or ([var (in-vars csp)] #:when (assigned-var? var)) - (eq? name (var-name var)))) + (eq? name (var-name var)))) (define (reduce-function-arity proc pattern) (unless (match (procedure-arity proc) @@ -162,27 +173,30 @@ (ormap assigned-name? ($constraint-names constraint))) (make-csp (vars csp) (for/list ([constraint (in-constraints csp)]) - (cond - [(and (if minimum-arity (<= minimum-arity (constraint-arity constraint)) #true) - (partially-assigned? constraint)) - (match-define ($constraint cnames proc) constraint) - ($constraint (filter-not assigned-name? cnames) - ;; pattern is mix of values and boxed symbols (indicating variables to persist) - ;; use boxes here as cheap way to distinguish id symbols from value symbols - (let ([reduce-arity-pattern (for/list ([cname (in-list cnames)]) - (if (assigned-name? cname) - (first ($csp-vals csp cname)) - (box cname)))]) - (reduce-function-arity proc reduce-arity-pattern)))] - [else constraint]))))) - + (cond + [(and (if minimum-arity (<= minimum-arity (constraint-arity constraint)) #true) + (partially-assigned? constraint)) + (match-define ($constraint cnames proc) constraint) + ($constraint (filter-not assigned-name? cnames) + ;; pattern is mix of values and boxed symbols (indicating variables to persist) + ;; use boxes here as cheap way to distinguish id symbols from value symbols + (let ([reduce-arity-pattern (for/list ([cname (in-list cnames)]) + (if (assigned-name? cname) + (first ($csp-vals csp cname)) + (box cname)))]) + (reduce-function-arity proc reduce-arity-pattern)))] + [else constraint]))))) + +(define nassns 0) +(define (reset-assns!) (set! nassns 0)) (define/contract (assign-val csp name val) (csp? name? any/c . -> . csp?) + (when-debug (set! nassns (add1 nassns))) (make-csp (for/list ([var (vars csp)]) - (if (eq? name (var-name var)) - ($avar name (list val)) - var)) + (if (eq? name (var-name var)) + ($avar name (list val)) + var)) (constraints csp))) (define/contract (unassigned-vars csp) @@ -214,7 +228,7 @@ (csp? $var? . -> . exact-nonnegative-integer?) (for/sum ([constraint (in-constraints csp)] #:when (memq (var-name var) ($constraint-names constraint))) - 1)) + 1)) (define/contract (blended-variable-selector csp) (csp? . -> . (or/c #false (and/c $var? (not/c assigned-var?)))) @@ -256,8 +270,8 @@ [cnames (in-value ($constraint-names constraint))] #:when (and (= (length names) (length cnames)) (for/and ([name (in-list names)]) - (memq name cnames)))) - constraint)) + (memq name cnames)))) + constraint)) (define (binary-constraint? constraint) (= 2 (constraint-arity constraint))) @@ -265,6 +279,9 @@ (define (constraint-relates? constraint name) (memq name ($constraint-names constraint))) +(define nfchecks 0) +(define (reset-nfcs!) (set! nfchecks 0)) + (define/contract (forward-check csp aname) (csp? name? . -> . csp?) (define aval (first ($csp-vals csp aname))) @@ -280,20 +297,21 @@ (define new-vals (for/list ([val (in-list vals)] #:when (for/and ([constraint (in-list constraints)]) - (let ([proc ($constraint-proc constraint)]) - (if (eq? name (first ($constraint-names constraint))) - (proc val aval) - (proc aval val))))) - val)) + (let ([proc ($constraint-proc constraint)]) + (if (eq? name (first ($constraint-names constraint))) + (proc val aval) + (proc aval val))))) + val)) ($cvar name new-vals (cons aname (if ($cvar? var) ($cvar-past var) null)))])])) (define checked-vars (map check-var (vars csp))) + (when-debug (set! nfchecks (+ (length checked-vars) nchecks))) ;; conflict-set will be empty if there are no empty domains (define conflict-set (for*/list ([var (in-list checked-vars)] #:when (empty? ($var-domain var)) [name (in-list ($cvar-past var))]) - name)) + name)) ;; for conflict-directed backjumping it's essential to forward-check ALL vars ;; (even after an empty domain is generated) and combine their conflicts ;; so we can discover the *most recent past var* that could be the culprit. @@ -310,13 +328,13 @@ (constraint-relates? constraint aname) (let ([other-name (first (remq aname ($constraint-names constraint)))]) (singleton-var? (csp-var csp other-name))))) - constraint)) + constraint)) (make-csp checked-vars nonsingleton-constraints)) (define/contract (constraint-checkable? c names) ($constraint? (listof name?) . -> . any/c) (for/and ([cname (in-list ($constraint-names c))]) - (memq cname names))) + (memq cname names))) (define/contract (constraint-arity constraint) ($constraint? . -> . exact-nonnegative-integer?) @@ -325,6 +343,8 @@ (define (singleton-var? var) (= 1 (length ($var-domain var)))) +(define nchecks 0) +(define (reset-nchecks!) (set! nchecks 0)) (define/contract (check-constraints csp) (csp? . -> . csp?) ;; this time, we're not limited to assigned variables @@ -332,12 +352,13 @@ ;; we also want to use "singleton" vars (that is, vars that have been reduced to a single domain value by forward checking) (define singleton-varnames (for/list ([var (in-vars csp)] #:when (singleton-var? var)) - (var-name var))) + (var-name var))) (define-values (checkable-constraints other-constraints) (partition (λ (c) (constraint-checkable? c singleton-varnames)) (constraints csp))) - (for ([constraint (in-list (sort checkable-constraints < #:key constraint-arity))] + (for ([(constraint idx) (in-indexed (sort checkable-constraints < #:key constraint-arity))] #:unless (constraint csp)) - (backtrack!)) + (when-debug (set! nchecks (+ (add1 idx) nchecks))) + (backtrack!)) ;; discard checked constraints, since they have no further reason to live (make-csp (vars csp) other-constraints)) @@ -346,15 +367,15 @@ ;; todo: why does this function slow down searches? (make-csp (for/list ([var (in-vars csp)]) - (match-define ($var name vals) var) - (define procs (for*/list ([constraint (in-constraints csp)] - [cnames (in-value ($constraint-names constraint))] - #:when (and (= 1 (length cnames)) (eq? name (car cnames)))) - ($constraint-proc constraint))) - ($var name - (for*/fold ([vals vals]) - ([proc (in-list procs)]) - (filter proc vals)))) + (match-define ($var name vals) var) + (define procs (for*/list ([constraint (in-constraints csp)] + [cnames (in-value ($constraint-names constraint))] + #:when (and (= 1 (length cnames)) (eq? name (car cnames)))) + ($constraint-proc constraint))) + ($var name + (for*/fold ([vals vals]) + ([proc (in-list procs)]) + (filter proc vals)))) (constraints csp))) (define/contract (backtracking-solver @@ -388,23 +409,27 @@ ;; todo: min-conflicts solver -(define/contract ($csp-assocs csp) +(define/contract (csp->assocs csp) (csp? . -> . (listof (cons/c name? any/c))) (for/list ([var (in-vars csp)]) - (match var - [($var name domain) (cons name (first domain))]))) + (match var + [($var name domain) (cons name (first domain))]))) (define/contract (solve* csp - #:finish-proc [finish-proc $csp-assocs] + #:finish-proc [finish-proc csp->assocs] #:solver [solver (or (current-solver) backtracking-solver)] #:count [max-solutions +inf.0]) ((csp?) (#:finish-proc procedure? #:solver procedure? #:count integer?) . ->* . (listof any/c)) + (when-debug + (reset-assns!) + (reset-nfcs!) + (reset-nchecks!)) (for/list ([solution (in-producer (solver csp) (void))] [idx (in-range max-solutions)]) - (finish-proc solution))) + (finish-proc solution))) (define/contract (solve csp - #:finish-proc [finish-proc $csp-assocs] + #:finish-proc [finish-proc csp->assocs] #:solver [solver (or (current-solver) backtracking-solver)]) ((csp?) (#:finish-proc procedure? #:solver procedure?) . ->* . (or/c #false any/c)) (match (solve* csp #:finish-proc finish-proc #:solver solver #:count 1) From bb1033ca3e79bbf748204d9999743003cf3c7543 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Sat, 20 Oct 2018 15:41:24 -0700 Subject: [PATCH 163/246] snore --- csp/hacs-test.rkt | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/csp/hacs-test.rkt b/csp/hacs-test.rkt index 3963f836..531a2b45 100644 --- a/csp/hacs-test.rkt +++ b/csp/hacs-test.rkt @@ -210,8 +210,10 @@ (for ([vars (list ns cs ds ss ps)]) (add-pairwise-constraint! zebra neq? vars)) +(define (xnor lcond rcond) + (or (and lcond rcond) (and (not lcond) (not rcond)))) (define (paired-with lval left rval right) - (add-constraint! zebra (λ (left right) (or (not (eq? left lval)) (eq? rval right))) (list left right))) + (add-constraint! zebra (λ (left right) (xnor (eq? left lval) (eq? rval right))) (list left right))) (define (paired-with* lval lefts rval rights) (for ([left lefts][right rights]) @@ -255,7 +257,7 @@ (list left righta rightb))) (for ([left (list (first lefts) (last lefts))] [right (list (second rights) (fourth rights))]) - (add-constraint! zebra (λ (left right) (or (not (eq? left lval)) (eq? rval right))) + (add-constraint! zebra (λ (left right) (xnor (eq? left lval) (eq? rval right))) (list left right)))) ;# 10. The man who smokes chesterfields lives next to the one who keeps foxes. From 62c11e167625e595a8a7ed711c53d0eb0a50340a Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Sat, 20 Oct 2018 18:08:13 -0700 Subject: [PATCH 164/246] min-con --- csp/aima-queens.rkt | 25 ++++++++++++ csp/aima.rkt | 6 ++- csp/hacs-test-workbench.rkt | 25 +++++++++++- csp/hacs-test.rkt | 6 +-- csp/hacs.rkt | 81 ++++++++++++++++++++++++++++++------- 5 files changed, 120 insertions(+), 23 deletions(-) create mode 100644 csp/aima-queens.rkt diff --git a/csp/aima-queens.rkt b/csp/aima-queens.rkt new file mode 100644 index 00000000..4f29fe56 --- /dev/null +++ b/csp/aima-queens.rkt @@ -0,0 +1,25 @@ +#lang br +(require "aima.rkt" sugar/debug) + + +;; queens problem +;; place queens on chessboard so they do not intersect +(define qs (for/list ([q 8]) (string->symbol (format "q~a" q)))) +(define rows (range (length qs))) +(define vds (for/list ([q qs]) + ($vd q (range (length qs))))) +(define (q-col q) (string->number (string-trim (symbol->string q) "q"))) +(define cs (for*/list ([qs (in-combinations qs 2)]) + (match-define (list qa qb) qs) + (match-define (list qa-col qb-col) (map q-col qs)) + ($constraint + (list qa qb) + (λ (qa-row qb-row) + (and + (not (= (abs (- qa-row qb-row)) (abs (- qa-col qb-col)))) ; same diagonal? + (not (= qa-row qb-row))))))) + +(define queens (make-csp vds cs)) + +(current-solver min-conflicts) +(time-named (solve queens)) \ No newline at end of file diff --git a/csp/aima.rkt b/csp/aima.rkt index 042a76be..05346496 100644 --- a/csp/aima.rkt +++ b/csp/aima.rkt @@ -370,7 +370,8 @@ ;; ______________________________________________________________________________ ;; Min-conflicts hillclimbing search for CSPs -(define (min_conflicts csp [max_steps (expt 10 5)]) +(require sugar/debug) +(define (min-conflicts csp [max_steps (expt 10 5)]) (($csp?) (integer?) . ->* . generator?) ;; Solve a CSP by stochastic hillclimbing on the number of conflicts. ;; Generate a complete assignment for all variables (probably with conflicts) @@ -384,6 +385,7 @@ (for ([i (in-range max_steps)]) (define conflicted (conflicted_vars csp current)) (when (empty? conflicted) + (report i) (yield current)) (define var (first ((if (current-shuffle) shuffle values) conflicted))) (define val (min_conflicts_value csp var current)) @@ -527,7 +529,7 @@ (set-$csp-curr_domains! csp #f) (parameterize ([current-shuffle #f] - [current-solver min_conflicts]) + [current-solver min-conflicts]) (check-equal? (solve csp) (make-hasheq '((nsw . red) (nt . red) (q . green) (sa . blue) (t . red) (v . green) (wa . green)))) diff --git a/csp/hacs-test-workbench.rkt b/csp/hacs-test-workbench.rkt index dad7dcf2..32fa1f05 100644 --- a/csp/hacs-test-workbench.rkt +++ b/csp/hacs-test-workbench.rkt @@ -1,7 +1,28 @@ #lang debug racket -(require sugar "hacs.rkt") +(require sugar/debug "hacs.rkt") (current-inference forward-check) (current-select-variable mrv) (current-order-values shuffle) -(current-shuffle #true) \ No newline at end of file +(current-shuffle #true) + +;; queens problem +;; place queens on chessboard so they do not intersect +(define queens (make-csp)) +(define qs (for/list ([q 10]) (string->symbol (format "q~a" q)))) +(define rows (range (length qs))) +(add-vars! queens qs rows) +(define (q-col q) (string->number (string-trim (symbol->string q) "q"))) +(for* ([qs (in-combinations qs 2)]) + (match-define (list qa qb) qs) + (match-define (list qa-col qb-col) (map q-col qs)) + (add-constraint! queens + (λ (qa-row qb-row) + (nor + (= (abs (- qa-row qb-row)) (abs (- qa-col qb-col))) ; same diagonal? + (= qa-row qb-row))) ; same row? + (list qa qb))) + +#;(time-named (solve queens)) +(parameterize ([current-solver min-conflicts]) + (time-named (solve queens))) \ No newline at end of file diff --git a/csp/hacs-test.rkt b/csp/hacs-test.rkt index 531a2b45..42da51e8 100644 --- a/csp/hacs-test.rkt +++ b/csp/hacs-test.rkt @@ -158,10 +158,6 @@ (check-equal? 92 (length (time-named (solve* queens)))) -#;(parameterize ([current-solver min-conflicts]) - (solve queens)) - - #| # There are no tricks, just pure logic, so good luck and don't give up. # @@ -298,4 +294,4 @@ (time-avg n (void (solve smm))) (time-avg n (void (solve* queens))) (time-avg n (void (solve zebra))))) - + \ No newline at end of file diff --git a/csp/hacs.rkt b/csp/hacs.rkt index dc41594f..4b0acbea 100644 --- a/csp/hacs.rkt +++ b/csp/hacs.rkt @@ -1,5 +1,5 @@ #lang debug racket -(require racket/generator graph) +(require racket/generator graph sugar/debug) (provide (all-defined-out)) (define-syntax when-debug @@ -345,8 +345,8 @@ (define nchecks 0) (define (reset-nchecks!) (set! nchecks 0)) -(define/contract (check-constraints csp) - (csp? . -> . csp?) +(define/contract (check-constraints csp [mandatory-names #f] #:conflicts [conflict-count? #f]) + ((csp?) ((listof name?) #:conflicts boolean?) . ->* . (or/c csp? exact-nonnegative-integer?)) ;; this time, we're not limited to assigned variables ;; (that is, vars that have been deliberately assigned in the backtrack process thus far) ;; we also want to use "singleton" vars (that is, vars that have been reduced to a single domain value by forward checking) @@ -354,13 +354,24 @@ #:when (singleton-var? var)) (var-name var))) (define-values (checkable-constraints other-constraints) - (partition (λ (c) (constraint-checkable? c singleton-varnames)) (constraints csp))) - (for ([(constraint idx) (in-indexed (sort checkable-constraints < #:key constraint-arity))] - #:unless (constraint csp)) - (when-debug (set! nchecks (+ (add1 idx) nchecks))) - (backtrack!)) - ;; discard checked constraints, since they have no further reason to live - (make-csp (vars csp) other-constraints)) + (partition (λ (c) (and (constraint-checkable? c singleton-varnames) + (if mandatory-names + (for/and ([name (in-list mandatory-names)]) + (constraint-relates? c name)) + #true))) (constraints csp))) + (cond + [conflict-count? (define conflict-count + (for/sum ([constraint (in-list checkable-constraints)] + #:unless (constraint csp)) + 1)) + (when-debug (set! nchecks (+ conflict-count nchecks))) + conflict-count] + [else (for ([(constraint idx) (in-indexed (sort checkable-constraints < #:key constraint-arity))] + #:unless (constraint csp)) + (when-debug (set! nchecks (+ (add1 idx) nchecks))) + (backtrack!)) + ;; discard checked constraints, since they have no further reason to live + (make-csp (vars csp) other-constraints)])) (define/contract (make-nodes-consistent csp) (csp? . -> . csp?) @@ -407,7 +418,49 @@ (loop csp))) conflicts)])))) -;; todo: min-conflicts solver + +(define/contract (min-conflicts csp [max-steps (expt 10 3)]) + (($csp?) (integer?) . ->* . generator?) + ;; Solve a CSP by stochastic hillclimbing on the number of conflicts. + (generator () + (let loop ([csp0 csp]) + ;; Generate a complete assignment for all variables (probably with conflicts) + (define starting-assignment + (for/fold ([csp csp0]) + ([var (in-vars csp0)]) + (define name (var-name var)) + (assign-val csp name (first (shuffle ($csp-vals csp0 name)))))) + ;; Now repeatedly choose a random conflicted variable and change it + (for/fold ([csp starting-assignment]) + ([i (in-range max-steps)]) + (match (conflicted-var-names csp) + [(? empty?) (when (check-constraints csp) (report i 'steps-taken) (yield csp))] + [cvar-names + (define cvar-name (first ((if (current-shuffle) shuffle values) cvar-names))) + (define val (min-conflicts-value csp cvar-name ($csp-vals csp0 cvar-name))) + (assign-val csp cvar-name val)])) + (loop csp0)))) + +(define/contract (conflicted-var-names csp) + ($csp? . -> . (listof name?)) + ;; Return a list of variables in current assignment that are conflicted + (for/list ([var (in-vars csp)] + #:when (positive? (nconflicts csp (var-name var)))) + (var-name var))) + +(define/contract (min-conflicts-value csp name vals) + ($csp? name? (listof any/c) . -> . any/c) + ;; Return the value that will give var the least number of conflicts + (argmin-random-tie (λ (val) (nconflicts csp name val)) vals)) + +(define no-value-sig (gensym)) + +(define/contract (nconflicts csp name [val no-value-sig]) + (($csp? name?) (any/c) . ->* . exact-nonnegative-integer?) + ;; How many conflicts var: val assignment has with other variables. + (check-constraints (if (eq? val no-value-sig) + csp + (assign-val csp name val)) (list name) #:conflicts #t)) (define/contract (csp->assocs csp) (csp? . -> . (listof (cons/c name? any/c))) @@ -418,8 +471,8 @@ (define/contract (solve* csp #:finish-proc [finish-proc csp->assocs] #:solver [solver (or (current-solver) backtracking-solver)] - #:count [max-solutions +inf.0]) - ((csp?) (#:finish-proc procedure? #:solver procedure? #:count integer?) . ->* . (listof any/c)) + #:limit [max-solutions +inf.0]) + ((csp?) (#:finish-proc procedure? #:solver procedure? #:limit integer?) . ->* . (listof any/c)) (when-debug (reset-assns!) (reset-nfcs!) @@ -432,7 +485,7 @@ #:finish-proc [finish-proc csp->assocs] #:solver [solver (or (current-solver) backtracking-solver)]) ((csp?) (#:finish-proc procedure? #:solver procedure?) . ->* . (or/c #false any/c)) - (match (solve* csp #:finish-proc finish-proc #:solver solver #:count 1) + (match (solve* csp #:finish-proc finish-proc #:solver solver #:limit 1) [(list solution) solution] [else #false])) From fe94d1ff60fe3b5b33c23287921a458ac2aa61e6 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Sat, 20 Oct 2018 19:39:40 -0700 Subject: [PATCH 165/246] cleanse --- csp/hacs-test-workbench.rkt | 2 +- csp/hacs.rkt | 24 +++++++++--------------- 2 files changed, 10 insertions(+), 16 deletions(-) diff --git a/csp/hacs-test-workbench.rkt b/csp/hacs-test-workbench.rkt index 32fa1f05..2c39acd7 100644 --- a/csp/hacs-test-workbench.rkt +++ b/csp/hacs-test-workbench.rkt @@ -9,7 +9,7 @@ ;; queens problem ;; place queens on chessboard so they do not intersect (define queens (make-csp)) -(define qs (for/list ([q 10]) (string->symbol (format "q~a" q)))) +(define qs (for/list ([q 8]) (string->symbol (format "q~a" q)))) (define rows (range (length qs))) (add-vars! queens qs rows) (define (q-col q) (string->number (string-trim (symbol->string q) "q"))) diff --git a/csp/hacs.rkt b/csp/hacs.rkt index 4b0acbea..999983c3 100644 --- a/csp/hacs.rkt +++ b/csp/hacs.rkt @@ -28,6 +28,7 @@ (define constraints $csp-constraints) (define-syntax-rule (in-constraints csp) (in-list ($csp-constraints csp))) (define-syntax-rule (in-vars csp) (in-list ($csp-vars csp))) +(define-syntax-rule (in-var-names csp) (in-list (map $var-name ($csp-vars csp)))) (struct $constraint (names proc) #:transparent #:property prop:procedure @@ -209,18 +210,11 @@ [(? empty?) #false] [(cons x _) x])) -(define/contract (argmin-random-tie proc xs) - (procedure? (non-empty-listof any/c) . -> . any/c) - (let* ([xs (sort xs < #:key proc)] - [xs (takef xs (λ (x) (= (proc (car xs)) (proc x))))] - [xs ((if (current-shuffle) shuffle values) xs)]) - (first xs))) - (define/contract (minimum-remaining-values csp) (csp? . -> . (or/c #false (and/c $var? (not/c assigned-var?)))) (match (unassigned-vars csp) [(? empty?) #false] - [xs (argmin-random-tie (λ (var) (length ($var-domain var))) xs)])) + [xs (argmin (λ (var) (length ($var-domain var))) (shuffle xs))])) (define mrv minimum-remaining-values) @@ -419,7 +413,7 @@ conflicts)])))) -(define/contract (min-conflicts csp [max-steps (expt 10 3)]) +(define/contract (min-conflicts csp [max-steps 64]) (($csp?) (integer?) . ->* . generator?) ;; Solve a CSP by stochastic hillclimbing on the number of conflicts. (generator () @@ -434,7 +428,7 @@ (for/fold ([csp starting-assignment]) ([i (in-range max-steps)]) (match (conflicted-var-names csp) - [(? empty?) (when (check-constraints csp) (report i 'steps-taken) (yield csp))] + [(? empty?) (when (check-constraints csp) (yield csp)) (loop csp0)] [cvar-names (define cvar-name (first ((if (current-shuffle) shuffle values) cvar-names))) (define val (min-conflicts-value csp cvar-name ($csp-vals csp0 cvar-name))) @@ -444,14 +438,14 @@ (define/contract (conflicted-var-names csp) ($csp? . -> . (listof name?)) ;; Return a list of variables in current assignment that are conflicted - (for/list ([var (in-vars csp)] - #:when (positive? (nconflicts csp (var-name var)))) - (var-name var))) + (for/list ([name (in-var-names csp)] + #:when (positive? (nconflicts csp name))) + name)) (define/contract (min-conflicts-value csp name vals) ($csp? name? (listof any/c) . -> . any/c) ;; Return the value that will give var the least number of conflicts - (argmin-random-tie (λ (val) (nconflicts csp name val)) vals)) + (argmin (λ (val) (nconflicts csp name val)) (shuffle vals))) (define no-value-sig (gensym)) @@ -460,7 +454,7 @@ ;; How many conflicts var: val assignment has with other variables. (check-constraints (if (eq? val no-value-sig) csp - (assign-val csp name val)) (list name) #:conflicts #t)) + (assign-val csp name val)) (list name) #:conflicts #true)) (define/contract (csp->assocs csp) (csp? . -> . (listof (cons/c name? any/c))) From fc42059e3be7e69390f521348f0e5939a6aedc2e Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Sun, 21 Oct 2018 09:25:07 -0700 Subject: [PATCH 166/246] deshuffle --- csp/hacs-test-workbench.rkt | 35 +++++---- csp/hacs-test.rkt | 4 +- csp/hacs.rkt | 141 +++++++++++++++++++----------------- 3 files changed, 94 insertions(+), 86 deletions(-) diff --git a/csp/hacs-test-workbench.rkt b/csp/hacs-test-workbench.rkt index 2c39acd7..55faea1c 100644 --- a/csp/hacs-test-workbench.rkt +++ b/csp/hacs-test-workbench.rkt @@ -4,25 +4,28 @@ (current-inference forward-check) (current-select-variable mrv) (current-order-values shuffle) -(current-shuffle #true) +(current-random #true) ;; queens problem ;; place queens on chessboard so they do not intersect -(define queens (make-csp)) -(define qs (for/list ([q 8]) (string->symbol (format "q~a" q)))) -(define rows (range (length qs))) -(add-vars! queens qs rows) -(define (q-col q) (string->number (string-trim (symbol->string q) "q"))) -(for* ([qs (in-combinations qs 2)]) - (match-define (list qa qb) qs) - (match-define (list qa-col qb-col) (map q-col qs)) - (add-constraint! queens - (λ (qa-row qb-row) - (nor - (= (abs (- qa-row qb-row)) (abs (- qa-col qb-col))) ; same diagonal? - (= qa-row qb-row))) ; same row? - (list qa qb))) -#;(time-named (solve queens)) +(define board-size 8) + + (define queens (make-csp)) + (define qs (for/list ([q board-size]) (string->symbol (format "q~a" q)))) + (define rows (range (length qs))) + (add-vars! queens qs rows) + (define (q-col q) (string->number (string-trim (symbol->string q) "q"))) + (for* ([qs (in-combinations qs 2)]) + (match-define (list qa qb) qs) + (match-define (list qa-col qb-col) (map q-col qs)) + (add-constraint! queens + (λ (qa-row qb-row) + (nor + (= (abs (- qa-row qb-row)) (abs (- qa-col qb-col))) ; same diagonal? + (= qa-row qb-row))) ; same row? + (list qa qb))) + +(time-avg 10 (solve queens)) (parameterize ([current-solver min-conflicts]) (time-named (solve queens))) \ No newline at end of file diff --git a/csp/hacs-test.rkt b/csp/hacs-test.rkt index 42da51e8..4c3511b5 100644 --- a/csp/hacs-test.rkt +++ b/csp/hacs-test.rkt @@ -4,7 +4,7 @@ (current-inference forward-check) (current-select-variable mrv-degree-hybrid) (current-order-values shuffle) -(current-shuffle #true) +(current-random #true) (check-equal? (first-unassigned-variable ($csp (list ($var 'a (range 3)) ($var 'b (range 3))) null)) ($var 'a (range 3))) @@ -278,7 +278,7 @@ (apply map list (slice-at x 5))) (check-equal? (parameterize ([current-select-variable mrv] - [current-shuffle #f]) + [current-random #f]) (finish (time-named (solve zebra)))) '(((nationality-0 . norwegian) (color-0 . yellow) (drink-0 . water) (smoke-0 . kools) (pet-0 . foxes)) ((nationality-1 . ukrainian) (color-1 . blue) (drink-1 . tea) (smoke-1 . chesterfields) (pet-1 . horses)) diff --git a/csp/hacs.rkt b/csp/hacs.rkt index 999983c3..36042e0b 100644 --- a/csp/hacs.rkt +++ b/csp/hacs.rkt @@ -16,7 +16,7 @@ (if (null? argss) (yield (reverse acc)) (for ([arg (in-list (car argss))]) - (loop (cdr argss) (cons arg acc)))))))) + (loop (cdr argss) (cons arg acc)))))))) (struct $csp (vars constraints @@ -37,7 +37,7 @@ (raise-argument-error '$constraint-proc "$csp" csp)) ;; apply proc in many-to-many style (for/and ([args (in-cartesian (map (λ (cname) ($csp-vals csp cname)) ($constraint-names constraint)))]) - (apply ($constraint-proc constraint) args)))) + (apply ($constraint-proc constraint) args)))) (define (make-constraint [names null] [proc values]) ($constraint names proc)) @@ -92,11 +92,11 @@ ((csp? procedure? (listof (listof name?))) ((or/c #false name?)) . ->* . void?) (set-$csp-constraints! csp (append (constraints csp) (for/list ([names (in-list namess)]) - (for ([name (in-list names)]) - (check-name-in-csp! 'add-constraints! csp name)) - (make-constraint names (if proc-name - (procedure-rename proc proc-name) - proc)))))) + (for ([name (in-list names)]) + (check-name-in-csp! 'add-constraints! csp name)) + (make-constraint names (if proc-name + (procedure-rename proc proc-name) + proc)))))) (define/contract (add-pairwise-constraint! csp proc var-names [proc-name #false]) ((csp? procedure? (listof name?)) (name?) . ->* . void?) @@ -117,7 +117,7 @@ (define current-order-values (make-parameter #f)) (define current-inference (make-parameter #f)) (define current-solver (make-parameter #f)) -(define current-shuffle (make-parameter #t)) +(define current-random (make-parameter #t)) (define/contract (check-name-in-csp! caller csp name) (symbol? csp? name? . -> . void?) @@ -130,7 +130,7 @@ (check-name-in-csp! 'csp-var csp name) (for/first ([var (in-vars csp)] #:when (eq? name (var-name var))) - var)) + var)) (define/contract ($csp-vals csp name) (csp? name? . -> . (listof any/c)) @@ -143,7 +143,7 @@ (csp? name? . -> . any/c) (for/or ([var (in-vars csp)] #:when (assigned-var? var)) - (eq? name (var-name var)))) + (eq? name (var-name var)))) (define (reduce-function-arity proc pattern) (unless (match (procedure-arity proc) @@ -174,19 +174,19 @@ (ormap assigned-name? ($constraint-names constraint))) (make-csp (vars csp) (for/list ([constraint (in-constraints csp)]) - (cond - [(and (if minimum-arity (<= minimum-arity (constraint-arity constraint)) #true) - (partially-assigned? constraint)) - (match-define ($constraint cnames proc) constraint) - ($constraint (filter-not assigned-name? cnames) - ;; pattern is mix of values and boxed symbols (indicating variables to persist) - ;; use boxes here as cheap way to distinguish id symbols from value symbols - (let ([reduce-arity-pattern (for/list ([cname (in-list cnames)]) - (if (assigned-name? cname) - (first ($csp-vals csp cname)) - (box cname)))]) - (reduce-function-arity proc reduce-arity-pattern)))] - [else constraint]))))) + (cond + [(and (if minimum-arity (<= minimum-arity (constraint-arity constraint)) #true) + (partially-assigned? constraint)) + (match-define ($constraint cnames proc) constraint) + ($constraint (filter-not assigned-name? cnames) + ;; pattern is mix of values and boxed symbols (indicating variables to persist) + ;; use boxes here as cheap way to distinguish id symbols from value symbols + (let ([reduce-arity-pattern (for/list ([cname (in-list cnames)]) + (if (assigned-name? cname) + (first ($csp-vals csp cname)) + (box cname)))]) + (reduce-function-arity proc reduce-arity-pattern)))] + [else constraint]))))) (define nassns 0) (define (reset-assns!) (set! nassns 0)) @@ -195,9 +195,9 @@ (when-debug (set! nassns (add1 nassns))) (make-csp (for/list ([var (vars csp)]) - (if (eq? name (var-name var)) - ($avar name (list val)) - var)) + (if (eq? name (var-name var)) + ($avar name (list val)) + var)) (constraints csp))) (define/contract (unassigned-vars csp) @@ -214,7 +214,7 @@ (csp? . -> . (or/c #false (and/c $var? (not/c assigned-var?)))) (match (unassigned-vars csp) [(? empty?) #false] - [xs (argmin (λ (var) (length ($var-domain var))) (shuffle xs))])) + [xs (argmin (λ (var) (length ($var-domain var))) xs)])) (define mrv minimum-remaining-values) @@ -222,7 +222,7 @@ (csp? $var? . -> . exact-nonnegative-integer?) (for/sum ([constraint (in-constraints csp)] #:when (memq (var-name var) ($constraint-names constraint))) - 1)) + 1)) (define/contract (blended-variable-selector csp) (csp? . -> . (or/c #false (and/c $var? (not/c assigned-var?)))) @@ -252,7 +252,7 @@ ;; use degree as tiebreaker for mrv (define max-degree-arg (argmax (λ (var) (var-degree csp var)) mrv-uvars)) ;; use random tiebreaker for degree - (first (shuffle (filter (λ (var) (= (var-degree csp max-degree-arg) (var-degree csp var))) mrv-uvars)))])])) + (random-pick (filter (λ (var) (= (var-degree csp max-degree-arg) (var-degree csp var))) mrv-uvars))])])) (define first-domain-value values) @@ -264,8 +264,8 @@ [cnames (in-value ($constraint-names constraint))] #:when (and (= (length names) (length cnames)) (for/and ([name (in-list names)]) - (memq name cnames)))) - constraint)) + (memq name cnames)))) + constraint)) (define (binary-constraint? constraint) (= 2 (constraint-arity constraint))) @@ -291,11 +291,11 @@ (define new-vals (for/list ([val (in-list vals)] #:when (for/and ([constraint (in-list constraints)]) - (let ([proc ($constraint-proc constraint)]) - (if (eq? name (first ($constraint-names constraint))) - (proc val aval) - (proc aval val))))) - val)) + (let ([proc ($constraint-proc constraint)]) + (if (eq? name (first ($constraint-names constraint))) + (proc val aval) + (proc aval val))))) + val)) ($cvar name new-vals (cons aname (if ($cvar? var) ($cvar-past var) null)))])])) @@ -305,7 +305,7 @@ (define conflict-set (for*/list ([var (in-list checked-vars)] #:when (empty? ($var-domain var)) [name (in-list ($cvar-past var))]) - name)) + name)) ;; for conflict-directed backjumping it's essential to forward-check ALL vars ;; (even after an empty domain is generated) and combine their conflicts ;; so we can discover the *most recent past var* that could be the culprit. @@ -322,13 +322,13 @@ (constraint-relates? constraint aname) (let ([other-name (first (remq aname ($constraint-names constraint)))]) (singleton-var? (csp-var csp other-name))))) - constraint)) + constraint)) (make-csp checked-vars nonsingleton-constraints)) (define/contract (constraint-checkable? c names) ($constraint? (listof name?) . -> . any/c) (for/and ([cname (in-list ($constraint-names c))]) - (memq cname names))) + (memq cname names))) (define/contract (constraint-arity constraint) ($constraint? . -> . exact-nonnegative-integer?) @@ -346,24 +346,24 @@ ;; we also want to use "singleton" vars (that is, vars that have been reduced to a single domain value by forward checking) (define singleton-varnames (for/list ([var (in-vars csp)] #:when (singleton-var? var)) - (var-name var))) + (var-name var))) (define-values (checkable-constraints other-constraints) (partition (λ (c) (and (constraint-checkable? c singleton-varnames) (if mandatory-names (for/and ([name (in-list mandatory-names)]) - (constraint-relates? c name)) + (constraint-relates? c name)) #true))) (constraints csp))) (cond [conflict-count? (define conflict-count (for/sum ([constraint (in-list checkable-constraints)] #:unless (constraint csp)) - 1)) + 1)) (when-debug (set! nchecks (+ conflict-count nchecks))) conflict-count] [else (for ([(constraint idx) (in-indexed (sort checkable-constraints < #:key constraint-arity))] #:unless (constraint csp)) - (when-debug (set! nchecks (+ (add1 idx) nchecks))) - (backtrack!)) + (when-debug (set! nchecks (+ (add1 idx) nchecks))) + (backtrack!)) ;; discard checked constraints, since they have no further reason to live (make-csp (vars csp) other-constraints)])) @@ -372,15 +372,15 @@ ;; todo: why does this function slow down searches? (make-csp (for/list ([var (in-vars csp)]) - (match-define ($var name vals) var) - (define procs (for*/list ([constraint (in-constraints csp)] - [cnames (in-value ($constraint-names constraint))] - #:when (and (= 1 (length cnames)) (eq? name (car cnames)))) - ($constraint-proc constraint))) - ($var name - (for*/fold ([vals vals]) - ([proc (in-list procs)]) - (filter proc vals)))) + (match-define ($var name vals) var) + (define procs (for*/list ([constraint (in-constraints csp)] + [cnames (in-value ($constraint-names constraint))] + #:when (and (= 1 (length cnames)) (eq? name (car cnames)))) + ($constraint-proc constraint))) + ($var name + (for*/fold ([vals vals]) + ([proc (in-list procs)]) + (filter proc vals)))) (constraints csp))) (define/contract (backtracking-solver @@ -412,8 +412,10 @@ (loop csp))) conflicts)])))) +(define (random-pick xs) + (list-ref xs (random (length xs)))) -(define/contract (min-conflicts csp [max-steps 64]) +(define/contract (min-conflicts csp [max-steps 100]) (($csp?) (integer?) . ->* . generator?) ;; Solve a CSP by stochastic hillclimbing on the number of conflicts. (generator () @@ -421,31 +423,34 @@ ;; Generate a complete assignment for all variables (probably with conflicts) (define starting-assignment (for/fold ([csp csp0]) - ([var (in-vars csp0)]) - (define name (var-name var)) - (assign-val csp name (first (shuffle ($csp-vals csp0 name)))))) + ([var (in-vars csp0)]) + (define name (var-name var)) + (assign-val csp name (random-pick ($csp-vals csp0 name))))) ;; Now repeatedly choose a random conflicted variable and change it (for/fold ([csp starting-assignment]) ([i (in-range max-steps)]) (match (conflicted-var-names csp) - [(? empty?) (when (check-constraints csp) (yield csp)) (loop csp0)] - [cvar-names - (define cvar-name (first ((if (current-shuffle) shuffle values) cvar-names))) - (define val (min-conflicts-value csp cvar-name ($csp-vals csp0 cvar-name))) - (assign-val csp cvar-name val)])) - (loop csp0)))) + [(? empty?) (yield csp) (loop csp0)] + [names + (define name (random-pick names)) + (define val (min-conflicts-value csp name ($csp-vals csp0 name))) + (assign-val csp name val)]))))) (define/contract (conflicted-var-names csp) ($csp? . -> . (listof name?)) ;; Return a list of variables in current assignment that are conflicted (for/list ([name (in-var-names csp)] #:when (positive? (nconflicts csp name))) - name)) + name)) (define/contract (min-conflicts-value csp name vals) ($csp? name? (listof any/c) . -> . any/c) ;; Return the value that will give var the least number of conflicts - (argmin (λ (val) (nconflicts csp name val)) (shuffle vals))) + (define vals-by-conflict (sort vals < #:key (λ (val) (nconflicts csp name val)) + #:cache-keys? #true)) + (for/first ([val (in-list vals-by-conflict)] + #:unless (equal? val (first ($csp-vals csp name)))) + val)) (define no-value-sig (gensym)) @@ -459,8 +464,8 @@ (define/contract (csp->assocs csp) (csp? . -> . (listof (cons/c name? any/c))) (for/list ([var (in-vars csp)]) - (match var - [($var name domain) (cons name (first domain))]))) + (match var + [($var name domain) (cons name (first domain))]))) (define/contract (solve* csp #:finish-proc [finish-proc csp->assocs] @@ -473,7 +478,7 @@ (reset-nchecks!)) (for/list ([solution (in-producer (solver csp) (void))] [idx (in-range max-solutions)]) - (finish-proc solution))) + (finish-proc solution))) (define/contract (solve csp #:finish-proc [finish-proc csp->assocs] From 4896a2b7e460286e65f0e0a0af096df8378c3b4e Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Sun, 21 Oct 2018 10:52:15 -0700 Subject: [PATCH 167/246] threaded --- csp/hacs-test-workbench.rkt | 32 ++++++++++++++-------------- csp/hacs.rkt | 42 ++++++++++++++++++++++--------------- 2 files changed, 41 insertions(+), 33 deletions(-) diff --git a/csp/hacs-test-workbench.rkt b/csp/hacs-test-workbench.rkt index 55faea1c..d8d6663e 100644 --- a/csp/hacs-test-workbench.rkt +++ b/csp/hacs-test-workbench.rkt @@ -9,23 +9,23 @@ ;; queens problem ;; place queens on chessboard so they do not intersect -(define board-size 8) +(define board-size 12) - (define queens (make-csp)) - (define qs (for/list ([q board-size]) (string->symbol (format "q~a" q)))) - (define rows (range (length qs))) - (add-vars! queens qs rows) - (define (q-col q) (string->number (string-trim (symbol->string q) "q"))) - (for* ([qs (in-combinations qs 2)]) - (match-define (list qa qb) qs) - (match-define (list qa-col qb-col) (map q-col qs)) - (add-constraint! queens - (λ (qa-row qb-row) - (nor - (= (abs (- qa-row qb-row)) (abs (- qa-col qb-col))) ; same diagonal? - (= qa-row qb-row))) ; same row? - (list qa qb))) +(define queens (make-csp)) +(define qs (for/list ([q board-size]) (string->symbol (format "q~a" q)))) +(define rows (range (length qs))) +(add-vars! queens qs rows) +(define (q-col q) (string->number (string-trim (symbol->string q) "q"))) +(for* ([qs (in-combinations qs 2)]) + (match-define (list qa qb) qs) + (match-define (list qa-col qb-col) (map q-col qs)) + (add-constraint! queens + (λ (qa-row qb-row) + (nor + (= (abs (- qa-row qb-row)) (abs (- qa-col qb-col))) ; same diagonal? + (= qa-row qb-row))) ; same row? + (list qa qb))) -(time-avg 10 (solve queens)) +#;(time-avg 10 (solve queens)) (parameterize ([current-solver min-conflicts]) (time-named (solve queens))) \ No newline at end of file diff --git a/csp/hacs.rkt b/csp/hacs.rkt index 36042e0b..78ee3fd9 100644 --- a/csp/hacs.rkt +++ b/csp/hacs.rkt @@ -415,26 +415,34 @@ (define (random-pick xs) (list-ref xs (random (length xs)))) +(define (assign-random-vals csp) + (for/fold ([new-csp csp]) + ([name (in-var-names csp)]) + (assign-val new-csp name (random-pick ($csp-vals csp name))))) + +(define (make-min-conflcts-thread csp0 max-steps [main-thread (current-thread)]) + (thread + (λ () + ;; Generate a complete assignment for all variables (probably with conflicts) + (for/fold ([csp (assign-random-vals csp0)]) + ([nth-step (in-range max-steps)]) + ;; Now repeatedly choose a random conflicted variable and change it + (match (conflicted-var-names csp) + [(? empty?) (thread-send main-thread csp) csp] + [names + (define name (random-pick names)) + (define val (min-conflicts-value csp name ($csp-vals csp0 name))) + (assign-val csp name val)]))))) + (define/contract (min-conflicts csp [max-steps 100]) (($csp?) (integer?) . ->* . generator?) - ;; Solve a CSP by stochastic hillclimbing on the number of conflicts. + ;; Solve a CSP by stochastic hillclimbing on the number of conflicts. (generator () - (let loop ([csp0 csp]) - ;; Generate a complete assignment for all variables (probably with conflicts) - (define starting-assignment - (for/fold ([csp csp0]) - ([var (in-vars csp0)]) - (define name (var-name var)) - (assign-val csp name (random-pick ($csp-vals csp0 name))))) - ;; Now repeatedly choose a random conflicted variable and change it - (for/fold ([csp starting-assignment]) - ([i (in-range max-steps)]) - (match (conflicted-var-names csp) - [(? empty?) (yield csp) (loop csp0)] - [names - (define name (random-pick names)) - (define val (min-conflicts-value csp name ($csp-vals csp0 name))) - (assign-val csp name val)]))))) + (for ([thread-count 4]) ; todo: what is ideal thread quantity? + (make-min-conflcts-thread csp max-steps)) + (let loop () + (yield (thread-receive)) + (loop)))) (define/contract (conflicted-var-names csp) ($csp? . -> . (listof name?)) From 43a30be843dac78cd7ccd1c6aee78e05ca9faa30 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Sun, 21 Oct 2018 11:13:11 -0700 Subject: [PATCH 168/246] we'll see --- csp/hacs-test-workbench.rkt | 4 ++-- csp/hacs.rkt | 17 +++++++++-------- 2 files changed, 11 insertions(+), 10 deletions(-) diff --git a/csp/hacs-test-workbench.rkt b/csp/hacs-test-workbench.rkt index d8d6663e..6d3194e9 100644 --- a/csp/hacs-test-workbench.rkt +++ b/csp/hacs-test-workbench.rkt @@ -9,7 +9,7 @@ ;; queens problem ;; place queens on chessboard so they do not intersect -(define board-size 12) +(define board-size 8) (define queens (make-csp)) (define qs (for/list ([q board-size]) (string->symbol (format "q~a" q)))) @@ -26,6 +26,6 @@ (= qa-row qb-row))) ; same row? (list qa qb))) -#;(time-avg 10 (solve queens)) +(time-avg 10 (solve queens)) (parameterize ([current-solver min-conflicts]) (time-named (solve queens))) \ No newline at end of file diff --git a/csp/hacs.rkt b/csp/hacs.rkt index 78ee3fd9..40d7561d 100644 --- a/csp/hacs.rkt +++ b/csp/hacs.rkt @@ -175,7 +175,7 @@ (make-csp (vars csp) (for/list ([constraint (in-constraints csp)]) (cond - [(and (if minimum-arity (<= minimum-arity (constraint-arity constraint)) #true) + [(and (or (not minimum-arity) (<= minimum-arity (constraint-arity constraint))) (partially-assigned? constraint)) (match-define ($constraint cnames proc) constraint) ($constraint (filter-not assigned-name? cnames) @@ -327,6 +327,8 @@ (define/contract (constraint-checkable? c names) ($constraint? (listof name?) . -> . any/c) + ;; constraint is checkable if all constraint names + ;; are in target list of names. (for/and ([cname (in-list ($constraint-names c))]) (memq cname names))) @@ -349,10 +351,10 @@ (var-name var))) (define-values (checkable-constraints other-constraints) (partition (λ (c) (and (constraint-checkable? c singleton-varnames) - (if mandatory-names + (or (not mandatory-names) (for/and ([name (in-list mandatory-names)]) - (constraint-relates? c name)) - #true))) (constraints csp))) + (constraint-relates? c name))))) + (constraints csp))) (cond [conflict-count? (define conflict-count (for/sum ([constraint (in-list checkable-constraints)] @@ -440,9 +442,8 @@ (generator () (for ([thread-count 4]) ; todo: what is ideal thread quantity? (make-min-conflcts-thread csp max-steps)) - (let loop () - (yield (thread-receive)) - (loop)))) + (for ([i (in-naturals)]) + (yield (thread-receive))))) (define/contract (conflicted-var-names csp) ($csp? . -> . (listof name?)) @@ -457,7 +458,7 @@ (define vals-by-conflict (sort vals < #:key (λ (val) (nconflicts csp name val)) #:cache-keys? #true)) (for/first ([val (in-list vals-by-conflict)] - #:unless (equal? val (first ($csp-vals csp name)))) + #:unless (equal? val (first ($csp-vals csp name)))) ;; but change the value val)) (define no-value-sig (gensym)) From d21e5c171bfffc8fddc604dc17280a3342bf3d27 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Sun, 21 Oct 2018 11:49:34 -0700 Subject: [PATCH 169/246] nitwittery --- csp/hacs-test-workbench.rkt | 9 +++---- csp/hacs.rkt | 51 ++++++++++++++++++++++--------------- 2 files changed, 34 insertions(+), 26 deletions(-) diff --git a/csp/hacs-test-workbench.rkt b/csp/hacs-test-workbench.rkt index 6d3194e9..df69806d 100644 --- a/csp/hacs-test-workbench.rkt +++ b/csp/hacs-test-workbench.rkt @@ -21,11 +21,10 @@ (match-define (list qa-col qb-col) (map q-col qs)) (add-constraint! queens (λ (qa-row qb-row) - (nor - (= (abs (- qa-row qb-row)) (abs (- qa-col qb-col))) ; same diagonal? - (= qa-row qb-row))) ; same row? - (list qa qb))) + (not (= (abs (- qa-row qb-row)) (abs (- (q-col qa) (q-col qb)))))) ; same diag? + (list qa qb)) + (add-constraint! queens (negate =) (list qa qb))) (time-avg 10 (solve queens)) -(parameterize ([current-solver min-conflicts]) +(parameterize ([current-solver min-conflicts-solver]) (time-named (solve queens))) \ No newline at end of file diff --git a/csp/hacs.rkt b/csp/hacs.rkt index 40d7561d..e514c987 100644 --- a/csp/hacs.rkt +++ b/csp/hacs.rkt @@ -250,9 +250,13 @@ [(list winning-uvar) winning-uvar] [(list mrv-uvars ...) ;; use degree as tiebreaker for mrv - (define max-degree-arg (argmax (λ (var) (var-degree csp var)) mrv-uvars)) + (define degrees (map (λ (var) (var-degree csp var)) mrv-uvars)) + (define max-degree (apply max degrees)) ;; use random tiebreaker for degree - (random-pick (filter (λ (var) (= (var-degree csp max-degree-arg) (var-degree csp var))) mrv-uvars))])])) + (random-pick (for/list ([var (in-list mrv-uvars)] + [degree (in-list degrees)] + #:when (= max-degree degree)) + var))])])) (define first-domain-value values) @@ -422,26 +426,27 @@ ([name (in-var-names csp)]) (assign-val new-csp name (random-pick ($csp-vals csp name))))) -(define (make-min-conflcts-thread csp0 max-steps [main-thread (current-thread)]) +(define (make-min-conflcts-thread csp0 thread-count max-steps [main-thread (current-thread)]) (thread (λ () - ;; Generate a complete assignment for all variables (probably with conflicts) - (for/fold ([csp (assign-random-vals csp0)]) - ([nth-step (in-range max-steps)]) - ;; Now repeatedly choose a random conflicted variable and change it - (match (conflicted-var-names csp) - [(? empty?) (thread-send main-thread csp) csp] - [names - (define name (random-pick names)) - (define val (min-conflicts-value csp name ($csp-vals csp0 name))) - (assign-val csp name val)]))))) - -(define/contract (min-conflicts csp [max-steps 100]) + (let loop () + ;; Generate a complete assignment for all variables (probably with conflicts) + (for/fold ([csp (assign-random-vals csp0)]) + ([nth-step (in-range max-steps)]) + ;; Now repeatedly choose a random conflicted variable and change it + (match (conflicted-var-names csp) + [(? empty?) (thread-send main-thread csp) (loop)] + [names + (define name (random-pick names)) + (define val (min-conflicts-value csp name ($csp-vals csp0 name))) + (assign-val csp name val)])))))) + +(define/contract (min-conflicts-solver csp [max-steps 100]) (($csp?) (integer?) . ->* . generator?) ;; Solve a CSP by stochastic hillclimbing on the number of conflicts. (generator () - (for ([thread-count 4]) ; todo: what is ideal thread quantity? - (make-min-conflcts-thread csp max-steps)) + (for ([thread-count 4]) ; todo: what is ideal thread count? + (make-min-conflcts-thread csp thread-count max-steps)) (for ([i (in-naturals)]) (yield (thread-receive))))) @@ -480,7 +485,8 @@ #:finish-proc [finish-proc csp->assocs] #:solver [solver (or (current-solver) backtracking-solver)] #:limit [max-solutions +inf.0]) - ((csp?) (#:finish-proc procedure? #:solver procedure? #:limit integer?) . ->* . (listof any/c)) + ((csp?) (#:finish-proc procedure? #:solver procedure? #:limit exact-nonnegative-integer?) + . ->* . (listof any/c)) (when-debug (reset-assns!) (reset-nfcs!) @@ -491,10 +497,13 @@ (define/contract (solve csp #:finish-proc [finish-proc csp->assocs] - #:solver [solver (or (current-solver) backtracking-solver)]) - ((csp?) (#:finish-proc procedure? #:solver procedure?) . ->* . (or/c #false any/c)) - (match (solve* csp #:finish-proc finish-proc #:solver solver #:limit 1) + #:solver [solver (or (current-solver) backtracking-solver)] + #:limit [max-solutions 1]) + ((csp?) (#:finish-proc procedure? #:solver procedure? #:limit exact-nonnegative-integer?) + . ->* . (or/c #false any/c)) + (match (solve* csp #:finish-proc finish-proc #:solver solver #:limit max-solutions) [(list solution) solution] + [(list solutions ...) solutions] [else #false])) (define (<> a b) (not (= a b))) From 586d99ec07f928af63f38fa1db0e437922c0d0bb Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Sun, 21 Oct 2018 13:31:22 -0700 Subject: [PATCH 170/246] decomp (broken) --- csp/hacs.rkt | 40 ++++++++++++++++++++++++++++++++++------ 1 file changed, 34 insertions(+), 6 deletions(-) diff --git a/csp/hacs.rkt b/csp/hacs.rkt index e514c987..d5ba1d6c 100644 --- a/csp/hacs.rkt +++ b/csp/hacs.rkt @@ -479,7 +479,34 @@ (csp? . -> . (listof (cons/c name? any/c))) (for/list ([var (in-vars csp)]) (match var - [($var name domain) (cons name (first domain))]))) + [($var name (list val)) (cons name val)]))) + +(define/contract (combine-csps csps) + ((listof $csp?) . -> . $csp?) + (make-csp + (apply append (map $csp-vars csps)) + (apply append (map $csp-constraints csps)))) + +(define/contract (make-cartesian-generator solgens) + ((listof generator?) . -> . generator?) + (generator () + (let loop ([solgens solgens][sols empty]) + (cond + [(empty? solgens) (yield (combine-csps (reverse sols)))] + [else (match-define (cons solgen others) solgens) + (for ([sol (in-producer solgen (void))]) + (loop others (cons sol sols)))])))) + +(define/contract (extract-subcsp csp names) + ($csp? (listof name?) . -> . $csp?) + (make-csp + (for/list ([var (in-vars csp)] + #:when (memq (var-name var) names)) + var) + (for/list ([constraint (in-constraints csp)] + #:when (for/and ([cname (in-list ($constraint-names constraint))]) + (memq cname names))) + constraint))) (define/contract (solve* csp #:finish-proc [finish-proc csp->assocs] @@ -487,11 +514,12 @@ #:limit [max-solutions +inf.0]) ((csp?) (#:finish-proc procedure? #:solver procedure? #:limit exact-nonnegative-integer?) . ->* . (listof any/c)) - (when-debug - (reset-assns!) - (reset-nfcs!) - (reset-nchecks!)) - (for/list ([solution (in-producer (solver csp) (void))] + (when-debug (reset-assns!) (reset-nfcs!) (reset-nchecks!)) + + (define subproblems (for/list ([nodeset (in-list (cc (csp->graph csp)))]) + (extract-subcsp csp nodeset))) + + (for/list ([solution (in-producer (make-cartesian-generator (map solver subproblems)) (void))] [idx (in-range max-solutions)]) (finish-proc solution))) From 7d76fc138486c268f85f91afc5224bc33eeabb2c Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Sun, 21 Oct 2018 14:08:14 -0700 Subject: [PATCH 171/246] wham --- csp/hacs-map.rkt | 6 +++--- csp/hacs.rkt | 29 ++++++++++++++++++++--------- 2 files changed, 23 insertions(+), 12 deletions(-) diff --git a/csp/hacs-map.rkt b/csp/hacs-map.rkt index f0c77ef0..34450098 100644 --- a/csp/hacs-map.rkt +++ b/csp/hacs-map.rkt @@ -1,7 +1,8 @@ #lang debug racket -(require "hacs.rkt") +(require "hacs.rkt" sugar/debug) (module+ test (require rackunit)) + (define (map-coloring-csp colors neighbors) (define variables (remove-duplicates (flatten neighbors) eq?)) (define vds (for/list ([var (in-list variables)]) @@ -55,5 +56,4 @@ (module+ test (check-true (pair? (solve fr)))) -(module+ main - (solve aus)) \ No newline at end of file +(module+ main) \ No newline at end of file diff --git a/csp/hacs.rkt b/csp/hacs.rkt index d5ba1d6c..26f92106 100644 --- a/csp/hacs.rkt +++ b/csp/hacs.rkt @@ -118,6 +118,7 @@ (define current-inference (make-parameter #f)) (define current-solver (make-parameter #f)) (define current-random (make-parameter #t)) +(define current-decompose (make-parameter #t)) (define/contract (check-name-in-csp! caller csp name) (symbol? csp? name? . -> . void?) @@ -490,12 +491,19 @@ (define/contract (make-cartesian-generator solgens) ((listof generator?) . -> . generator?) (generator () - (let loop ([solgens solgens][sols empty]) - (cond - [(empty? solgens) (yield (combine-csps (reverse sols)))] - [else (match-define (cons solgen others) solgens) - (for ([sol (in-producer solgen (void))]) - (loop others (cons sol sols)))])))) + (define solcache (make-hasheqv)) + (let loop ([solgens solgens][idx 0][sols empty]) + (match solgens + [(? empty?) (yield (combine-csps (reverse sols)))] + [(cons solgen rest) + (cond + [(eq? (generator-state solgen) 'done) + (for ([sol (in-list (reverse (hash-ref solcache idx)))]) + (loop rest (add1 idx) (cons sol sols)))] + [else + (for ([sol (in-producer solgen (void))]) + (hash-update! solcache idx (λ (vals) (cons sol vals)) null) + (loop rest (add1 idx) (cons sol sols)))])])))) (define/contract (extract-subcsp csp names) ($csp? (listof name?) . -> . $csp?) @@ -516,10 +524,13 @@ . ->* . (listof any/c)) (when-debug (reset-assns!) (reset-nfcs!) (reset-nchecks!)) - (define subproblems (for/list ([nodeset (in-list (cc (csp->graph csp)))]) - (extract-subcsp csp nodeset))) + (define subcsps ; decompose into independent csps. `cc` determines "connected components" + (if (current-decompose) + (for/list ([nodeset (in-list (cc (csp->graph csp)))]) + (extract-subcsp csp nodeset)) + (list csp))) - (for/list ([solution (in-producer (make-cartesian-generator (map solver subproblems)) (void))] + (for/list ([solution (in-producer (make-cartesian-generator (map solver subcsps)) (void))] [idx (in-range max-solutions)]) (finish-proc solution))) From 5840ef1cc89ad7eb2e18f1d06a8e0aaa5e1f6848 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Sun, 21 Oct 2018 17:16:44 -0700 Subject: [PATCH 172/246] dreamy streamy --- csp/hacs.rkt | 21 ++++++++------------- 1 file changed, 8 insertions(+), 13 deletions(-) diff --git a/csp/hacs.rkt b/csp/hacs.rkt index 26f92106..23a2cc84 100644 --- a/csp/hacs.rkt +++ b/csp/hacs.rkt @@ -491,19 +491,14 @@ (define/contract (make-cartesian-generator solgens) ((listof generator?) . -> . generator?) (generator () - (define solcache (make-hasheqv)) - (let loop ([solgens solgens][idx 0][sols empty]) - (match solgens - [(? empty?) (yield (combine-csps (reverse sols)))] - [(cons solgen rest) - (cond - [(eq? (generator-state solgen) 'done) - (for ([sol (in-list (reverse (hash-ref solcache idx)))]) - (loop rest (add1 idx) (cons sol sols)))] - [else - (for ([sol (in-producer solgen (void))]) - (hash-update! solcache idx (λ (vals) (cons sol vals)) null) - (loop rest (add1 idx) (cons sol sols)))])])))) + (define solstreams (for/list ([solgen (in-list solgens)]) + (for/stream ([sol (in-producer solgen (void))]) + sol))) + (let loop ([solstreams solstreams][sols empty]) + (if (null? solstreams) + (yield (combine-csps (reverse sols))) + (for ([sol (in-stream (car solstreams))]) + (loop (cdr solstreams) (cons sol sols))))))) (define/contract (extract-subcsp csp names) ($csp? (listof name?) . -> . $csp?) From fe283510e92d1bee537e32e3bf0af8e91fce069a Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Sun, 21 Oct 2018 23:29:09 -0700 Subject: [PATCH 173/246] over --- csp/hacs-test-workbench.rkt | 3 ++- csp/hacs.rkt | 20 ++++++++++++++++---- 2 files changed, 18 insertions(+), 5 deletions(-) diff --git a/csp/hacs-test-workbench.rkt b/csp/hacs-test-workbench.rkt index df69806d..e8a05ca8 100644 --- a/csp/hacs-test-workbench.rkt +++ b/csp/hacs-test-workbench.rkt @@ -25,6 +25,7 @@ (list qa qb)) (add-constraint! queens (negate =) (list qa qb))) +(current-multithreaded #t) (time-avg 10 (solve queens)) (parameterize ([current-solver min-conflicts-solver]) - (time-named (solve queens))) \ No newline at end of file + (time-avg 10 (solve queens))) \ No newline at end of file diff --git a/csp/hacs.rkt b/csp/hacs.rkt index 23a2cc84..b9b85cbc 100644 --- a/csp/hacs.rkt +++ b/csp/hacs.rkt @@ -119,6 +119,7 @@ (define current-solver (make-parameter #f)) (define current-random (make-parameter #t)) (define current-decompose (make-parameter #t)) +(define current-multithreaded (make-parameter #t)) (define/contract (check-name-in-csp! caller csp name) (symbol? csp? name? . -> . void?) @@ -446,7 +447,7 @@ (($csp?) (integer?) . ->* . generator?) ;; Solve a CSP by stochastic hillclimbing on the number of conflicts. (generator () - (for ([thread-count 4]) ; todo: what is ideal thread count? + (for ([thread-count (if (current-multithreaded) 4 1)]) ; todo: what is ideal thread count? (make-min-conflcts-thread csp thread-count max-steps)) (for ([i (in-naturals)]) (yield (thread-receive))))) @@ -457,10 +458,21 @@ (for/list ([name (in-var-names csp)] #:when (positive? (nconflicts csp name))) name)) + +(define/contract (optimal-stop-min proc xs) + (procedure? (listof any/c) . -> . any/c) + (define-values (sample candidates) (split-at xs (inexact->exact (floor (* .458 (length xs)))))) + (define threshold (argmin proc sample)) + (or (for/first ([c (in-list candidates)] + #:when (<= (proc c) threshold)) + c) + (last candidates))) + (define/contract (min-conflicts-value csp name vals) ($csp? name? (listof any/c) . -> . any/c) ;; Return the value that will give var the least number of conflicts + #;(optimal-stop-min (λ (val) (nconflicts csp name val)) vals) (define vals-by-conflict (sort vals < #:key (λ (val) (nconflicts csp name val)) #:cache-keys? #true)) (for/first ([val (in-list vals-by-conflict)] @@ -492,13 +504,13 @@ ((listof generator?) . -> . generator?) (generator () (define solstreams (for/list ([solgen (in-list solgens)]) - (for/stream ([sol (in-producer solgen (void))]) - sol))) + (for/stream ([sol (in-producer solgen (void))]) + sol))) (let loop ([solstreams solstreams][sols empty]) (if (null? solstreams) (yield (combine-csps (reverse sols))) (for ([sol (in-stream (car solstreams))]) - (loop (cdr solstreams) (cons sol sols))))))) + (loop (cdr solstreams) (cons sol sols))))))) (define/contract (extract-subcsp csp names) ($csp? (listof name?) . -> . $csp?) From d418d1ca0c638f7e2eb97f4ad7b45210a264ca1a Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Mon, 22 Oct 2018 16:20:14 -0700 Subject: [PATCH 174/246] motion --- csp/{ => csp}/aima-queens.rkt | 0 csp/{ => csp}/aima-smm.rkt | 0 csp/{ => csp}/aima-sum.rkt | 0 csp/{ => csp}/aima.rkt | 0 csp/{ => csp}/csp-test-etc.rkt | 0 csp/{ => csp}/csp-test-problems.rkt | 0 csp/{ => csp}/csp-test.rkt | 0 csp/{ => csp}/csp.rkt | 0 csp/{ => csp}/hacs-map.rkt | 0 csp/{ => csp}/hacs-smm.rkt | 0 csp/csp/hacs-test-workbench.rkt | 30 + csp/{ => csp}/hacs-test.rkt | 0 csp/csp/hacs.rkt | 545 ++++++++++++++++++ csp/{ => csp}/main.rkt | 0 csp/{ => csp}/port/constraint.rkt | 0 csp/{ => csp}/port/domain.rkt | 0 csp/{ => csp}/port/helper.rkt | 0 csp/{ => csp}/port/main.rkt | 0 csp/{ => csp}/port/problem.rkt | 0 csp/{ => csp}/port/solver.rkt | 0 csp/{ => csp}/port/test-classes.rkt | 0 csp/{ => csp}/port/test-einstein.rkt | 0 csp/{ => csp}/port/test-problems.rkt | 0 csp/{ => csp}/port/variable.rkt | 0 .../API Documentation.webloc | 0 csp/{ => csp}/python-constraint/LICENSE | 0 csp/{ => csp}/python-constraint/MANIFEST.in | 0 csp/{ => csp}/python-constraint/PKG-INFO | 0 csp/{ => csp}/python-constraint/README | 0 csp/{ => csp}/python-constraint/constraint.py | 0 .../python-constraint/examples/abc/abc.py | 0 .../python-constraint/examples/coins/coins.py | 0 .../examples/crosswords/crosswords.py | 0 .../examples/crosswords/large.mask | 0 .../examples/crosswords/medium.mask | 0 .../examples/crosswords/python.mask | 0 .../examples/crosswords/small.mask | 0 .../examples/einstein/einstein.py | 0 .../examples/einstein/einstein2.py | 0 .../examples/queens/queens.py | 0 .../python-constraint/examples/rooks/rooks.py | 0 .../examples/studentdesks/studentdesks.py | 0 .../examples/sudoku/sudoku.py | 0 .../examples/wordmath/seisseisdoze.py | 0 .../examples/wordmath/sendmoremoney.py | 0 .../examples/wordmath/twotwofour.py | 0 .../python-constraint/examples/xsum/xsum.py | 0 csp/{ => csp}/python-constraint/setup.cfg | 0 csp/{ => csp}/python-constraint/setup.py | 0 .../python-constraint/testconstraint.py | 0 .../python-constraint/trials/abcd.py | 0 .../python-constraint/trials/coins.py | 0 .../python-constraint/trials/constraint.py | 0 .../python-constraint/trials/crosswords.py | 0 .../python-constraint/trials/einstein.py | 0 .../python-constraint/trials/einstein2.py | 0 .../python-constraint/trials/large.mask | 0 .../python-constraint/trials/medium.mask | 0 .../python-constraint/trials/python.mask | 0 .../python-constraint/trials/queens.py | 0 .../python-constraint/trials/rooks.py | 0 .../python-constraint/trials/seisseisdoze.py | 0 .../python-constraint/trials/sendmoremoney.py | 0 .../python-constraint/trials/small.mask | 0 .../python-constraint/trials/studentdesks.py | 0 .../python-constraint/trials/sudoku.py | 0 .../python-constraint/trials/twotwofour.py | 0 .../python-constraint/trials/xsum.py | 0 csp/csp/scribblings/csp.scrbl | 31 + csp/info.rkt | 7 +- 70 files changed, 609 insertions(+), 4 deletions(-) rename csp/{ => csp}/aima-queens.rkt (100%) rename csp/{ => csp}/aima-smm.rkt (100%) rename csp/{ => csp}/aima-sum.rkt (100%) rename csp/{ => csp}/aima.rkt (100%) rename csp/{ => csp}/csp-test-etc.rkt (100%) rename csp/{ => csp}/csp-test-problems.rkt (100%) rename csp/{ => csp}/csp-test.rkt (100%) rename csp/{ => csp}/csp.rkt (100%) rename csp/{ => csp}/hacs-map.rkt (100%) rename csp/{ => csp}/hacs-smm.rkt (100%) create mode 100644 csp/csp/hacs-test-workbench.rkt rename csp/{ => csp}/hacs-test.rkt (100%) create mode 100644 csp/csp/hacs.rkt rename csp/{ => csp}/main.rkt (100%) rename csp/{ => csp}/port/constraint.rkt (100%) rename csp/{ => csp}/port/domain.rkt (100%) rename csp/{ => csp}/port/helper.rkt (100%) rename csp/{ => csp}/port/main.rkt (100%) rename csp/{ => csp}/port/problem.rkt (100%) rename csp/{ => csp}/port/solver.rkt (100%) rename csp/{ => csp}/port/test-classes.rkt (100%) rename csp/{ => csp}/port/test-einstein.rkt (100%) rename csp/{ => csp}/port/test-problems.rkt (100%) rename csp/{ => csp}/port/variable.rkt (100%) rename csp/{ => csp}/python-constraint/API Documentation.webloc (100%) rename csp/{ => csp}/python-constraint/LICENSE (100%) rename csp/{ => csp}/python-constraint/MANIFEST.in (100%) rename csp/{ => csp}/python-constraint/PKG-INFO (100%) rename csp/{ => csp}/python-constraint/README (100%) rename csp/{ => csp}/python-constraint/constraint.py (100%) rename csp/{ => csp}/python-constraint/examples/abc/abc.py (100%) rename csp/{ => csp}/python-constraint/examples/coins/coins.py (100%) rename csp/{ => csp}/python-constraint/examples/crosswords/crosswords.py (100%) rename csp/{ => csp}/python-constraint/examples/crosswords/large.mask (100%) rename csp/{ => csp}/python-constraint/examples/crosswords/medium.mask (100%) rename csp/{ => csp}/python-constraint/examples/crosswords/python.mask (100%) rename csp/{ => csp}/python-constraint/examples/crosswords/small.mask (100%) rename csp/{ => csp}/python-constraint/examples/einstein/einstein.py (100%) rename csp/{ => csp}/python-constraint/examples/einstein/einstein2.py (100%) rename csp/{ => csp}/python-constraint/examples/queens/queens.py (100%) rename csp/{ => csp}/python-constraint/examples/rooks/rooks.py (100%) rename csp/{ => csp}/python-constraint/examples/studentdesks/studentdesks.py (100%) rename csp/{ => csp}/python-constraint/examples/sudoku/sudoku.py (100%) rename csp/{ => csp}/python-constraint/examples/wordmath/seisseisdoze.py (100%) rename csp/{ => csp}/python-constraint/examples/wordmath/sendmoremoney.py (100%) rename csp/{ => csp}/python-constraint/examples/wordmath/twotwofour.py (100%) rename csp/{ => csp}/python-constraint/examples/xsum/xsum.py (100%) rename csp/{ => csp}/python-constraint/setup.cfg (100%) rename csp/{ => csp}/python-constraint/setup.py (100%) rename csp/{ => csp}/python-constraint/testconstraint.py (100%) rename csp/{ => csp}/python-constraint/trials/abcd.py (100%) rename csp/{ => csp}/python-constraint/trials/coins.py (100%) rename csp/{ => csp}/python-constraint/trials/constraint.py (100%) rename csp/{ => csp}/python-constraint/trials/crosswords.py (100%) rename csp/{ => csp}/python-constraint/trials/einstein.py (100%) rename csp/{ => csp}/python-constraint/trials/einstein2.py (100%) rename csp/{ => csp}/python-constraint/trials/large.mask (100%) rename csp/{ => csp}/python-constraint/trials/medium.mask (100%) rename csp/{ => csp}/python-constraint/trials/python.mask (100%) rename csp/{ => csp}/python-constraint/trials/queens.py (100%) rename csp/{ => csp}/python-constraint/trials/rooks.py (100%) rename csp/{ => csp}/python-constraint/trials/seisseisdoze.py (100%) rename csp/{ => csp}/python-constraint/trials/sendmoremoney.py (100%) rename csp/{ => csp}/python-constraint/trials/small.mask (100%) rename csp/{ => csp}/python-constraint/trials/studentdesks.py (100%) rename csp/{ => csp}/python-constraint/trials/sudoku.py (100%) rename csp/{ => csp}/python-constraint/trials/twotwofour.py (100%) rename csp/{ => csp}/python-constraint/trials/xsum.py (100%) create mode 100644 csp/csp/scribblings/csp.scrbl diff --git a/csp/aima-queens.rkt b/csp/csp/aima-queens.rkt similarity index 100% rename from csp/aima-queens.rkt rename to csp/csp/aima-queens.rkt diff --git a/csp/aima-smm.rkt b/csp/csp/aima-smm.rkt similarity index 100% rename from csp/aima-smm.rkt rename to csp/csp/aima-smm.rkt diff --git a/csp/aima-sum.rkt b/csp/csp/aima-sum.rkt similarity index 100% rename from csp/aima-sum.rkt rename to csp/csp/aima-sum.rkt diff --git a/csp/aima.rkt b/csp/csp/aima.rkt similarity index 100% rename from csp/aima.rkt rename to csp/csp/aima.rkt diff --git a/csp/csp-test-etc.rkt b/csp/csp/csp-test-etc.rkt similarity index 100% rename from csp/csp-test-etc.rkt rename to csp/csp/csp-test-etc.rkt diff --git a/csp/csp-test-problems.rkt b/csp/csp/csp-test-problems.rkt similarity index 100% rename from csp/csp-test-problems.rkt rename to csp/csp/csp-test-problems.rkt diff --git a/csp/csp-test.rkt b/csp/csp/csp-test.rkt similarity index 100% rename from csp/csp-test.rkt rename to csp/csp/csp-test.rkt diff --git a/csp/csp.rkt b/csp/csp/csp.rkt similarity index 100% rename from csp/csp.rkt rename to csp/csp/csp.rkt diff --git a/csp/hacs-map.rkt b/csp/csp/hacs-map.rkt similarity index 100% rename from csp/hacs-map.rkt rename to csp/csp/hacs-map.rkt diff --git a/csp/hacs-smm.rkt b/csp/csp/hacs-smm.rkt similarity index 100% rename from csp/hacs-smm.rkt rename to csp/csp/hacs-smm.rkt diff --git a/csp/csp/hacs-test-workbench.rkt b/csp/csp/hacs-test-workbench.rkt new file mode 100644 index 00000000..df69806d --- /dev/null +++ b/csp/csp/hacs-test-workbench.rkt @@ -0,0 +1,30 @@ +#lang debug racket +(require sugar/debug "hacs.rkt") + +(current-inference forward-check) +(current-select-variable mrv) +(current-order-values shuffle) +(current-random #true) + +;; queens problem +;; place queens on chessboard so they do not intersect + +(define board-size 8) + +(define queens (make-csp)) +(define qs (for/list ([q board-size]) (string->symbol (format "q~a" q)))) +(define rows (range (length qs))) +(add-vars! queens qs rows) +(define (q-col q) (string->number (string-trim (symbol->string q) "q"))) +(for* ([qs (in-combinations qs 2)]) + (match-define (list qa qb) qs) + (match-define (list qa-col qb-col) (map q-col qs)) + (add-constraint! queens + (λ (qa-row qb-row) + (not (= (abs (- qa-row qb-row)) (abs (- (q-col qa) (q-col qb)))))) ; same diag? + (list qa qb)) + (add-constraint! queens (negate =) (list qa qb))) + +(time-avg 10 (solve queens)) +(parameterize ([current-solver min-conflicts-solver]) + (time-named (solve queens))) \ No newline at end of file diff --git a/csp/hacs-test.rkt b/csp/csp/hacs-test.rkt similarity index 100% rename from csp/hacs-test.rkt rename to csp/csp/hacs-test.rkt diff --git a/csp/csp/hacs.rkt b/csp/csp/hacs.rkt new file mode 100644 index 00000000..23a2cc84 --- /dev/null +++ b/csp/csp/hacs.rkt @@ -0,0 +1,545 @@ +#lang debug racket +(require racket/generator graph sugar/debug) +(provide (all-defined-out)) + +(define-syntax when-debug + (let () + (define debug #f) + (if debug + (make-rename-transformer #'begin) + (λ (stx) (syntax-case stx () + [(_ . rest) #'(void)]))))) + +(define-syntax-rule (in-cartesian x) + (in-generator (let ([argss x]) + (let loop ([argss argss][acc empty]) + (if (null? argss) + (yield (reverse acc)) + (for ([arg (in-list (car argss))]) + (loop (cdr argss) (cons arg acc)))))))) + +(struct $csp (vars + constraints + [assignments #:auto] + [checks #:auto]) #:mutable #:transparent + #:auto-value 0) +(define csp? $csp?) +(define vars $csp-vars) +(define constraints $csp-constraints) +(define-syntax-rule (in-constraints csp) (in-list ($csp-constraints csp))) +(define-syntax-rule (in-vars csp) (in-list ($csp-vars csp))) +(define-syntax-rule (in-var-names csp) (in-list (map $var-name ($csp-vars csp)))) + +(struct $constraint (names proc) #:transparent + #:property prop:procedure + (λ (constraint csp) + (unless ($csp? csp) + (raise-argument-error '$constraint-proc "$csp" csp)) + ;; apply proc in many-to-many style + (for/and ([args (in-cartesian (map (λ (cname) ($csp-vals csp cname)) ($constraint-names constraint)))]) + (apply ($constraint-proc constraint) args)))) + +(define (make-constraint [names null] [proc values]) + ($constraint names proc)) + +(define constraint-names $constraint-names) +(define constraint? $constraint?) + +(define (csp->graphviz csp) + (define g (csp->graph csp)) + (graphviz g #:colors (coloring/brelaz g))) + +(define (csp->graph csp) + (for*/fold ([g (unweighted-graph/undirected (map var-name (vars csp)))]) + ([constraint (in-constraints csp)] + [edge (in-combinations (constraint-names constraint) 2)]) + (apply add-edge! g edge) + g)) + +(struct $var (name domain) #:transparent) +(define var? $var?) +(define name? symbol?) +(define $var-vals $var-domain) +(define var-name $var-name) + +(struct $cvar $var (past) #:transparent) +(struct $avar $var () #:transparent) +(define assigned-var? $avar?) + +(define/contract (make-csp [vars null] [constraints null]) + (() ((listof var?) (listof constraint?)) . ->* . csp?) + ($csp vars constraints)) + +(define/contract (add-vars! csp names-or-procedure [vals-or-procedure empty]) + ((csp? (or/c (listof name?) procedure?)) ((or/c (listof any/c) procedure?)) . ->* . void?) + (for/fold ([vars ($csp-vars csp)] + #:result (set-$csp-vars! csp vars)) + ([name (in-list (if (procedure? names-or-procedure) + (names-or-procedure) + names-or-procedure))]) + (when (memq name (map var-name vars)) + (raise-argument-error 'add-vars! "var that doesn't already exist" name)) + (append vars (list ($var name + (if (procedure? vals-or-procedure) + (vals-or-procedure) + vals-or-procedure)))))) + +(define/contract (add-var! csp name [vals-or-procedure empty]) + ((csp? name?) ((or/c (listof any/c) procedure?)) . ->* . void?) + (add-vars! csp (list name) vals-or-procedure)) + +(define/contract (add-constraints! csp proc namess [proc-name #false]) + ((csp? procedure? (listof (listof name?))) ((or/c #false name?)) . ->* . void?) + (set-$csp-constraints! csp (append (constraints csp) + (for/list ([names (in-list namess)]) + (for ([name (in-list names)]) + (check-name-in-csp! 'add-constraints! csp name)) + (make-constraint names (if proc-name + (procedure-rename proc proc-name) + proc)))))) + +(define/contract (add-pairwise-constraint! csp proc var-names [proc-name #false]) + ((csp? procedure? (listof name?)) (name?) . ->* . void?) + (add-constraints! csp proc (combinations var-names 2) proc-name)) + +(define/contract (add-constraint! csp proc var-names [proc-name #false]) + ((csp? procedure? (listof name?)) (name?) . ->* . void?) + (add-constraints! csp proc (list var-names) proc-name)) + +(define/contract (alldiff= x y) + (any/c any/c . -> . boolean?) + (not (= x y))) + +(struct $backtrack (names) #:transparent) +(define (backtrack! [names null]) (raise ($backtrack names))) + +(define current-select-variable (make-parameter #f)) +(define current-order-values (make-parameter #f)) +(define current-inference (make-parameter #f)) +(define current-solver (make-parameter #f)) +(define current-random (make-parameter #t)) +(define current-decompose (make-parameter #t)) + +(define/contract (check-name-in-csp! caller csp name) + (symbol? csp? name? . -> . void?) + (define names (map var-name (vars csp))) + (unless (memq name names) + (raise-argument-error caller (format "one of these existing csp var names: ~v" names) name))) + +(define/contract (csp-var csp name) + (csp? name? . -> . $var?) + (check-name-in-csp! 'csp-var csp name) + (for/first ([var (in-vars csp)] + #:when (eq? name (var-name var))) + var)) + +(define/contract ($csp-vals csp name) + (csp? name? . -> . (listof any/c)) + (check-name-in-csp! 'csp-vals csp name) + ($var-domain (csp-var csp name))) + +(define order-domain-values values) + +(define/contract (assigned-name? csp name) + (csp? name? . -> . any/c) + (for/or ([var (in-vars csp)] + #:when (assigned-var? var)) + (eq? name (var-name var)))) + +(define (reduce-function-arity proc pattern) + (unless (match (procedure-arity proc) + [(arity-at-least val) (<= val (length pattern))] + [(? number? val) (= val (length pattern))]) + (raise-argument-error 'reduce-arity (format "list of length ~a, same as procedure arity" (procedure-arity proc)) pattern)) + (define reduced-arity-name (string->symbol (format "reduced-arity-~a" (object-name proc)))) + (define-values (boxed-id-names vals) (partition box? pattern)) + (define new-arity (length boxed-id-names)) + (procedure-rename + (λ xs + (unless (= (length xs) new-arity) + (apply raise-arity-error reduced-arity-name new-arity xs)) + (apply proc (for/fold ([acc empty] + [xs xs] + [vals vals] + #:result (reverse acc)) + ([pat-item (in-list pattern)]) + (if (box? pat-item) + (values (cons (car xs) acc) (cdr xs) vals) + (values (cons (car vals) acc) xs (cdr vals)))))) + reduced-arity-name)) + +(define/contract (reduce-constraint-arity csp [minimum-arity 3]) + ((csp?) ((or/c #false exact-nonnegative-integer?)) . ->* . csp?) + (let ([assigned-name? (curry assigned-name? csp)]) + (define (partially-assigned? constraint) + (ormap assigned-name? ($constraint-names constraint))) + (make-csp (vars csp) + (for/list ([constraint (in-constraints csp)]) + (cond + [(and (or (not minimum-arity) (<= minimum-arity (constraint-arity constraint))) + (partially-assigned? constraint)) + (match-define ($constraint cnames proc) constraint) + ($constraint (filter-not assigned-name? cnames) + ;; pattern is mix of values and boxed symbols (indicating variables to persist) + ;; use boxes here as cheap way to distinguish id symbols from value symbols + (let ([reduce-arity-pattern (for/list ([cname (in-list cnames)]) + (if (assigned-name? cname) + (first ($csp-vals csp cname)) + (box cname)))]) + (reduce-function-arity proc reduce-arity-pattern)))] + [else constraint]))))) + +(define nassns 0) +(define (reset-assns!) (set! nassns 0)) +(define/contract (assign-val csp name val) + (csp? name? any/c . -> . csp?) + (when-debug (set! nassns (add1 nassns))) + (make-csp + (for/list ([var (vars csp)]) + (if (eq? name (var-name var)) + ($avar name (list val)) + var)) + (constraints csp))) + +(define/contract (unassigned-vars csp) + (csp? . -> . (listof (and/c $var? (not/c assigned-var?)))) + (filter-not assigned-var? (vars csp))) + +(define/contract (first-unassigned-variable csp) + (csp? . -> . (or/c #false (and/c $var? (not/c assigned-var?)))) + (match (unassigned-vars csp) + [(? empty?) #false] + [(cons x _) x])) + +(define/contract (minimum-remaining-values csp) + (csp? . -> . (or/c #false (and/c $var? (not/c assigned-var?)))) + (match (unassigned-vars csp) + [(? empty?) #false] + [xs (argmin (λ (var) (length ($var-domain var))) xs)])) + +(define mrv minimum-remaining-values) + +(define/contract (var-degree csp var) + (csp? $var? . -> . exact-nonnegative-integer?) + (for/sum ([constraint (in-constraints csp)] + #:when (memq (var-name var) ($constraint-names constraint))) + 1)) + +(define/contract (blended-variable-selector csp) + (csp? . -> . (or/c #false (and/c $var? (not/c assigned-var?)))) + (define uvars (unassigned-vars csp)) + (cond + [(empty? uvars) #false] + [(findf singleton-var? uvars)] + [else (first (let* ([uvars-by-mrv (sort uvars < #:key (λ (var) (length ($var-domain var))))] + [uvars-by-degree (sort uvars-by-mrv > #:key (λ (var) (var-degree csp var)))]) + uvars-by-degree))])) + +(define/contract (remaining-values var) + ($var? . -> . exact-nonnegative-integer?) + (length ($var-vals var))) + +(define/contract (mrv-degree-hybrid csp) + (csp? . -> . (or/c #f $var?)) + (define uvars (unassigned-vars csp)) + (cond + [(empty? uvars) #false] + [else + ;; minimum remaining values (MRV) rule + (define mrv-arg (argmin remaining-values uvars)) + (match (filter (λ (var) (= (remaining-values mrv-arg) (remaining-values var))) uvars) + [(list winning-uvar) winning-uvar] + [(list mrv-uvars ...) + ;; use degree as tiebreaker for mrv + (define degrees (map (λ (var) (var-degree csp var)) mrv-uvars)) + (define max-degree (apply max degrees)) + ;; use random tiebreaker for degree + (random-pick (for/list ([var (in-list mrv-uvars)] + [degree (in-list degrees)] + #:when (= max-degree degree)) + var))])])) + +(define first-domain-value values) + +(define (no-inference csp name) csp) + +(define/contract (relating-only constraints names) + ((listof $constraint?) (listof name?) . -> . (listof $constraint?)) + (for*/list ([constraint (in-list constraints)] + [cnames (in-value ($constraint-names constraint))] + #:when (and (= (length names) (length cnames)) + (for/and ([name (in-list names)]) + (memq name cnames)))) + constraint)) + +(define (binary-constraint? constraint) + (= 2 (constraint-arity constraint))) + +(define (constraint-relates? constraint name) + (memq name ($constraint-names constraint))) + +(define nfchecks 0) +(define (reset-nfcs!) (set! nfchecks 0)) + +(define/contract (forward-check csp aname) + (csp? name? . -> . csp?) + (define aval (first ($csp-vals csp aname))) + (define (check-var var) + (match var + ;; don't check against assigned vars, or the reference var + ;; (which is probably assigned but maybe not) + [(? (λ (x) (or (assigned-var? x) (eq? (var-name x) aname)))) var] + [($var name vals) + (match ((constraints csp) . relating-only . (list aname name)) + [(? empty?) var] + [constraints + (define new-vals + (for/list ([val (in-list vals)] + #:when (for/and ([constraint (in-list constraints)]) + (let ([proc ($constraint-proc constraint)]) + (if (eq? name (first ($constraint-names constraint))) + (proc val aval) + (proc aval val))))) + val)) + ($cvar name new-vals (cons aname (if ($cvar? var) + ($cvar-past var) + null)))])])) + (define checked-vars (map check-var (vars csp))) + (when-debug (set! nfchecks (+ (length checked-vars) nchecks))) + ;; conflict-set will be empty if there are no empty domains + (define conflict-set (for*/list ([var (in-list checked-vars)] + #:when (empty? ($var-domain var)) + [name (in-list ($cvar-past var))]) + name)) + ;; for conflict-directed backjumping it's essential to forward-check ALL vars + ;; (even after an empty domain is generated) and combine their conflicts + ;; so we can discover the *most recent past var* that could be the culprit. + ;; If we just bail out at the first conflict, we may backjump too far based on its history + ;; (and thereby miss parts of the search tree) + (when (pair? conflict-set) + (backtrack! conflict-set)) + ;; Discard constraints that have produced singleton domains + ;; (they have no further use) + (define nonsingleton-constraints + (for/list ([constraint (in-constraints csp)] + #:unless (and + (binary-constraint? constraint) + (constraint-relates? constraint aname) + (let ([other-name (first (remq aname ($constraint-names constraint)))]) + (singleton-var? (csp-var csp other-name))))) + constraint)) + (make-csp checked-vars nonsingleton-constraints)) + +(define/contract (constraint-checkable? c names) + ($constraint? (listof name?) . -> . any/c) + ;; constraint is checkable if all constraint names + ;; are in target list of names. + (for/and ([cname (in-list ($constraint-names c))]) + (memq cname names))) + +(define/contract (constraint-arity constraint) + ($constraint? . -> . exact-nonnegative-integer?) + (length ($constraint-names constraint))) + +(define (singleton-var? var) + (= 1 (length ($var-domain var)))) + +(define nchecks 0) +(define (reset-nchecks!) (set! nchecks 0)) +(define/contract (check-constraints csp [mandatory-names #f] #:conflicts [conflict-count? #f]) + ((csp?) ((listof name?) #:conflicts boolean?) . ->* . (or/c csp? exact-nonnegative-integer?)) + ;; this time, we're not limited to assigned variables + ;; (that is, vars that have been deliberately assigned in the backtrack process thus far) + ;; we also want to use "singleton" vars (that is, vars that have been reduced to a single domain value by forward checking) + (define singleton-varnames (for/list ([var (in-vars csp)] + #:when (singleton-var? var)) + (var-name var))) + (define-values (checkable-constraints other-constraints) + (partition (λ (c) (and (constraint-checkable? c singleton-varnames) + (or (not mandatory-names) + (for/and ([name (in-list mandatory-names)]) + (constraint-relates? c name))))) + (constraints csp))) + (cond + [conflict-count? (define conflict-count + (for/sum ([constraint (in-list checkable-constraints)] + #:unless (constraint csp)) + 1)) + (when-debug (set! nchecks (+ conflict-count nchecks))) + conflict-count] + [else (for ([(constraint idx) (in-indexed (sort checkable-constraints < #:key constraint-arity))] + #:unless (constraint csp)) + (when-debug (set! nchecks (+ (add1 idx) nchecks))) + (backtrack!)) + ;; discard checked constraints, since they have no further reason to live + (make-csp (vars csp) other-constraints)])) + +(define/contract (make-nodes-consistent csp) + (csp? . -> . csp?) + ;; todo: why does this function slow down searches? + (make-csp + (for/list ([var (in-vars csp)]) + (match-define ($var name vals) var) + (define procs (for*/list ([constraint (in-constraints csp)] + [cnames (in-value ($constraint-names constraint))] + #:when (and (= 1 (length cnames)) (eq? name (car cnames)))) + ($constraint-proc constraint))) + ($var name + (for*/fold ([vals vals]) + ([proc (in-list procs)]) + (filter proc vals)))) + (constraints csp))) + +(define/contract (backtracking-solver + csp + #:select-variable [select-unassigned-variable + (or (current-select-variable) first-unassigned-variable)] + #:order-values [order-domain-values (or (current-order-values) first-domain-value)] + #:inference [inference (or (current-inference) no-inference)]) + ((csp?) (#:select-variable procedure? #:order-values procedure? #:inference procedure?) . ->* . generator?) + (generator () + (let loop ([csp csp]) + (match (select-unassigned-variable csp) + [#false (yield csp)] + [($var name domain) + (define (wants-backtrack? exn) + (and ($backtrack? exn) (or (let ([btns ($backtrack-names exn)]) + (or (empty? btns) (memq name btns)))))) + (for/fold ([conflicts null] + #:result (void)) + ([val (in-list (order-domain-values domain))]) + (with-handlers ([wants-backtrack? + (λ (bt) (append conflicts (remq name ($backtrack-names bt))))]) + (let* ([csp (assign-val csp name val)] + ;; reduce constraints before inference, + ;; to create more forward-checkable (binary) constraints + [csp (reduce-constraint-arity csp)] + [csp (inference csp name)] + [csp (check-constraints csp)]) + (loop csp))) + conflicts)])))) + +(define (random-pick xs) + (list-ref xs (random (length xs)))) + +(define (assign-random-vals csp) + (for/fold ([new-csp csp]) + ([name (in-var-names csp)]) + (assign-val new-csp name (random-pick ($csp-vals csp name))))) + +(define (make-min-conflcts-thread csp0 thread-count max-steps [main-thread (current-thread)]) + (thread + (λ () + (let loop () + ;; Generate a complete assignment for all variables (probably with conflicts) + (for/fold ([csp (assign-random-vals csp0)]) + ([nth-step (in-range max-steps)]) + ;; Now repeatedly choose a random conflicted variable and change it + (match (conflicted-var-names csp) + [(? empty?) (thread-send main-thread csp) (loop)] + [names + (define name (random-pick names)) + (define val (min-conflicts-value csp name ($csp-vals csp0 name))) + (assign-val csp name val)])))))) + +(define/contract (min-conflicts-solver csp [max-steps 100]) + (($csp?) (integer?) . ->* . generator?) + ;; Solve a CSP by stochastic hillclimbing on the number of conflicts. + (generator () + (for ([thread-count 4]) ; todo: what is ideal thread count? + (make-min-conflcts-thread csp thread-count max-steps)) + (for ([i (in-naturals)]) + (yield (thread-receive))))) + +(define/contract (conflicted-var-names csp) + ($csp? . -> . (listof name?)) + ;; Return a list of variables in current assignment that are conflicted + (for/list ([name (in-var-names csp)] + #:when (positive? (nconflicts csp name))) + name)) + +(define/contract (min-conflicts-value csp name vals) + ($csp? name? (listof any/c) . -> . any/c) + ;; Return the value that will give var the least number of conflicts + (define vals-by-conflict (sort vals < #:key (λ (val) (nconflicts csp name val)) + #:cache-keys? #true)) + (for/first ([val (in-list vals-by-conflict)] + #:unless (equal? val (first ($csp-vals csp name)))) ;; but change the value + val)) + +(define no-value-sig (gensym)) + +(define/contract (nconflicts csp name [val no-value-sig]) + (($csp? name?) (any/c) . ->* . exact-nonnegative-integer?) + ;; How many conflicts var: val assignment has with other variables. + (check-constraints (if (eq? val no-value-sig) + csp + (assign-val csp name val)) (list name) #:conflicts #true)) + +(define/contract (csp->assocs csp) + (csp? . -> . (listof (cons/c name? any/c))) + (for/list ([var (in-vars csp)]) + (match var + [($var name (list val)) (cons name val)]))) + +(define/contract (combine-csps csps) + ((listof $csp?) . -> . $csp?) + (make-csp + (apply append (map $csp-vars csps)) + (apply append (map $csp-constraints csps)))) + +(define/contract (make-cartesian-generator solgens) + ((listof generator?) . -> . generator?) + (generator () + (define solstreams (for/list ([solgen (in-list solgens)]) + (for/stream ([sol (in-producer solgen (void))]) + sol))) + (let loop ([solstreams solstreams][sols empty]) + (if (null? solstreams) + (yield (combine-csps (reverse sols))) + (for ([sol (in-stream (car solstreams))]) + (loop (cdr solstreams) (cons sol sols))))))) + +(define/contract (extract-subcsp csp names) + ($csp? (listof name?) . -> . $csp?) + (make-csp + (for/list ([var (in-vars csp)] + #:when (memq (var-name var) names)) + var) + (for/list ([constraint (in-constraints csp)] + #:when (for/and ([cname (in-list ($constraint-names constraint))]) + (memq cname names))) + constraint))) + +(define/contract (solve* csp + #:finish-proc [finish-proc csp->assocs] + #:solver [solver (or (current-solver) backtracking-solver)] + #:limit [max-solutions +inf.0]) + ((csp?) (#:finish-proc procedure? #:solver procedure? #:limit exact-nonnegative-integer?) + . ->* . (listof any/c)) + (when-debug (reset-assns!) (reset-nfcs!) (reset-nchecks!)) + + (define subcsps ; decompose into independent csps. `cc` determines "connected components" + (if (current-decompose) + (for/list ([nodeset (in-list (cc (csp->graph csp)))]) + (extract-subcsp csp nodeset)) + (list csp))) + + (for/list ([solution (in-producer (make-cartesian-generator (map solver subcsps)) (void))] + [idx (in-range max-solutions)]) + (finish-proc solution))) + +(define/contract (solve csp + #:finish-proc [finish-proc csp->assocs] + #:solver [solver (or (current-solver) backtracking-solver)] + #:limit [max-solutions 1]) + ((csp?) (#:finish-proc procedure? #:solver procedure? #:limit exact-nonnegative-integer?) + . ->* . (or/c #false any/c)) + (match (solve* csp #:finish-proc finish-proc #:solver solver #:limit max-solutions) + [(list solution) solution] + [(list solutions ...) solutions] + [else #false])) + +(define (<> a b) (not (= a b))) +(define (neq? a b) (not (eq? a b))) + diff --git a/csp/main.rkt b/csp/csp/main.rkt similarity index 100% rename from csp/main.rkt rename to csp/csp/main.rkt diff --git a/csp/port/constraint.rkt b/csp/csp/port/constraint.rkt similarity index 100% rename from csp/port/constraint.rkt rename to csp/csp/port/constraint.rkt diff --git a/csp/port/domain.rkt b/csp/csp/port/domain.rkt similarity index 100% rename from csp/port/domain.rkt rename to csp/csp/port/domain.rkt diff --git a/csp/port/helper.rkt b/csp/csp/port/helper.rkt similarity index 100% rename from csp/port/helper.rkt rename to csp/csp/port/helper.rkt diff --git a/csp/port/main.rkt b/csp/csp/port/main.rkt similarity index 100% rename from csp/port/main.rkt rename to csp/csp/port/main.rkt diff --git a/csp/port/problem.rkt b/csp/csp/port/problem.rkt similarity index 100% rename from csp/port/problem.rkt rename to csp/csp/port/problem.rkt diff --git a/csp/port/solver.rkt b/csp/csp/port/solver.rkt similarity index 100% rename from csp/port/solver.rkt rename to csp/csp/port/solver.rkt diff --git a/csp/port/test-classes.rkt b/csp/csp/port/test-classes.rkt similarity index 100% rename from csp/port/test-classes.rkt rename to csp/csp/port/test-classes.rkt diff --git a/csp/port/test-einstein.rkt b/csp/csp/port/test-einstein.rkt similarity index 100% rename from csp/port/test-einstein.rkt rename to csp/csp/port/test-einstein.rkt diff --git a/csp/port/test-problems.rkt b/csp/csp/port/test-problems.rkt similarity index 100% rename from csp/port/test-problems.rkt rename to csp/csp/port/test-problems.rkt diff --git a/csp/port/variable.rkt b/csp/csp/port/variable.rkt similarity index 100% rename from csp/port/variable.rkt rename to csp/csp/port/variable.rkt diff --git a/csp/python-constraint/API Documentation.webloc b/csp/csp/python-constraint/API Documentation.webloc similarity index 100% rename from csp/python-constraint/API Documentation.webloc rename to csp/csp/python-constraint/API Documentation.webloc diff --git a/csp/python-constraint/LICENSE b/csp/csp/python-constraint/LICENSE similarity index 100% rename from csp/python-constraint/LICENSE rename to csp/csp/python-constraint/LICENSE diff --git a/csp/python-constraint/MANIFEST.in b/csp/csp/python-constraint/MANIFEST.in similarity index 100% rename from csp/python-constraint/MANIFEST.in rename to csp/csp/python-constraint/MANIFEST.in diff --git a/csp/python-constraint/PKG-INFO b/csp/csp/python-constraint/PKG-INFO similarity index 100% rename from csp/python-constraint/PKG-INFO rename to csp/csp/python-constraint/PKG-INFO diff --git a/csp/python-constraint/README b/csp/csp/python-constraint/README similarity index 100% rename from csp/python-constraint/README rename to csp/csp/python-constraint/README diff --git a/csp/python-constraint/constraint.py b/csp/csp/python-constraint/constraint.py similarity index 100% rename from csp/python-constraint/constraint.py rename to csp/csp/python-constraint/constraint.py diff --git a/csp/python-constraint/examples/abc/abc.py b/csp/csp/python-constraint/examples/abc/abc.py similarity index 100% rename from csp/python-constraint/examples/abc/abc.py rename to csp/csp/python-constraint/examples/abc/abc.py diff --git a/csp/python-constraint/examples/coins/coins.py b/csp/csp/python-constraint/examples/coins/coins.py similarity index 100% rename from csp/python-constraint/examples/coins/coins.py rename to csp/csp/python-constraint/examples/coins/coins.py diff --git a/csp/python-constraint/examples/crosswords/crosswords.py b/csp/csp/python-constraint/examples/crosswords/crosswords.py similarity index 100% rename from csp/python-constraint/examples/crosswords/crosswords.py rename to csp/csp/python-constraint/examples/crosswords/crosswords.py diff --git a/csp/python-constraint/examples/crosswords/large.mask b/csp/csp/python-constraint/examples/crosswords/large.mask similarity index 100% rename from csp/python-constraint/examples/crosswords/large.mask rename to csp/csp/python-constraint/examples/crosswords/large.mask diff --git a/csp/python-constraint/examples/crosswords/medium.mask b/csp/csp/python-constraint/examples/crosswords/medium.mask similarity index 100% rename from csp/python-constraint/examples/crosswords/medium.mask rename to csp/csp/python-constraint/examples/crosswords/medium.mask diff --git a/csp/python-constraint/examples/crosswords/python.mask b/csp/csp/python-constraint/examples/crosswords/python.mask similarity index 100% rename from csp/python-constraint/examples/crosswords/python.mask rename to csp/csp/python-constraint/examples/crosswords/python.mask diff --git a/csp/python-constraint/examples/crosswords/small.mask b/csp/csp/python-constraint/examples/crosswords/small.mask similarity index 100% rename from csp/python-constraint/examples/crosswords/small.mask rename to csp/csp/python-constraint/examples/crosswords/small.mask diff --git a/csp/python-constraint/examples/einstein/einstein.py b/csp/csp/python-constraint/examples/einstein/einstein.py similarity index 100% rename from csp/python-constraint/examples/einstein/einstein.py rename to csp/csp/python-constraint/examples/einstein/einstein.py diff --git a/csp/python-constraint/examples/einstein/einstein2.py b/csp/csp/python-constraint/examples/einstein/einstein2.py similarity index 100% rename from csp/python-constraint/examples/einstein/einstein2.py rename to csp/csp/python-constraint/examples/einstein/einstein2.py diff --git a/csp/python-constraint/examples/queens/queens.py b/csp/csp/python-constraint/examples/queens/queens.py similarity index 100% rename from csp/python-constraint/examples/queens/queens.py rename to csp/csp/python-constraint/examples/queens/queens.py diff --git a/csp/python-constraint/examples/rooks/rooks.py b/csp/csp/python-constraint/examples/rooks/rooks.py similarity index 100% rename from csp/python-constraint/examples/rooks/rooks.py rename to csp/csp/python-constraint/examples/rooks/rooks.py diff --git a/csp/python-constraint/examples/studentdesks/studentdesks.py b/csp/csp/python-constraint/examples/studentdesks/studentdesks.py similarity index 100% rename from csp/python-constraint/examples/studentdesks/studentdesks.py rename to csp/csp/python-constraint/examples/studentdesks/studentdesks.py diff --git a/csp/python-constraint/examples/sudoku/sudoku.py b/csp/csp/python-constraint/examples/sudoku/sudoku.py similarity index 100% rename from csp/python-constraint/examples/sudoku/sudoku.py rename to csp/csp/python-constraint/examples/sudoku/sudoku.py diff --git a/csp/python-constraint/examples/wordmath/seisseisdoze.py b/csp/csp/python-constraint/examples/wordmath/seisseisdoze.py similarity index 100% rename from csp/python-constraint/examples/wordmath/seisseisdoze.py rename to csp/csp/python-constraint/examples/wordmath/seisseisdoze.py diff --git a/csp/python-constraint/examples/wordmath/sendmoremoney.py b/csp/csp/python-constraint/examples/wordmath/sendmoremoney.py similarity index 100% rename from csp/python-constraint/examples/wordmath/sendmoremoney.py rename to csp/csp/python-constraint/examples/wordmath/sendmoremoney.py diff --git a/csp/python-constraint/examples/wordmath/twotwofour.py b/csp/csp/python-constraint/examples/wordmath/twotwofour.py similarity index 100% rename from csp/python-constraint/examples/wordmath/twotwofour.py rename to csp/csp/python-constraint/examples/wordmath/twotwofour.py diff --git a/csp/python-constraint/examples/xsum/xsum.py b/csp/csp/python-constraint/examples/xsum/xsum.py similarity index 100% rename from csp/python-constraint/examples/xsum/xsum.py rename to csp/csp/python-constraint/examples/xsum/xsum.py diff --git a/csp/python-constraint/setup.cfg b/csp/csp/python-constraint/setup.cfg similarity index 100% rename from csp/python-constraint/setup.cfg rename to csp/csp/python-constraint/setup.cfg diff --git a/csp/python-constraint/setup.py b/csp/csp/python-constraint/setup.py similarity index 100% rename from csp/python-constraint/setup.py rename to csp/csp/python-constraint/setup.py diff --git a/csp/python-constraint/testconstraint.py b/csp/csp/python-constraint/testconstraint.py similarity index 100% rename from csp/python-constraint/testconstraint.py rename to csp/csp/python-constraint/testconstraint.py diff --git a/csp/python-constraint/trials/abcd.py b/csp/csp/python-constraint/trials/abcd.py similarity index 100% rename from csp/python-constraint/trials/abcd.py rename to csp/csp/python-constraint/trials/abcd.py diff --git a/csp/python-constraint/trials/coins.py b/csp/csp/python-constraint/trials/coins.py similarity index 100% rename from csp/python-constraint/trials/coins.py rename to csp/csp/python-constraint/trials/coins.py diff --git a/csp/python-constraint/trials/constraint.py b/csp/csp/python-constraint/trials/constraint.py similarity index 100% rename from csp/python-constraint/trials/constraint.py rename to csp/csp/python-constraint/trials/constraint.py diff --git a/csp/python-constraint/trials/crosswords.py b/csp/csp/python-constraint/trials/crosswords.py similarity index 100% rename from csp/python-constraint/trials/crosswords.py rename to csp/csp/python-constraint/trials/crosswords.py diff --git a/csp/python-constraint/trials/einstein.py b/csp/csp/python-constraint/trials/einstein.py similarity index 100% rename from csp/python-constraint/trials/einstein.py rename to csp/csp/python-constraint/trials/einstein.py diff --git a/csp/python-constraint/trials/einstein2.py b/csp/csp/python-constraint/trials/einstein2.py similarity index 100% rename from csp/python-constraint/trials/einstein2.py rename to csp/csp/python-constraint/trials/einstein2.py diff --git a/csp/python-constraint/trials/large.mask b/csp/csp/python-constraint/trials/large.mask similarity index 100% rename from csp/python-constraint/trials/large.mask rename to csp/csp/python-constraint/trials/large.mask diff --git a/csp/python-constraint/trials/medium.mask b/csp/csp/python-constraint/trials/medium.mask similarity index 100% rename from csp/python-constraint/trials/medium.mask rename to csp/csp/python-constraint/trials/medium.mask diff --git a/csp/python-constraint/trials/python.mask b/csp/csp/python-constraint/trials/python.mask similarity index 100% rename from csp/python-constraint/trials/python.mask rename to csp/csp/python-constraint/trials/python.mask diff --git a/csp/python-constraint/trials/queens.py b/csp/csp/python-constraint/trials/queens.py similarity index 100% rename from csp/python-constraint/trials/queens.py rename to csp/csp/python-constraint/trials/queens.py diff --git a/csp/python-constraint/trials/rooks.py b/csp/csp/python-constraint/trials/rooks.py similarity index 100% rename from csp/python-constraint/trials/rooks.py rename to csp/csp/python-constraint/trials/rooks.py diff --git a/csp/python-constraint/trials/seisseisdoze.py b/csp/csp/python-constraint/trials/seisseisdoze.py similarity index 100% rename from csp/python-constraint/trials/seisseisdoze.py rename to csp/csp/python-constraint/trials/seisseisdoze.py diff --git a/csp/python-constraint/trials/sendmoremoney.py b/csp/csp/python-constraint/trials/sendmoremoney.py similarity index 100% rename from csp/python-constraint/trials/sendmoremoney.py rename to csp/csp/python-constraint/trials/sendmoremoney.py diff --git a/csp/python-constraint/trials/small.mask b/csp/csp/python-constraint/trials/small.mask similarity index 100% rename from csp/python-constraint/trials/small.mask rename to csp/csp/python-constraint/trials/small.mask diff --git a/csp/python-constraint/trials/studentdesks.py b/csp/csp/python-constraint/trials/studentdesks.py similarity index 100% rename from csp/python-constraint/trials/studentdesks.py rename to csp/csp/python-constraint/trials/studentdesks.py diff --git a/csp/python-constraint/trials/sudoku.py b/csp/csp/python-constraint/trials/sudoku.py similarity index 100% rename from csp/python-constraint/trials/sudoku.py rename to csp/csp/python-constraint/trials/sudoku.py diff --git a/csp/python-constraint/trials/twotwofour.py b/csp/csp/python-constraint/trials/twotwofour.py similarity index 100% rename from csp/python-constraint/trials/twotwofour.py rename to csp/csp/python-constraint/trials/twotwofour.py diff --git a/csp/python-constraint/trials/xsum.py b/csp/csp/python-constraint/trials/xsum.py similarity index 100% rename from csp/python-constraint/trials/xsum.py rename to csp/csp/python-constraint/trials/xsum.py diff --git a/csp/csp/scribblings/csp.scrbl b/csp/csp/scribblings/csp.scrbl new file mode 100644 index 00000000..158d5897 --- /dev/null +++ b/csp/csp/scribblings/csp.scrbl @@ -0,0 +1,31 @@ +#lang scribble/manual + +@(require scribble/eval (for-label racket csp)) + +@(define my-eval (make-base-eval)) +@(my-eval `(require csp)) + + +@title{csp} + +@author[(author+email "Matthew Butterick" "mb@mbtype.com")] + + +@defmodule[csp] + +A simple hyphenation engine that uses the Knuth–Liang hyphenation algorithm originally developed for TeX. I have added little to their work. Accordingly, I take little credit. + +@section{Installation} + +At the command line: +@verbatim{raco pkg install csp} + +After that, you can update the package like so: +@verbatim{raco pkg update csp} + +@section{License & source code} + +This module is licensed under the LGPL. + +Source repository at @link["http://github.com/mbutterick/csp"]{http://github.com/mbutterick/csp}. Suggestions & corrections welcome. + diff --git a/csp/info.rkt b/csp/info.rkt index bb3b0a3f..5b7681d8 100644 --- a/csp/info.rkt +++ b/csp/info.rkt @@ -1,7 +1,6 @@ #lang info -(define collection "csp") -(define deps '(("base" #:version "6.0") "sugar" "rackunit-lib")) +(define collection 'multi) +(define deps '(("base" #:version "6.0") "sugar" "rackunit-lib" "debug" "graph")) (define update-implies '("sugar")) -;(define scribblings '(("scribblings/pollen.scrbl" (multi-page)))) -;(define raco-commands '(("pollen" pollen/raco "issue Pollen command" #f))) +(define scribblings '(("csp/scribblings/csp.scrbl" (multi-page)))) ;(define compile-omit-paths '("tests" "raco.rkt")) \ No newline at end of file From 6f1db5fd55b4f92c9ece685bad4592d4ba202025 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Mon, 22 Oct 2018 17:05:28 -0700 Subject: [PATCH 175/246] yes --- csp/csp/hacs-smm.rkt | 47 --- csp/csp/hacs-test-workbench.rkt | 3 +- csp/csp/hacs-test.rkt | 88 ++--- csp/csp/hacs.rkt | 527 +++++++++++++++--------------- csp/csp/info.rkt | 3 + csp/csp/main.rkt | 4 +- csp/csp/scribblings/csp.scrbl | 8 +- csp/hacs-test-workbench.rkt | 31 -- csp/hacs.rkt | 557 -------------------------------- csp/info.rkt | 4 +- 10 files changed, 327 insertions(+), 945 deletions(-) delete mode 100644 csp/csp/hacs-smm.rkt create mode 100644 csp/csp/info.rkt delete mode 100644 csp/hacs-test-workbench.rkt delete mode 100644 csp/hacs.rkt diff --git a/csp/csp/hacs-smm.rkt b/csp/csp/hacs-smm.rkt deleted file mode 100644 index 58e9ac67..00000000 --- a/csp/csp/hacs-smm.rkt +++ /dev/null @@ -1,47 +0,0 @@ -#lang br -(require "hacs.rkt") - -; SEND -;+ MORE -;------ -; MONEY - -(define $vd +var) - -(define (word-value . xs) - (for/sum ([(x idx) (in-indexed (reverse xs))]) - (* x (expt 10 idx)))) - -(define vs '(s e n d m o r y)) -(define vds (for/list ([k vs]) - ($vd k (range 10)))) - -(define (not= x y) (not (= x y))) - -(define alldiffs - (for/list ([pr (in-combinations vs 2)]) - ($constraint pr not=))) - -(define (smm-func s e n d m o r y) - (= (+ (word-value s e n d) (word-value m o r e)) (word-value m o n e y))) - -(define csp ($csp vds (append - - alldiffs - (list - ($constraint vs smm-func) - ($constraint '(s) positive?) - ($constraint '(m) (λ (x) (= 1 x))) - ($constraint '(d e y) (λ (d e y) (= (modulo (+ d e) 10) y))) - ($constraint '(n d r e y) (λ (n d r e y) - (= (modulo (+ (word-value n d) (word-value r e)) 100) - (word-value e y)))) - ($constraint '(e n d o r y) (λ (e n d o r y) - (= (modulo (+ (word-value e n d) (word-value o r e)) 1000) (word-value n e y)))))))) -(parameterize ([current-select-variable mrv] - [current-order-values lcv] - [current-inference mac]) - (time (solve csp))) -(nassigns csp) -(nchecks csp) -(reset! csp) \ No newline at end of file diff --git a/csp/csp/hacs-test-workbench.rkt b/csp/csp/hacs-test-workbench.rkt index df69806d..e8a05ca8 100644 --- a/csp/csp/hacs-test-workbench.rkt +++ b/csp/csp/hacs-test-workbench.rkt @@ -25,6 +25,7 @@ (list qa qb)) (add-constraint! queens (negate =) (list qa qb))) +(current-multithreaded #t) (time-avg 10 (solve queens)) (parameterize ([current-solver min-conflicts-solver]) - (time-named (solve queens))) \ No newline at end of file + (time-avg 10 (solve queens))) \ No newline at end of file diff --git a/csp/csp/hacs-test.rkt b/csp/csp/hacs-test.rkt index 4c3511b5..73ff798f 100644 --- a/csp/csp/hacs-test.rkt +++ b/csp/csp/hacs-test.rkt @@ -6,72 +6,72 @@ (current-order-values shuffle) (current-random #true) -(check-equal? (first-unassigned-variable ($csp (list ($var 'a (range 3)) ($var 'b (range 3))) null)) - ($var 'a (range 3))) -(check-equal? (first-unassigned-variable ($csp (list ($avar 'a (range 3)) ($var 'b (range 3))) null)) - ($var 'b (range 3))) -(check-false (first-unassigned-variable ($csp (list ($avar 'a (range 3)) ($avar 'b (range 3))) null))) +(check-equal? (first-unassigned-variable (csp (list (variable 'a (range 3)) (variable 'b (range 3))) null)) + (variable 'a (range 3))) +(check-equal? (first-unassigned-variable (csp (list (avar 'a (range 3)) (variable 'b (range 3))) null)) + (variable 'b (range 3))) +(check-false (first-unassigned-variable (csp (list (avar 'a (range 3)) (avar 'b (range 3))) null))) (check-equal? ;; no forward checking when no constraints - ($csp-vars (forward-check ($csp (list ($avar 'a '(1)) ($var 'b (range 2))) null) 'a)) - (list ($avar 'a '(1)) ($var 'b '(0 1)))) + (csp-vars (forward-check (csp (list (avar 'a '(1)) (variable 'b (range 2))) null) 'a)) + (list (avar 'a '(1)) (variable 'b '(0 1)))) (check-equal? - ($csp-vars (forward-check (forward-check ($csp (list ($avar 'a '(1)) ($avar 'b '(0)) ($var 'c '(0 1 2))) - (list ($constraint '(a c) (negate =)) - ($constraint '(b c) (negate =)))) 'a) 'b)) - (list ($avar 'a '(1)) ($avar 'b '(0)) ($cvar 'c '(2) '(b a)))) + (csp-vars (forward-check (forward-check (csp (list (avar 'a '(1)) (avar 'b '(0)) (variable 'c '(0 1 2))) + (list (constraint '(a c) (negate =)) + (constraint '(b c) (negate =)))) 'a) 'b)) + (list (avar 'a '(1)) (avar 'b '(0)) (cvar 'c '(2) '(b a)))) (check-equal? ;; no inconsistency: b≠c not checked when fc is relative to a - ($csp-vars (forward-check ($csp (list ($avar 'a '(1)) ($var 'b (range 2)) ($var 'c '(0))) - (list ($constraint '(a b) (negate =)) - ($constraint '(b c) (negate =)))) 'a)) - (list ($avar 'a '(1)) ($cvar 'b '(0) '(a)) ($var 'c '(0)))) + (csp-vars (forward-check (csp (list (avar 'a '(1)) (variable 'b (range 2)) (variable 'c '(0))) + (list (constraint '(a b) (negate =)) + (constraint '(b c) (negate =)))) 'a)) + (list (avar 'a '(1)) (cvar 'b '(0) '(a)) (variable 'c '(0)))) (check-equal? ;; no inconsistency: a≠b not checked when fc ignores a, which is already assigned - ($csp-vars (forward-check ($csp (list ($avar 'a '(1)) ($avar 'b '(1)) ($var 'c (range 2))) - (list ($constraint '(a b) (negate =)) - ($constraint '(b c) (negate =)))) 'b)) - (list ($avar 'a '(1)) ($avar 'b '(1)) ($cvar 'c '(0) '(b)))) + (csp-vars (forward-check (csp (list (avar 'a '(1)) (avar 'b '(1)) (variable 'c (range 2))) + (list (constraint '(a b) (negate =)) + (constraint '(b c) (negate =)))) 'b)) + (list (avar 'a '(1)) (avar 'b '(1)) (cvar 'c '(0) '(b)))) (check-exn $backtrack? - (λ () ($csp-vars (forward-check ($csp (list ($avar 'a '(1)) - ($var 'b '(1))) - (list ($constraint '(a b) (negate =)))) 'a)))) + (λ () (csp-vars (forward-check (csp (list (avar 'a '(1)) + (variable 'b '(1))) + (list (constraint '(a b) (negate =)))) 'a)))) -(check-equal? ($csp-vars (forward-check ($csp (list ($var 'a '(0)) - ($var 'b (range 3))) - (list ($constraint '(a b) <))) 'a)) - (list ($var 'a '(0)) ($cvar 'b '(1 2) '(a)))) +(check-equal? (csp-vars (forward-check (csp (list (variable 'a '(0)) + (variable 'b (range 3))) + (list (constraint '(a b) <))) 'a)) + (list (variable 'a '(0)) (cvar 'b '(1 2) '(a)))) (check-equal? (parameterize ([current-inference forward-check]) - (length (solve* ($csp (list ($var 'x (range 3)) - ($var 'y (range 3)) - ($var 'z (range 3))) - (list ($constraint '(x y) <>) - ($constraint '(x z) <>) - ($constraint '(y z) <>)))))) 6) + (length (solve* (csp (list (variable 'x (range 3)) + (variable 'y (range 3)) + (variable 'z (range 3))) + (list (constraint '(x y) <>) + (constraint '(x z) <>) + (constraint '(y z) <>)))))) 6) (parameterize ([current-inference forward-check]) (define vds (for/list ([k '(wa nt nsw q t v sa)]) - ($var k '(red green blue)))) + (variable k '(red green blue)))) (define cs (list - ($constraint '(wa nt) neq?) - ($constraint '(wa sa) neq?) - ($constraint '(nt sa) neq?) - ($constraint '(nt q) neq?) - ($constraint '(q sa) neq?) - ($constraint '(q nsw) neq?) - ($constraint '(nsw sa) neq?) - ($constraint '(nsw v) neq?) - ($constraint '(v sa) neq?))) - (define csp ($csp vds cs)) - (check-equal? (length (solve* csp)) 18)) + (constraint '(wa nt) neq?) + (constraint '(wa sa) neq?) + (constraint '(nt sa) neq?) + (constraint '(nt q) neq?) + (constraint '(q sa) neq?) + (constraint '(q nsw) neq?) + (constraint '(nsw sa) neq?) + (constraint '(nsw v) neq?) + (constraint '(v sa) neq?))) + (define aus (csp vds cs)) + (check-equal? (length (solve* aus)) 18)) (define quarters (make-csp)) diff --git a/csp/csp/hacs.rkt b/csp/csp/hacs.rkt index 23a2cc84..8d21eccc 100644 --- a/csp/csp/hacs.rkt +++ b/csp/csp/hacs.rkt @@ -1,5 +1,5 @@ #lang debug racket -(require racket/generator graph sugar/debug) +(require racket/generator graph) (provide (all-defined-out)) (define-syntax when-debug @@ -16,95 +16,97 @@ (if (null? argss) (yield (reverse acc)) (for ([arg (in-list (car argss))]) - (loop (cdr argss) (cons arg acc)))))))) + (loop (cdr argss) (cons arg acc)))))))) -(struct $csp (vars +(struct csp (vars constraints [assignments #:auto] [checks #:auto]) #:mutable #:transparent #:auto-value 0) -(define csp? $csp?) -(define vars $csp-vars) -(define constraints $csp-constraints) -(define-syntax-rule (in-constraints csp) (in-list ($csp-constraints csp))) -(define-syntax-rule (in-vars csp) (in-list ($csp-vars csp))) -(define-syntax-rule (in-var-names csp) (in-list (map $var-name ($csp-vars csp)))) - -(struct $constraint (names proc) #:transparent +(define vars csp-vars) +(define constraints csp-constraints) +(define-syntax-rule (in-constraints csp) (in-list (csp-constraints csp))) +(define-syntax-rule (in-vars csp) (in-list (csp-vars csp))) +(define-syntax-rule (in-variable-names csp) (in-list (map variable-name (csp-vars csp)))) + +(struct constraint (names proc) #:transparent #:property prop:procedure - (λ (constraint csp) - (unless ($csp? csp) - (raise-argument-error '$constraint-proc "$csp" csp)) + (λ (const prob) + (unless (csp? prob) + (raise-argument-error '$constraint-proc "$csp" prob)) ;; apply proc in many-to-many style - (for/and ([args (in-cartesian (map (λ (cname) ($csp-vals csp cname)) ($constraint-names constraint)))]) - (apply ($constraint-proc constraint) args)))) + (for/and ([args (in-cartesian (map (λ (name) (csp-domain prob name)) (constraint-names const)))]) + (apply (constraint-proc const) args)))) (define (make-constraint [names null] [proc values]) - ($constraint names proc)) + (constraint names proc)) -(define constraint-names $constraint-names) -(define constraint? $constraint?) -(define (csp->graphviz csp) - (define g (csp->graph csp)) +(define (csp->graphviz prob) + (define g (csp->graph prob)) (graphviz g #:colors (coloring/brelaz g))) -(define (csp->graph csp) - (for*/fold ([g (unweighted-graph/undirected (map var-name (vars csp)))]) - ([constraint (in-constraints csp)] +(define (csp->graph prob) + (for*/fold ([gr (unweighted-graph/undirected (map variable-name (vars prob)))]) + ([constraint (in-constraints prob)] [edge (in-combinations (constraint-names constraint) 2)]) - (apply add-edge! g edge) - g)) + (apply add-edge! gr edge) + gr)) -(struct $var (name domain) #:transparent) -(define var? $var?) +(struct variable (name domain) #:transparent) (define name? symbol?) -(define $var-vals $var-domain) -(define var-name $var-name) -(struct $cvar $var (past) #:transparent) -(struct $avar $var () #:transparent) -(define assigned-var? $avar?) +(struct checked-var variable (past) #:transparent) +(define cvar checked-var) +(define cvar? checked-var?) + +(struct assigned-var variable () #:transparent) +(define avar assigned-var) +(define avar? assigned-var?) -(define/contract (make-csp [vars null] [constraints null]) - (() ((listof var?) (listof constraint?)) . ->* . csp?) - ($csp vars constraints)) +(define/contract (make-csp [vars null] [consts null]) + (() ((listof variable?) (listof constraint?)) . ->* . csp?) + (csp vars consts)) -(define/contract (add-vars! csp names-or-procedure [vals-or-procedure empty]) +(define/contract (add-variables! prob names-or-procedure [vals-or-procedure empty]) ((csp? (or/c (listof name?) procedure?)) ((or/c (listof any/c) procedure?)) . ->* . void?) - (for/fold ([vars ($csp-vars csp)] - #:result (set-$csp-vars! csp vars)) + (for/fold ([vars (csp-vars prob)] + #:result (set-csp-vars! prob vars)) ([name (in-list (if (procedure? names-or-procedure) (names-or-procedure) names-or-procedure))]) - (when (memq name (map var-name vars)) + (when (memq name (map variable-name vars)) (raise-argument-error 'add-vars! "var that doesn't already exist" name)) - (append vars (list ($var name + (append vars (list (variable name (if (procedure? vals-or-procedure) (vals-or-procedure) vals-or-procedure)))))) -(define/contract (add-var! csp name [vals-or-procedure empty]) +(define add-vars! add-variables!) + +(define/contract (add-variable! prob name [vals-or-procedure empty]) ((csp? name?) ((or/c (listof any/c) procedure?)) . ->* . void?) - (add-vars! csp (list name) vals-or-procedure)) + (add-vars! prob (list name) vals-or-procedure)) -(define/contract (add-constraints! csp proc namess [proc-name #false]) +(define add-var! add-variable!) + +(define/contract (add-constraints! prob proc namess [proc-name #false]) ((csp? procedure? (listof (listof name?))) ((or/c #false name?)) . ->* . void?) - (set-$csp-constraints! csp (append (constraints csp) - (for/list ([names (in-list namess)]) - (for ([name (in-list names)]) - (check-name-in-csp! 'add-constraints! csp name)) - (make-constraint names (if proc-name - (procedure-rename proc proc-name) - proc)))))) - -(define/contract (add-pairwise-constraint! csp proc var-names [proc-name #false]) + (set-csp-constraints! prob (append (constraints prob) + (for/list ([names (in-list namess)]) + (for ([name (in-list names)]) + (check-name-in-csp! 'add-constraints! prob name)) + (make-constraint names (if proc-name + (procedure-rename proc proc-name) + proc)))))) + +(define/contract (add-pairwise-constraint! prob proc var-names [proc-name #false]) ((csp? procedure? (listof name?)) (name?) . ->* . void?) - (add-constraints! csp proc (combinations var-names 2) proc-name)) + (add-constraints! prob proc (combinations var-names 2) proc-name)) -(define/contract (add-constraint! csp proc var-names [proc-name #false]) +(define/contract (add-constraint! prob proc names [proc-name #false]) ((csp? procedure? (listof name?)) (name?) . ->* . void?) - (add-constraints! csp proc (list var-names) proc-name)) + (add-constraints! prob proc (list names) proc-name)) (define/contract (alldiff= x y) (any/c any/c . -> . boolean?) @@ -120,37 +122,38 @@ (define current-random (make-parameter #t)) (define current-decompose (make-parameter #t)) -(define/contract (check-name-in-csp! caller csp name) +(define/contract (check-name-in-csp! caller prob name) (symbol? csp? name? . -> . void?) - (define names (map var-name (vars csp))) + (define names (map variable-name (vars prob))) (unless (memq name names) (raise-argument-error caller (format "one of these existing csp var names: ~v" names) name))) -(define/contract (csp-var csp name) - (csp? name? . -> . $var?) - (check-name-in-csp! 'csp-var csp name) - (for/first ([var (in-vars csp)] - #:when (eq? name (var-name var))) - var)) +(define/contract (csp-var prob name) + (csp? name? . -> . variable?) + (check-name-in-csp! 'csp-var prob name) + (for/first ([var (in-vars prob)] + #:when (eq? name (variable-name var))) + var)) -(define/contract ($csp-vals csp name) +(define/contract (csp-domain prob name) (csp? name? . -> . (listof any/c)) - (check-name-in-csp! 'csp-vals csp name) - ($var-domain (csp-var csp name))) + (check-name-in-csp! 'csp-vals prob name) + (variable-domain (csp-var prob name))) (define order-domain-values values) -(define/contract (assigned-name? csp name) +(define/contract (assigned-name? prob name) (csp? name? . -> . any/c) - (for/or ([var (in-vars csp)] + (for/or ([var (in-vars prob)] #:when (assigned-var? var)) - (eq? name (var-name var)))) + (eq? name (variable-name var)))) -(define (reduce-function-arity proc pattern) +(define/contract (reduce-function-arity proc pattern) + (procedure? (listof any/c) . -> . procedure?) (unless (match (procedure-arity proc) [(arity-at-least val) (<= val (length pattern))] [(? number? val) (= val (length pattern))]) - (raise-argument-error 'reduce-arity (format "list of length ~a, same as procedure arity" (procedure-arity proc)) pattern)) + (raise-argument-error 'reduce-function-arity (format "list of length ~a, same as procedure arity" (procedure-arity proc)) pattern)) (define reduced-arity-name (string->symbol (format "reduced-arity-~a" (object-name proc)))) (define-values (boxed-id-names vals) (partition box? pattern)) (define new-arity (length boxed-id-names)) @@ -168,80 +171,82 @@ (values (cons (car vals) acc) xs (cdr vals)))))) reduced-arity-name)) -(define/contract (reduce-constraint-arity csp [minimum-arity 3]) +(define/contract (reduce-constraint-arity prob [minimum-arity 3]) ((csp?) ((or/c #false exact-nonnegative-integer?)) . ->* . csp?) - (let ([assigned-name? (curry assigned-name? csp)]) + (let ([assigned-name? (curry assigned-name? prob)]) (define (partially-assigned? constraint) - (ormap assigned-name? ($constraint-names constraint))) - (make-csp (vars csp) - (for/list ([constraint (in-constraints csp)]) - (cond - [(and (or (not minimum-arity) (<= minimum-arity (constraint-arity constraint))) - (partially-assigned? constraint)) - (match-define ($constraint cnames proc) constraint) - ($constraint (filter-not assigned-name? cnames) - ;; pattern is mix of values and boxed symbols (indicating variables to persist) - ;; use boxes here as cheap way to distinguish id symbols from value symbols - (let ([reduce-arity-pattern (for/list ([cname (in-list cnames)]) - (if (assigned-name? cname) - (first ($csp-vals csp cname)) - (box cname)))]) - (reduce-function-arity proc reduce-arity-pattern)))] - [else constraint]))))) + (ormap assigned-name? (constraint-names constraint))) + (make-csp (vars prob) + (for/list ([const (in-constraints prob)]) + (cond + [(and (or (not minimum-arity) (<= minimum-arity (constraint-arity const))) + (partially-assigned? const)) + (match-define (constraint cnames proc) const) + (constraint (filter-not assigned-name? cnames) + ;; pattern is mix of values and boxed symbols (indicating variables to persist) + ;; use boxes here as cheap way to distinguish id symbols from value symbols + (let ([reduce-arity-pattern (for/list ([cname (in-list cnames)]) + (if (assigned-name? cname) + (first (csp-domain prob cname)) + (box cname)))]) + (reduce-function-arity proc reduce-arity-pattern)))] + [else const]))))) (define nassns 0) + (define (reset-assns!) (set! nassns 0)) -(define/contract (assign-val csp name val) + +(define/contract (assign-val prob name val) (csp? name? any/c . -> . csp?) (when-debug (set! nassns (add1 nassns))) (make-csp - (for/list ([var (vars csp)]) - (if (eq? name (var-name var)) - ($avar name (list val)) - var)) - (constraints csp))) + (for/list ([var (vars prob)]) + (if (eq? name (variable-name var)) + (assigned-var name (list val)) + var)) + (constraints prob))) -(define/contract (unassigned-vars csp) - (csp? . -> . (listof (and/c $var? (not/c assigned-var?)))) - (filter-not assigned-var? (vars csp))) +(define/contract (unassigned-vars prob) + (csp? . -> . (listof (and/c variable? (not/c assigned-var?)))) + (filter-not assigned-var? (vars prob))) (define/contract (first-unassigned-variable csp) - (csp? . -> . (or/c #false (and/c $var? (not/c assigned-var?)))) + (csp? . -> . (or/c #false (and/c variable? (not/c assigned-var?)))) (match (unassigned-vars csp) [(? empty?) #false] [(cons x _) x])) -(define/contract (minimum-remaining-values csp) - (csp? . -> . (or/c #false (and/c $var? (not/c assigned-var?)))) - (match (unassigned-vars csp) +(define/contract (minimum-remaining-values prob) + (csp? . -> . (or/c #false (and/c variable? (not/c assigned-var?)))) + (match (unassigned-vars prob) [(? empty?) #false] - [xs (argmin (λ (var) (length ($var-domain var))) xs)])) + [xs (argmin (λ (var) (length (variable-domain var))) xs)])) (define mrv minimum-remaining-values) -(define/contract (var-degree csp var) - (csp? $var? . -> . exact-nonnegative-integer?) - (for/sum ([constraint (in-constraints csp)] - #:when (memq (var-name var) ($constraint-names constraint))) - 1)) +(define/contract (var-degree prob var) + (csp? variable? . -> . exact-nonnegative-integer?) + (for/sum ([const (in-constraints prob)] + #:when (memq (variable-name var) (constraint-names const))) + 1)) -(define/contract (blended-variable-selector csp) - (csp? . -> . (or/c #false (and/c $var? (not/c assigned-var?)))) - (define uvars (unassigned-vars csp)) +(define/contract (blended-variable-selector prob) + (csp? . -> . (or/c #false (and/c variable? (not/c assigned-var?)))) + (define uvars (unassigned-vars prob)) (cond [(empty? uvars) #false] [(findf singleton-var? uvars)] - [else (first (let* ([uvars-by-mrv (sort uvars < #:key (λ (var) (length ($var-domain var))))] - [uvars-by-degree (sort uvars-by-mrv > #:key (λ (var) (var-degree csp var)))]) + [else (first (let* ([uvars-by-mrv (sort uvars < #:key (λ (var) (length (variable-domain var))))] + [uvars-by-degree (sort uvars-by-mrv > #:key (λ (var) (var-degree prob var)))]) uvars-by-degree))])) (define/contract (remaining-values var) - ($var? . -> . exact-nonnegative-integer?) - (length ($var-vals var))) + (variable? . -> . exact-nonnegative-integer?) + (length (variable-domain var))) -(define/contract (mrv-degree-hybrid csp) - (csp? . -> . (or/c #f $var?)) - (define uvars (unassigned-vars csp)) +(define/contract (mrv-degree-hybrid prob) + (csp? . -> . (or/c #f variable?)) + (define uvars (unassigned-vars prob)) (cond [(empty? uvars) #false] [else @@ -251,66 +256,66 @@ [(list winning-uvar) winning-uvar] [(list mrv-uvars ...) ;; use degree as tiebreaker for mrv - (define degrees (map (λ (var) (var-degree csp var)) mrv-uvars)) + (define degrees (map (λ (var) (var-degree prob var)) mrv-uvars)) (define max-degree (apply max degrees)) ;; use random tiebreaker for degree (random-pick (for/list ([var (in-list mrv-uvars)] [degree (in-list degrees)] #:when (= max-degree degree)) - var))])])) + var))])])) (define first-domain-value values) -(define (no-inference csp name) csp) +(define (no-inference prob name) prob) (define/contract (relating-only constraints names) - ((listof $constraint?) (listof name?) . -> . (listof $constraint?)) - (for*/list ([constraint (in-list constraints)] - [cnames (in-value ($constraint-names constraint))] + ((listof constraint?) (listof name?) . -> . (listof constraint?)) + (for*/list ([const (in-list constraints)] + [cnames (in-value (constraint-names const))] #:when (and (= (length names) (length cnames)) (for/and ([name (in-list names)]) - (memq name cnames)))) - constraint)) + (memq name cnames)))) + const)) -(define (binary-constraint? constraint) - (= 2 (constraint-arity constraint))) +(define (binary-constraint? const) + (= 2 (constraint-arity const))) -(define (constraint-relates? constraint name) - (memq name ($constraint-names constraint))) +(define (constraint-relates? const name) + (memq name (constraint-names const))) (define nfchecks 0) (define (reset-nfcs!) (set! nfchecks 0)) -(define/contract (forward-check csp aname) +(define/contract (forward-check prob ref-name) (csp? name? . -> . csp?) - (define aval (first ($csp-vals csp aname))) + (define aval (first (csp-domain prob ref-name))) (define (check-var var) (match var ;; don't check against assigned vars, or the reference var ;; (which is probably assigned but maybe not) - [(? (λ (x) (or (assigned-var? x) (eq? (var-name x) aname)))) var] - [($var name vals) - (match ((constraints csp) . relating-only . (list aname name)) + [(? (λ (x) (or (assigned-var? x) (eq? (variable-name x) ref-name)))) var] + [(variable name vals) + (match ((constraints prob) . relating-only . (list ref-name name)) [(? empty?) var] [constraints (define new-vals (for/list ([val (in-list vals)] #:when (for/and ([constraint (in-list constraints)]) - (let ([proc ($constraint-proc constraint)]) - (if (eq? name (first ($constraint-names constraint))) - (proc val aval) - (proc aval val))))) - val)) - ($cvar name new-vals (cons aname (if ($cvar? var) - ($cvar-past var) + (let ([proc (constraint-proc constraint)]) + (if (eq? name (first (constraint-names constraint))) + (proc val aval) + (proc aval val))))) + val)) + (checked-var name new-vals (cons ref-name (if (checked-var? var) + (checked-var-past var) null)))])])) - (define checked-vars (map check-var (vars csp))) + (define checked-vars (map check-var (vars prob))) (when-debug (set! nfchecks (+ (length checked-vars) nchecks))) ;; conflict-set will be empty if there are no empty domains (define conflict-set (for*/list ([var (in-list checked-vars)] - #:when (empty? ($var-domain var)) - [name (in-list ($cvar-past var))]) - name)) + #:when (empty? (variable-domain var)) + [name (in-list (checked-var-past var))]) + name)) ;; for conflict-directed backjumping it's essential to forward-check ALL vars ;; (even after an empty domain is generated) and combine their conflicts ;; so we can discover the *most recent past var* that could be the culprit. @@ -321,87 +326,89 @@ ;; Discard constraints that have produced singleton domains ;; (they have no further use) (define nonsingleton-constraints - (for/list ([constraint (in-constraints csp)] + (for/list ([const (in-constraints prob)] #:unless (and - (binary-constraint? constraint) - (constraint-relates? constraint aname) - (let ([other-name (first (remq aname ($constraint-names constraint)))]) - (singleton-var? (csp-var csp other-name))))) - constraint)) + (binary-constraint? const) + (constraint-relates? const ref-name) + (let ([other-name (first (remq ref-name (constraint-names const)))]) + (singleton-var? (csp-var prob other-name))))) + const)) (make-csp checked-vars nonsingleton-constraints)) (define/contract (constraint-checkable? c names) - ($constraint? (listof name?) . -> . any/c) + (constraint? (listof name?) . -> . any/c) ;; constraint is checkable if all constraint names ;; are in target list of names. - (for/and ([cname (in-list ($constraint-names c))]) - (memq cname names))) + (for/and ([cname (in-list (constraint-names c))]) + (memq cname names))) -(define/contract (constraint-arity constraint) - ($constraint? . -> . exact-nonnegative-integer?) - (length ($constraint-names constraint))) +(define/contract (constraint-arity const) + (constraint? . -> . exact-nonnegative-integer?) + (length (constraint-names const))) (define (singleton-var? var) - (= 1 (length ($var-domain var)))) + (= 1 (length (variable-domain var)))) (define nchecks 0) (define (reset-nchecks!) (set! nchecks 0)) -(define/contract (check-constraints csp [mandatory-names #f] #:conflicts [conflict-count? #f]) +(define/contract (check-constraints prob [mandatory-names #f] #:conflicts [conflict-count? #f]) ((csp?) ((listof name?) #:conflicts boolean?) . ->* . (or/c csp? exact-nonnegative-integer?)) ;; this time, we're not limited to assigned variables ;; (that is, vars that have been deliberately assigned in the backtrack process thus far) ;; we also want to use "singleton" vars (that is, vars that have been reduced to a single domain value by forward checking) - (define singleton-varnames (for/list ([var (in-vars csp)] + (define singleton-varnames (for/list ([var (in-vars prob)] #:when (singleton-var? var)) - (var-name var))) - (define-values (checkable-constraints other-constraints) + (variable-name var))) + (define-values (checkable-consts other-consts) (partition (λ (c) (and (constraint-checkable? c singleton-varnames) (or (not mandatory-names) (for/and ([name (in-list mandatory-names)]) - (constraint-relates? c name))))) - (constraints csp))) + (constraint-relates? c name))))) + (constraints prob))) (cond - [conflict-count? (define conflict-count - (for/sum ([constraint (in-list checkable-constraints)] - #:unless (constraint csp)) - 1)) - (when-debug (set! nchecks (+ conflict-count nchecks))) - conflict-count] - [else (for ([(constraint idx) (in-indexed (sort checkable-constraints < #:key constraint-arity))] - #:unless (constraint csp)) - (when-debug (set! nchecks (+ (add1 idx) nchecks))) - (backtrack!)) - ;; discard checked constraints, since they have no further reason to live - (make-csp (vars csp) other-constraints)])) - -(define/contract (make-nodes-consistent csp) + [conflict-count? + (define conflict-count + (for/sum ([constraint (in-list checkable-consts)] + #:unless (constraint prob)) + 1)) + (when-debug (set! nchecks (+ conflict-count nchecks))) + conflict-count] + [else + (for ([(constraint idx) (in-indexed (sort checkable-consts < #:key constraint-arity))] + #:unless (constraint prob)) + (when-debug (set! nchecks (+ (add1 idx) nchecks))) + (backtrack!)) + ;; discard checked constraints, since they have no further reason to live + (make-csp (vars prob) other-consts)])) + +(define/contract (make-nodes-consistent prob) (csp? . -> . csp?) ;; todo: why does this function slow down searches? (make-csp - (for/list ([var (in-vars csp)]) - (match-define ($var name vals) var) - (define procs (for*/list ([constraint (in-constraints csp)] - [cnames (in-value ($constraint-names constraint))] - #:when (and (= 1 (length cnames)) (eq? name (car cnames)))) - ($constraint-proc constraint))) - ($var name - (for*/fold ([vals vals]) - ([proc (in-list procs)]) - (filter proc vals)))) - (constraints csp))) + (for/list ([var (in-vars prob)]) + (match-define (variable name vals) var) + (define procs (for*/list ([const (in-constraints prob)] + [cnames (in-value (constraint-names const))] + #:when (and (= 1 (length cnames)) (eq? name (car cnames)))) + (constraint-proc const))) + (variable name + (for*/fold ([vals vals]) + ([proc (in-list procs)]) + (filter proc vals)))) + (constraints prob))) (define/contract (backtracking-solver - csp + prob #:select-variable [select-unassigned-variable (or (current-select-variable) first-unassigned-variable)] #:order-values [order-domain-values (or (current-order-values) first-domain-value)] #:inference [inference (or (current-inference) no-inference)]) ((csp?) (#:select-variable procedure? #:order-values procedure? #:inference procedure?) . ->* . generator?) (generator () - (let loop ([csp csp]) - (match (select-unassigned-variable csp) - [#false (yield csp)] - [($var name domain) + (let loop ([prob prob]) + (match (select-unassigned-variable prob) + [#false (yield prob)] + [(variable name domain) (define (wants-backtrack? exn) (and ($backtrack? exn) (or (let ([btns ($backtrack-names exn)]) (or (empty? btns) (memq name btns)))))) @@ -410,83 +417,91 @@ ([val (in-list (order-domain-values domain))]) (with-handlers ([wants-backtrack? (λ (bt) (append conflicts (remq name ($backtrack-names bt))))]) - (let* ([csp (assign-val csp name val)] + (let* ([prob (assign-val prob name val)] ;; reduce constraints before inference, ;; to create more forward-checkable (binary) constraints - [csp (reduce-constraint-arity csp)] - [csp (inference csp name)] - [csp (check-constraints csp)]) - (loop csp))) + [prob (reduce-constraint-arity prob)] + [prob (inference prob name)] + [prob (check-constraints prob)]) + (loop prob))) conflicts)])))) (define (random-pick xs) (list-ref xs (random (length xs)))) -(define (assign-random-vals csp) - (for/fold ([new-csp csp]) - ([name (in-var-names csp)]) - (assign-val new-csp name (random-pick ($csp-vals csp name))))) +(define (assign-random-vals prob) + (for/fold ([new-csp prob]) + ([name (in-variable-names prob)]) + (assign-val new-csp name (random-pick (csp-domain prob name))))) -(define (make-min-conflcts-thread csp0 thread-count max-steps [main-thread (current-thread)]) +(define (make-min-conflcts-thread prob-start thread-count max-steps [main-thread (current-thread)]) (thread (λ () (let loop () ;; Generate a complete assignment for all variables (probably with conflicts) - (for/fold ([csp (assign-random-vals csp0)]) + (for/fold ([prob (assign-random-vals prob-start)]) ([nth-step (in-range max-steps)]) ;; Now repeatedly choose a random conflicted variable and change it - (match (conflicted-var-names csp) - [(? empty?) (thread-send main-thread csp) (loop)] + (match (conflicted-variable-names prob) + [(? empty?) (thread-send main-thread prob) (loop)] [names (define name (random-pick names)) - (define val (min-conflicts-value csp name ($csp-vals csp0 name))) - (assign-val csp name val)])))))) + (define val (min-conflicts-value prob name (csp-domain prob-start name))) + (assign-val prob name val)])))))) -(define/contract (min-conflicts-solver csp [max-steps 100]) - (($csp?) (integer?) . ->* . generator?) - ;; Solve a CSP by stochastic hillclimbing on the number of conflicts. +(define/contract (min-conflicts-solver prob [max-steps 100]) + ((csp?) (integer?) . ->* . generator?) (generator () (for ([thread-count 4]) ; todo: what is ideal thread count? - (make-min-conflcts-thread csp thread-count max-steps)) + (make-min-conflcts-thread prob thread-count max-steps)) (for ([i (in-naturals)]) - (yield (thread-receive))))) - -(define/contract (conflicted-var-names csp) - ($csp? . -> . (listof name?)) + (yield (thread-receive))))) + +(define/contract (optimal-stop-min proc xs) + (procedure? (listof any/c) . -> . any/c) + (define-values (sample candidates) (split-at xs (inexact->exact (floor (* .458 (length xs)))))) + (define threshold (argmin proc sample)) + (or (for/first ([c (in-list candidates)] + #:when (<= (proc c) threshold)) + c) + (last candidates))) + +(define/contract (conflicted-variable-names prob) + (csp? . -> . (listof name?)) ;; Return a list of variables in current assignment that are conflicted - (for/list ([name (in-var-names csp)] - #:when (positive? (nconflicts csp name))) - name)) + (for/list ([name (in-variable-names prob)] + #:when (positive? (nconflicts prob name))) + name)) -(define/contract (min-conflicts-value csp name vals) - ($csp? name? (listof any/c) . -> . any/c) +(define/contract (min-conflicts-value prob name vals) + (csp? name? (listof any/c) . -> . any/c) ;; Return the value that will give var the least number of conflicts - (define vals-by-conflict (sort vals < #:key (λ (val) (nconflicts csp name val)) + (define vals-by-conflict (sort vals < #:key (λ (val) (nconflicts prob name val)) #:cache-keys? #true)) (for/first ([val (in-list vals-by-conflict)] - #:unless (equal? val (first ($csp-vals csp name)))) ;; but change the value - val)) + #:unless (equal? val (first (csp-domain prob name)))) ;; but change the value + val)) (define no-value-sig (gensym)) -(define/contract (nconflicts csp name [val no-value-sig]) - (($csp? name?) (any/c) . ->* . exact-nonnegative-integer?) +(define/contract (nconflicts prob name [val no-value-sig]) + ((csp? name?) (any/c) . ->* . exact-nonnegative-integer?) ;; How many conflicts var: val assignment has with other variables. (check-constraints (if (eq? val no-value-sig) - csp - (assign-val csp name val)) (list name) #:conflicts #true)) + prob + (assign-val prob name val)) (list name) #:conflicts #true)) -(define/contract (csp->assocs csp) +(define/contract (csp->assocs prob) (csp? . -> . (listof (cons/c name? any/c))) - (for/list ([var (in-vars csp)]) - (match var - [($var name (list val)) (cons name val)]))) + (for/list ([var (in-vars prob)]) + (match var + [(variable name (list val)) (cons name val)]))) -(define/contract (combine-csps csps) - ((listof $csp?) . -> . $csp?) +(define/contract (combine-csps probs) + ((listof csp?) . -> . csp?) (make-csp - (apply append (map $csp-vars csps)) - (apply append (map $csp-constraints csps)))) + (apply append (map csp-vars probs)) + (apply append (map csp-constraints probs)))) (define/contract (make-cartesian-generator solgens) ((listof generator?) . -> . generator?) @@ -500,18 +515,18 @@ (for ([sol (in-stream (car solstreams))]) (loop (cdr solstreams) (cons sol sols))))))) -(define/contract (extract-subcsp csp names) - ($csp? (listof name?) . -> . $csp?) +(define/contract (extract-subcsp prob names) + (csp? (listof name?) . -> . csp?) (make-csp - (for/list ([var (in-vars csp)] - #:when (memq (var-name var) names)) - var) - (for/list ([constraint (in-constraints csp)] - #:when (for/and ([cname (in-list ($constraint-names constraint))]) - (memq cname names))) - constraint))) - -(define/contract (solve* csp + (for/list ([var (in-vars prob)] + #:when (memq (variable-name var) names)) + var) + (for/list ([const (in-constraints prob)] + #:when (for/and ([cname (in-list (constraint-names const))]) + (memq cname names))) + const))) + +(define/contract (solve* prob #:finish-proc [finish-proc csp->assocs] #:solver [solver (or (current-solver) backtracking-solver)] #:limit [max-solutions +inf.0]) @@ -521,21 +536,21 @@ (define subcsps ; decompose into independent csps. `cc` determines "connected components" (if (current-decompose) - (for/list ([nodeset (in-list (cc (csp->graph csp)))]) - (extract-subcsp csp nodeset)) - (list csp))) + (for/list ([nodeset (in-list (cc (csp->graph prob)))]) + (extract-subcsp prob nodeset)) + (list prob))) (for/list ([solution (in-producer (make-cartesian-generator (map solver subcsps)) (void))] [idx (in-range max-solutions)]) - (finish-proc solution))) + (finish-proc solution))) -(define/contract (solve csp +(define/contract (solve prob #:finish-proc [finish-proc csp->assocs] #:solver [solver (or (current-solver) backtracking-solver)] #:limit [max-solutions 1]) ((csp?) (#:finish-proc procedure? #:solver procedure? #:limit exact-nonnegative-integer?) . ->* . (or/c #false any/c)) - (match (solve* csp #:finish-proc finish-proc #:solver solver #:limit max-solutions) + (match (solve* prob #:finish-proc finish-proc #:solver solver #:limit max-solutions) [(list solution) solution] [(list solutions ...) solutions] [else #false])) diff --git a/csp/csp/info.rkt b/csp/csp/info.rkt new file mode 100644 index 00000000..9debf269 --- /dev/null +++ b/csp/csp/info.rkt @@ -0,0 +1,3 @@ +#lang info + +(define scribblings '(("scribblings/csp.scrbl" (multi-page)))) diff --git a/csp/csp/main.rkt b/csp/csp/main.rkt index f4d54358..334cb23a 100644 --- a/csp/csp/main.rkt +++ b/csp/csp/main.rkt @@ -1,4 +1,4 @@ #lang racket/base -(require "port/main.rkt") -(provide (all-from-out "port/main.rkt")) +(require "hacs.rkt") +(provide (all-from-out "hacs.rkt")) diff --git a/csp/csp/scribblings/csp.scrbl b/csp/csp/scribblings/csp.scrbl index 158d5897..6216c9da 100644 --- a/csp/csp/scribblings/csp.scrbl +++ b/csp/csp/scribblings/csp.scrbl @@ -5,15 +5,15 @@ @(define my-eval (make-base-eval)) @(my-eval `(require csp)) - -@title{csp} +@title{Constraint-satisfaction problems} @author[(author+email "Matthew Butterick" "mb@mbtype.com")] - @defmodule[csp] -A simple hyphenation engine that uses the Knuth–Liang hyphenation algorithm originally developed for TeX. I have added little to their work. Accordingly, I take little credit. +@margin-note{This package is in development. I make no commitment to maintaining the public interface documented below.} + +A simple solver for constraint-satisfaction problems. @section{Installation} diff --git a/csp/hacs-test-workbench.rkt b/csp/hacs-test-workbench.rkt deleted file mode 100644 index e8a05ca8..00000000 --- a/csp/hacs-test-workbench.rkt +++ /dev/null @@ -1,31 +0,0 @@ -#lang debug racket -(require sugar/debug "hacs.rkt") - -(current-inference forward-check) -(current-select-variable mrv) -(current-order-values shuffle) -(current-random #true) - -;; queens problem -;; place queens on chessboard so they do not intersect - -(define board-size 8) - -(define queens (make-csp)) -(define qs (for/list ([q board-size]) (string->symbol (format "q~a" q)))) -(define rows (range (length qs))) -(add-vars! queens qs rows) -(define (q-col q) (string->number (string-trim (symbol->string q) "q"))) -(for* ([qs (in-combinations qs 2)]) - (match-define (list qa qb) qs) - (match-define (list qa-col qb-col) (map q-col qs)) - (add-constraint! queens - (λ (qa-row qb-row) - (not (= (abs (- qa-row qb-row)) (abs (- (q-col qa) (q-col qb)))))) ; same diag? - (list qa qb)) - (add-constraint! queens (negate =) (list qa qb))) - -(current-multithreaded #t) -(time-avg 10 (solve queens)) -(parameterize ([current-solver min-conflicts-solver]) - (time-avg 10 (solve queens))) \ No newline at end of file diff --git a/csp/hacs.rkt b/csp/hacs.rkt deleted file mode 100644 index b9b85cbc..00000000 --- a/csp/hacs.rkt +++ /dev/null @@ -1,557 +0,0 @@ -#lang debug racket -(require racket/generator graph sugar/debug) -(provide (all-defined-out)) - -(define-syntax when-debug - (let () - (define debug #f) - (if debug - (make-rename-transformer #'begin) - (λ (stx) (syntax-case stx () - [(_ . rest) #'(void)]))))) - -(define-syntax-rule (in-cartesian x) - (in-generator (let ([argss x]) - (let loop ([argss argss][acc empty]) - (if (null? argss) - (yield (reverse acc)) - (for ([arg (in-list (car argss))]) - (loop (cdr argss) (cons arg acc)))))))) - -(struct $csp (vars - constraints - [assignments #:auto] - [checks #:auto]) #:mutable #:transparent - #:auto-value 0) -(define csp? $csp?) -(define vars $csp-vars) -(define constraints $csp-constraints) -(define-syntax-rule (in-constraints csp) (in-list ($csp-constraints csp))) -(define-syntax-rule (in-vars csp) (in-list ($csp-vars csp))) -(define-syntax-rule (in-var-names csp) (in-list (map $var-name ($csp-vars csp)))) - -(struct $constraint (names proc) #:transparent - #:property prop:procedure - (λ (constraint csp) - (unless ($csp? csp) - (raise-argument-error '$constraint-proc "$csp" csp)) - ;; apply proc in many-to-many style - (for/and ([args (in-cartesian (map (λ (cname) ($csp-vals csp cname)) ($constraint-names constraint)))]) - (apply ($constraint-proc constraint) args)))) - -(define (make-constraint [names null] [proc values]) - ($constraint names proc)) - -(define constraint-names $constraint-names) -(define constraint? $constraint?) - -(define (csp->graphviz csp) - (define g (csp->graph csp)) - (graphviz g #:colors (coloring/brelaz g))) - -(define (csp->graph csp) - (for*/fold ([g (unweighted-graph/undirected (map var-name (vars csp)))]) - ([constraint (in-constraints csp)] - [edge (in-combinations (constraint-names constraint) 2)]) - (apply add-edge! g edge) - g)) - -(struct $var (name domain) #:transparent) -(define var? $var?) -(define name? symbol?) -(define $var-vals $var-domain) -(define var-name $var-name) - -(struct $cvar $var (past) #:transparent) -(struct $avar $var () #:transparent) -(define assigned-var? $avar?) - -(define/contract (make-csp [vars null] [constraints null]) - (() ((listof var?) (listof constraint?)) . ->* . csp?) - ($csp vars constraints)) - -(define/contract (add-vars! csp names-or-procedure [vals-or-procedure empty]) - ((csp? (or/c (listof name?) procedure?)) ((or/c (listof any/c) procedure?)) . ->* . void?) - (for/fold ([vars ($csp-vars csp)] - #:result (set-$csp-vars! csp vars)) - ([name (in-list (if (procedure? names-or-procedure) - (names-or-procedure) - names-or-procedure))]) - (when (memq name (map var-name vars)) - (raise-argument-error 'add-vars! "var that doesn't already exist" name)) - (append vars (list ($var name - (if (procedure? vals-or-procedure) - (vals-or-procedure) - vals-or-procedure)))))) - -(define/contract (add-var! csp name [vals-or-procedure empty]) - ((csp? name?) ((or/c (listof any/c) procedure?)) . ->* . void?) - (add-vars! csp (list name) vals-or-procedure)) - -(define/contract (add-constraints! csp proc namess [proc-name #false]) - ((csp? procedure? (listof (listof name?))) ((or/c #false name?)) . ->* . void?) - (set-$csp-constraints! csp (append (constraints csp) - (for/list ([names (in-list namess)]) - (for ([name (in-list names)]) - (check-name-in-csp! 'add-constraints! csp name)) - (make-constraint names (if proc-name - (procedure-rename proc proc-name) - proc)))))) - -(define/contract (add-pairwise-constraint! csp proc var-names [proc-name #false]) - ((csp? procedure? (listof name?)) (name?) . ->* . void?) - (add-constraints! csp proc (combinations var-names 2) proc-name)) - -(define/contract (add-constraint! csp proc var-names [proc-name #false]) - ((csp? procedure? (listof name?)) (name?) . ->* . void?) - (add-constraints! csp proc (list var-names) proc-name)) - -(define/contract (alldiff= x y) - (any/c any/c . -> . boolean?) - (not (= x y))) - -(struct $backtrack (names) #:transparent) -(define (backtrack! [names null]) (raise ($backtrack names))) - -(define current-select-variable (make-parameter #f)) -(define current-order-values (make-parameter #f)) -(define current-inference (make-parameter #f)) -(define current-solver (make-parameter #f)) -(define current-random (make-parameter #t)) -(define current-decompose (make-parameter #t)) -(define current-multithreaded (make-parameter #t)) - -(define/contract (check-name-in-csp! caller csp name) - (symbol? csp? name? . -> . void?) - (define names (map var-name (vars csp))) - (unless (memq name names) - (raise-argument-error caller (format "one of these existing csp var names: ~v" names) name))) - -(define/contract (csp-var csp name) - (csp? name? . -> . $var?) - (check-name-in-csp! 'csp-var csp name) - (for/first ([var (in-vars csp)] - #:when (eq? name (var-name var))) - var)) - -(define/contract ($csp-vals csp name) - (csp? name? . -> . (listof any/c)) - (check-name-in-csp! 'csp-vals csp name) - ($var-domain (csp-var csp name))) - -(define order-domain-values values) - -(define/contract (assigned-name? csp name) - (csp? name? . -> . any/c) - (for/or ([var (in-vars csp)] - #:when (assigned-var? var)) - (eq? name (var-name var)))) - -(define (reduce-function-arity proc pattern) - (unless (match (procedure-arity proc) - [(arity-at-least val) (<= val (length pattern))] - [(? number? val) (= val (length pattern))]) - (raise-argument-error 'reduce-arity (format "list of length ~a, same as procedure arity" (procedure-arity proc)) pattern)) - (define reduced-arity-name (string->symbol (format "reduced-arity-~a" (object-name proc)))) - (define-values (boxed-id-names vals) (partition box? pattern)) - (define new-arity (length boxed-id-names)) - (procedure-rename - (λ xs - (unless (= (length xs) new-arity) - (apply raise-arity-error reduced-arity-name new-arity xs)) - (apply proc (for/fold ([acc empty] - [xs xs] - [vals vals] - #:result (reverse acc)) - ([pat-item (in-list pattern)]) - (if (box? pat-item) - (values (cons (car xs) acc) (cdr xs) vals) - (values (cons (car vals) acc) xs (cdr vals)))))) - reduced-arity-name)) - -(define/contract (reduce-constraint-arity csp [minimum-arity 3]) - ((csp?) ((or/c #false exact-nonnegative-integer?)) . ->* . csp?) - (let ([assigned-name? (curry assigned-name? csp)]) - (define (partially-assigned? constraint) - (ormap assigned-name? ($constraint-names constraint))) - (make-csp (vars csp) - (for/list ([constraint (in-constraints csp)]) - (cond - [(and (or (not minimum-arity) (<= minimum-arity (constraint-arity constraint))) - (partially-assigned? constraint)) - (match-define ($constraint cnames proc) constraint) - ($constraint (filter-not assigned-name? cnames) - ;; pattern is mix of values and boxed symbols (indicating variables to persist) - ;; use boxes here as cheap way to distinguish id symbols from value symbols - (let ([reduce-arity-pattern (for/list ([cname (in-list cnames)]) - (if (assigned-name? cname) - (first ($csp-vals csp cname)) - (box cname)))]) - (reduce-function-arity proc reduce-arity-pattern)))] - [else constraint]))))) - -(define nassns 0) -(define (reset-assns!) (set! nassns 0)) -(define/contract (assign-val csp name val) - (csp? name? any/c . -> . csp?) - (when-debug (set! nassns (add1 nassns))) - (make-csp - (for/list ([var (vars csp)]) - (if (eq? name (var-name var)) - ($avar name (list val)) - var)) - (constraints csp))) - -(define/contract (unassigned-vars csp) - (csp? . -> . (listof (and/c $var? (not/c assigned-var?)))) - (filter-not assigned-var? (vars csp))) - -(define/contract (first-unassigned-variable csp) - (csp? . -> . (or/c #false (and/c $var? (not/c assigned-var?)))) - (match (unassigned-vars csp) - [(? empty?) #false] - [(cons x _) x])) - -(define/contract (minimum-remaining-values csp) - (csp? . -> . (or/c #false (and/c $var? (not/c assigned-var?)))) - (match (unassigned-vars csp) - [(? empty?) #false] - [xs (argmin (λ (var) (length ($var-domain var))) xs)])) - -(define mrv minimum-remaining-values) - -(define/contract (var-degree csp var) - (csp? $var? . -> . exact-nonnegative-integer?) - (for/sum ([constraint (in-constraints csp)] - #:when (memq (var-name var) ($constraint-names constraint))) - 1)) - -(define/contract (blended-variable-selector csp) - (csp? . -> . (or/c #false (and/c $var? (not/c assigned-var?)))) - (define uvars (unassigned-vars csp)) - (cond - [(empty? uvars) #false] - [(findf singleton-var? uvars)] - [else (first (let* ([uvars-by-mrv (sort uvars < #:key (λ (var) (length ($var-domain var))))] - [uvars-by-degree (sort uvars-by-mrv > #:key (λ (var) (var-degree csp var)))]) - uvars-by-degree))])) - -(define/contract (remaining-values var) - ($var? . -> . exact-nonnegative-integer?) - (length ($var-vals var))) - -(define/contract (mrv-degree-hybrid csp) - (csp? . -> . (or/c #f $var?)) - (define uvars (unassigned-vars csp)) - (cond - [(empty? uvars) #false] - [else - ;; minimum remaining values (MRV) rule - (define mrv-arg (argmin remaining-values uvars)) - (match (filter (λ (var) (= (remaining-values mrv-arg) (remaining-values var))) uvars) - [(list winning-uvar) winning-uvar] - [(list mrv-uvars ...) - ;; use degree as tiebreaker for mrv - (define degrees (map (λ (var) (var-degree csp var)) mrv-uvars)) - (define max-degree (apply max degrees)) - ;; use random tiebreaker for degree - (random-pick (for/list ([var (in-list mrv-uvars)] - [degree (in-list degrees)] - #:when (= max-degree degree)) - var))])])) - -(define first-domain-value values) - -(define (no-inference csp name) csp) - -(define/contract (relating-only constraints names) - ((listof $constraint?) (listof name?) . -> . (listof $constraint?)) - (for*/list ([constraint (in-list constraints)] - [cnames (in-value ($constraint-names constraint))] - #:when (and (= (length names) (length cnames)) - (for/and ([name (in-list names)]) - (memq name cnames)))) - constraint)) - -(define (binary-constraint? constraint) - (= 2 (constraint-arity constraint))) - -(define (constraint-relates? constraint name) - (memq name ($constraint-names constraint))) - -(define nfchecks 0) -(define (reset-nfcs!) (set! nfchecks 0)) - -(define/contract (forward-check csp aname) - (csp? name? . -> . csp?) - (define aval (first ($csp-vals csp aname))) - (define (check-var var) - (match var - ;; don't check against assigned vars, or the reference var - ;; (which is probably assigned but maybe not) - [(? (λ (x) (or (assigned-var? x) (eq? (var-name x) aname)))) var] - [($var name vals) - (match ((constraints csp) . relating-only . (list aname name)) - [(? empty?) var] - [constraints - (define new-vals - (for/list ([val (in-list vals)] - #:when (for/and ([constraint (in-list constraints)]) - (let ([proc ($constraint-proc constraint)]) - (if (eq? name (first ($constraint-names constraint))) - (proc val aval) - (proc aval val))))) - val)) - ($cvar name new-vals (cons aname (if ($cvar? var) - ($cvar-past var) - null)))])])) - (define checked-vars (map check-var (vars csp))) - (when-debug (set! nfchecks (+ (length checked-vars) nchecks))) - ;; conflict-set will be empty if there are no empty domains - (define conflict-set (for*/list ([var (in-list checked-vars)] - #:when (empty? ($var-domain var)) - [name (in-list ($cvar-past var))]) - name)) - ;; for conflict-directed backjumping it's essential to forward-check ALL vars - ;; (even after an empty domain is generated) and combine their conflicts - ;; so we can discover the *most recent past var* that could be the culprit. - ;; If we just bail out at the first conflict, we may backjump too far based on its history - ;; (and thereby miss parts of the search tree) - (when (pair? conflict-set) - (backtrack! conflict-set)) - ;; Discard constraints that have produced singleton domains - ;; (they have no further use) - (define nonsingleton-constraints - (for/list ([constraint (in-constraints csp)] - #:unless (and - (binary-constraint? constraint) - (constraint-relates? constraint aname) - (let ([other-name (first (remq aname ($constraint-names constraint)))]) - (singleton-var? (csp-var csp other-name))))) - constraint)) - (make-csp checked-vars nonsingleton-constraints)) - -(define/contract (constraint-checkable? c names) - ($constraint? (listof name?) . -> . any/c) - ;; constraint is checkable if all constraint names - ;; are in target list of names. - (for/and ([cname (in-list ($constraint-names c))]) - (memq cname names))) - -(define/contract (constraint-arity constraint) - ($constraint? . -> . exact-nonnegative-integer?) - (length ($constraint-names constraint))) - -(define (singleton-var? var) - (= 1 (length ($var-domain var)))) - -(define nchecks 0) -(define (reset-nchecks!) (set! nchecks 0)) -(define/contract (check-constraints csp [mandatory-names #f] #:conflicts [conflict-count? #f]) - ((csp?) ((listof name?) #:conflicts boolean?) . ->* . (or/c csp? exact-nonnegative-integer?)) - ;; this time, we're not limited to assigned variables - ;; (that is, vars that have been deliberately assigned in the backtrack process thus far) - ;; we also want to use "singleton" vars (that is, vars that have been reduced to a single domain value by forward checking) - (define singleton-varnames (for/list ([var (in-vars csp)] - #:when (singleton-var? var)) - (var-name var))) - (define-values (checkable-constraints other-constraints) - (partition (λ (c) (and (constraint-checkable? c singleton-varnames) - (or (not mandatory-names) - (for/and ([name (in-list mandatory-names)]) - (constraint-relates? c name))))) - (constraints csp))) - (cond - [conflict-count? (define conflict-count - (for/sum ([constraint (in-list checkable-constraints)] - #:unless (constraint csp)) - 1)) - (when-debug (set! nchecks (+ conflict-count nchecks))) - conflict-count] - [else (for ([(constraint idx) (in-indexed (sort checkable-constraints < #:key constraint-arity))] - #:unless (constraint csp)) - (when-debug (set! nchecks (+ (add1 idx) nchecks))) - (backtrack!)) - ;; discard checked constraints, since they have no further reason to live - (make-csp (vars csp) other-constraints)])) - -(define/contract (make-nodes-consistent csp) - (csp? . -> . csp?) - ;; todo: why does this function slow down searches? - (make-csp - (for/list ([var (in-vars csp)]) - (match-define ($var name vals) var) - (define procs (for*/list ([constraint (in-constraints csp)] - [cnames (in-value ($constraint-names constraint))] - #:when (and (= 1 (length cnames)) (eq? name (car cnames)))) - ($constraint-proc constraint))) - ($var name - (for*/fold ([vals vals]) - ([proc (in-list procs)]) - (filter proc vals)))) - (constraints csp))) - -(define/contract (backtracking-solver - csp - #:select-variable [select-unassigned-variable - (or (current-select-variable) first-unassigned-variable)] - #:order-values [order-domain-values (or (current-order-values) first-domain-value)] - #:inference [inference (or (current-inference) no-inference)]) - ((csp?) (#:select-variable procedure? #:order-values procedure? #:inference procedure?) . ->* . generator?) - (generator () - (let loop ([csp csp]) - (match (select-unassigned-variable csp) - [#false (yield csp)] - [($var name domain) - (define (wants-backtrack? exn) - (and ($backtrack? exn) (or (let ([btns ($backtrack-names exn)]) - (or (empty? btns) (memq name btns)))))) - (for/fold ([conflicts null] - #:result (void)) - ([val (in-list (order-domain-values domain))]) - (with-handlers ([wants-backtrack? - (λ (bt) (append conflicts (remq name ($backtrack-names bt))))]) - (let* ([csp (assign-val csp name val)] - ;; reduce constraints before inference, - ;; to create more forward-checkable (binary) constraints - [csp (reduce-constraint-arity csp)] - [csp (inference csp name)] - [csp (check-constraints csp)]) - (loop csp))) - conflicts)])))) - -(define (random-pick xs) - (list-ref xs (random (length xs)))) - -(define (assign-random-vals csp) - (for/fold ([new-csp csp]) - ([name (in-var-names csp)]) - (assign-val new-csp name (random-pick ($csp-vals csp name))))) - -(define (make-min-conflcts-thread csp0 thread-count max-steps [main-thread (current-thread)]) - (thread - (λ () - (let loop () - ;; Generate a complete assignment for all variables (probably with conflicts) - (for/fold ([csp (assign-random-vals csp0)]) - ([nth-step (in-range max-steps)]) - ;; Now repeatedly choose a random conflicted variable and change it - (match (conflicted-var-names csp) - [(? empty?) (thread-send main-thread csp) (loop)] - [names - (define name (random-pick names)) - (define val (min-conflicts-value csp name ($csp-vals csp0 name))) - (assign-val csp name val)])))))) - -(define/contract (min-conflicts-solver csp [max-steps 100]) - (($csp?) (integer?) . ->* . generator?) - ;; Solve a CSP by stochastic hillclimbing on the number of conflicts. - (generator () - (for ([thread-count (if (current-multithreaded) 4 1)]) ; todo: what is ideal thread count? - (make-min-conflcts-thread csp thread-count max-steps)) - (for ([i (in-naturals)]) - (yield (thread-receive))))) - -(define/contract (conflicted-var-names csp) - ($csp? . -> . (listof name?)) - ;; Return a list of variables in current assignment that are conflicted - (for/list ([name (in-var-names csp)] - #:when (positive? (nconflicts csp name))) - name)) - -(define/contract (optimal-stop-min proc xs) - (procedure? (listof any/c) . -> . any/c) - (define-values (sample candidates) (split-at xs (inexact->exact (floor (* .458 (length xs)))))) - (define threshold (argmin proc sample)) - (or (for/first ([c (in-list candidates)] - #:when (<= (proc c) threshold)) - c) - (last candidates))) - - -(define/contract (min-conflicts-value csp name vals) - ($csp? name? (listof any/c) . -> . any/c) - ;; Return the value that will give var the least number of conflicts - #;(optimal-stop-min (λ (val) (nconflicts csp name val)) vals) - (define vals-by-conflict (sort vals < #:key (λ (val) (nconflicts csp name val)) - #:cache-keys? #true)) - (for/first ([val (in-list vals-by-conflict)] - #:unless (equal? val (first ($csp-vals csp name)))) ;; but change the value - val)) - -(define no-value-sig (gensym)) - -(define/contract (nconflicts csp name [val no-value-sig]) - (($csp? name?) (any/c) . ->* . exact-nonnegative-integer?) - ;; How many conflicts var: val assignment has with other variables. - (check-constraints (if (eq? val no-value-sig) - csp - (assign-val csp name val)) (list name) #:conflicts #true)) - -(define/contract (csp->assocs csp) - (csp? . -> . (listof (cons/c name? any/c))) - (for/list ([var (in-vars csp)]) - (match var - [($var name (list val)) (cons name val)]))) - -(define/contract (combine-csps csps) - ((listof $csp?) . -> . $csp?) - (make-csp - (apply append (map $csp-vars csps)) - (apply append (map $csp-constraints csps)))) - -(define/contract (make-cartesian-generator solgens) - ((listof generator?) . -> . generator?) - (generator () - (define solstreams (for/list ([solgen (in-list solgens)]) - (for/stream ([sol (in-producer solgen (void))]) - sol))) - (let loop ([solstreams solstreams][sols empty]) - (if (null? solstreams) - (yield (combine-csps (reverse sols))) - (for ([sol (in-stream (car solstreams))]) - (loop (cdr solstreams) (cons sol sols))))))) - -(define/contract (extract-subcsp csp names) - ($csp? (listof name?) . -> . $csp?) - (make-csp - (for/list ([var (in-vars csp)] - #:when (memq (var-name var) names)) - var) - (for/list ([constraint (in-constraints csp)] - #:when (for/and ([cname (in-list ($constraint-names constraint))]) - (memq cname names))) - constraint))) - -(define/contract (solve* csp - #:finish-proc [finish-proc csp->assocs] - #:solver [solver (or (current-solver) backtracking-solver)] - #:limit [max-solutions +inf.0]) - ((csp?) (#:finish-proc procedure? #:solver procedure? #:limit exact-nonnegative-integer?) - . ->* . (listof any/c)) - (when-debug (reset-assns!) (reset-nfcs!) (reset-nchecks!)) - - (define subcsps ; decompose into independent csps. `cc` determines "connected components" - (if (current-decompose) - (for/list ([nodeset (in-list (cc (csp->graph csp)))]) - (extract-subcsp csp nodeset)) - (list csp))) - - (for/list ([solution (in-producer (make-cartesian-generator (map solver subcsps)) (void))] - [idx (in-range max-solutions)]) - (finish-proc solution))) - -(define/contract (solve csp - #:finish-proc [finish-proc csp->assocs] - #:solver [solver (or (current-solver) backtracking-solver)] - #:limit [max-solutions 1]) - ((csp?) (#:finish-proc procedure? #:solver procedure? #:limit exact-nonnegative-integer?) - . ->* . (or/c #false any/c)) - (match (solve* csp #:finish-proc finish-proc #:solver solver #:limit max-solutions) - [(list solution) solution] - [(list solutions ...) solutions] - [else #false])) - -(define (<> a b) (not (= a b))) -(define (neq? a b) (not (eq? a b))) - diff --git a/csp/info.rkt b/csp/info.rkt index 5b7681d8..2e2dc245 100644 --- a/csp/info.rkt +++ b/csp/info.rkt @@ -1,6 +1,4 @@ #lang info (define collection 'multi) (define deps '(("base" #:version "6.0") "sugar" "rackunit-lib" "debug" "graph")) -(define update-implies '("sugar")) -(define scribblings '(("csp/scribblings/csp.scrbl" (multi-page)))) -;(define compile-omit-paths '("tests" "raco.rkt")) \ No newline at end of file +(define update-implies '("sugar")) \ No newline at end of file From 400b4849433d2d2b7163e46225fd770f025ffc66 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Mon, 22 Oct 2018 18:23:05 -0700 Subject: [PATCH 176/246] reality --- csp/csp/hacs-map.rkt | 10 +- csp/csp/hacs-test-queens.rkt | 31 ++++ csp/csp/hacs-test.rkt | 38 ++-- csp/csp/hacs.rkt | 334 +++++++++++++++++------------------ 4 files changed, 216 insertions(+), 197 deletions(-) create mode 100644 csp/csp/hacs-test-queens.rkt diff --git a/csp/csp/hacs-map.rkt b/csp/csp/hacs-map.rkt index 34450098..601f397b 100644 --- a/csp/csp/hacs-map.rkt +++ b/csp/csp/hacs-map.rkt @@ -4,13 +4,13 @@ (define (map-coloring-csp colors neighbors) - (define variables (remove-duplicates (flatten neighbors) eq?)) - (define vds (for/list ([var (in-list variables)]) - ($var var colors))) + (define names (remove-duplicates (flatten neighbors) eq?)) + (define vds (for/list ([name (in-list names)]) + (var name colors))) (define cs (for*/list ([neighbor neighbors] [target (cdr neighbor)]) - ($constraint (list (car neighbor) target) neq?))) - ($csp vds cs)) + (constraint (list (car neighbor) target) neq?))) + (csp vds cs)) (define (parse-colors str) (map string->symbol (map string-downcase (regexp-match* "." str)))) (define(parse-neighbors str) diff --git a/csp/csp/hacs-test-queens.rkt b/csp/csp/hacs-test-queens.rkt new file mode 100644 index 00000000..1bce97c7 --- /dev/null +++ b/csp/csp/hacs-test-queens.rkt @@ -0,0 +1,31 @@ +#lang debug racket +(require sugar/debug "hacs.rkt") + +(current-inference forward-check) +(current-select-variable mrv) +(current-order-values shuffle) +(current-random #true) + +;; queens problem +;; place queens on chessboard so they do not intersect + +(define board-size 8) + +(define queens (make-csp)) +(define qs (for/list ([q board-size]) (string->symbol (format "q~a" q)))) +(define rows (range (length qs))) +(add-vars! queens qs rows) +(define (q-col q) (string->number (string-trim (symbol->string q) "q"))) +(for* ([qs (in-combinations qs 2)]) + (match-define (list qa qb) qs) + (match-define (list qa-col qb-col) (map q-col qs)) + (add-constraint! queens + (λ (qa-row qb-row) + (not (= (abs (- qa-row qb-row)) (abs (- (q-col qa) (q-col qb)))))) ; same diag? + (list qa qb)) + (add-constraint! queens (negate =) (list qa qb))) + +(current-thread-count 4) +(time-avg 10 (solve queens)) +(parameterize ([current-solver min-conflicts-solver]) + (time-avg 10 (solve queens))) \ No newline at end of file diff --git a/csp/csp/hacs-test.rkt b/csp/csp/hacs-test.rkt index 73ff798f..47e48d61 100644 --- a/csp/csp/hacs-test.rkt +++ b/csp/csp/hacs-test.rkt @@ -6,60 +6,60 @@ (current-order-values shuffle) (current-random #true) -(check-equal? (first-unassigned-variable (csp (list (variable 'a (range 3)) (variable 'b (range 3))) null)) - (variable 'a (range 3))) -(check-equal? (first-unassigned-variable (csp (list (avar 'a (range 3)) (variable 'b (range 3))) null)) - (variable 'b (range 3))) +(check-equal? (first-unassigned-variable (csp (list (var 'a (range 3)) (var 'b (range 3))) null)) + (var 'a (range 3))) +(check-equal? (first-unassigned-variable (csp (list (avar 'a (range 3)) (var 'b (range 3))) null)) + (var 'b (range 3))) (check-false (first-unassigned-variable (csp (list (avar 'a (range 3)) (avar 'b (range 3))) null))) (check-equal? ;; no forward checking when no constraints - (csp-vars (forward-check (csp (list (avar 'a '(1)) (variable 'b (range 2))) null) 'a)) - (list (avar 'a '(1)) (variable 'b '(0 1)))) + (csp-vars (forward-check (csp (list (avar 'a '(1)) (var 'b (range 2))) null) 'a)) + (list (avar 'a '(1)) (var 'b '(0 1)))) (check-equal? - (csp-vars (forward-check (forward-check (csp (list (avar 'a '(1)) (avar 'b '(0)) (variable 'c '(0 1 2))) + (csp-vars (forward-check (forward-check (csp (list (avar 'a '(1)) (avar 'b '(0)) (var 'c '(0 1 2))) (list (constraint '(a c) (negate =)) (constraint '(b c) (negate =)))) 'a) 'b)) (list (avar 'a '(1)) (avar 'b '(0)) (cvar 'c '(2) '(b a)))) (check-equal? ;; no inconsistency: b≠c not checked when fc is relative to a - (csp-vars (forward-check (csp (list (avar 'a '(1)) (variable 'b (range 2)) (variable 'c '(0))) + (csp-vars (forward-check (csp (list (avar 'a '(1)) (var 'b (range 2)) (var 'c '(0))) (list (constraint '(a b) (negate =)) (constraint '(b c) (negate =)))) 'a)) - (list (avar 'a '(1)) (cvar 'b '(0) '(a)) (variable 'c '(0)))) + (list (avar 'a '(1)) (cvar 'b '(0) '(a)) (var 'c '(0)))) (check-equal? ;; no inconsistency: a≠b not checked when fc ignores a, which is already assigned - (csp-vars (forward-check (csp (list (avar 'a '(1)) (avar 'b '(1)) (variable 'c (range 2))) + (csp-vars (forward-check (csp (list (avar 'a '(1)) (avar 'b '(1)) (var 'c (range 2))) (list (constraint '(a b) (negate =)) (constraint '(b c) (negate =)))) 'b)) (list (avar 'a '(1)) (avar 'b '(1)) (cvar 'c '(0) '(b)))) -(check-exn $backtrack? +(check-exn backtrack? (λ () (csp-vars (forward-check (csp (list (avar 'a '(1)) - (variable 'b '(1))) + (var 'b '(1))) (list (constraint '(a b) (negate =)))) 'a)))) -(check-equal? (csp-vars (forward-check (csp (list (variable 'a '(0)) - (variable 'b (range 3))) +(check-equal? (csp-vars (forward-check (csp (list (var 'a '(0)) + (var 'b (range 3))) (list (constraint '(a b) <))) 'a)) - (list (variable 'a '(0)) (cvar 'b '(1 2) '(a)))) + (list (var 'a '(0)) (cvar 'b '(1 2) '(a)))) (check-equal? (parameterize ([current-inference forward-check]) - (length (solve* (csp (list (variable 'x (range 3)) - (variable 'y (range 3)) - (variable 'z (range 3))) + (length (solve* (csp (list (var 'x (range 3)) + (var 'y (range 3)) + (var 'z (range 3))) (list (constraint '(x y) <>) (constraint '(x z) <>) (constraint '(y z) <>)))))) 6) (parameterize ([current-inference forward-check]) (define vds (for/list ([k '(wa nt nsw q t v sa)]) - (variable k '(red green blue)))) + (var k '(red green blue)))) (define cs (list (constraint '(wa nt) neq?) (constraint '(wa sa) neq?) diff --git a/csp/csp/hacs.rkt b/csp/csp/hacs.rkt index 8d21eccc..8ce556e3 100644 --- a/csp/csp/hacs.rkt +++ b/csp/csp/hacs.rkt @@ -18,87 +18,85 @@ (for ([arg (in-list (car argss))]) (loop (cdr argss) (cons arg acc)))))))) -(struct csp (vars - constraints - [assignments #:auto] - [checks #:auto]) #:mutable #:transparent - #:auto-value 0) -(define vars csp-vars) +(struct csp (vars constraints [assignments #:auto] [checks #:auto]) + #:mutable #:transparent #:auto-value 0) (define constraints csp-constraints) +(define vars csp-vars) (define-syntax-rule (in-constraints csp) (in-list (csp-constraints csp))) -(define-syntax-rule (in-vars csp) (in-list (csp-vars csp))) -(define-syntax-rule (in-variable-names csp) (in-list (map variable-name (csp-vars csp)))) +(define-syntax-rule (in-vars csp) (in-list (vars csp))) +(define-syntax-rule (in-variable-names csp) (in-list (map var-name (vars csp)))) (struct constraint (names proc) #:transparent #:property prop:procedure (λ (const prob) (unless (csp? prob) - (raise-argument-error '$constraint-proc "$csp" prob)) + (raise-argument-error 'constraint-proc "csp" prob)) ;; apply proc in many-to-many style - (for/and ([args (in-cartesian (map (λ (name) (csp-domain prob name)) (constraint-names const)))]) + (for/and ([args (in-cartesian (map (λ (name) (find-domain prob name)) (constraint-names const)))]) (apply (constraint-proc const) args)))) -(define (make-constraint [names null] [proc values]) - (constraint names proc)) +(define name? symbol?) +(define/contract (make-constraint [names null] [proc values]) + (() ((listof name?) procedure?) . ->* . constraint?) + (constraint names proc)) -(define (csp->graphviz prob) +(define/contract (csp->graphviz prob) + (csp? . -> . string?) (define g (csp->graph prob)) (graphviz g #:colors (coloring/brelaz g))) -(define (csp->graph prob) - (for*/fold ([gr (unweighted-graph/undirected (map variable-name (vars prob)))]) +(define/contract (csp->graph prob) + (csp? . -> . graph?) + (for*/fold ([gr (unweighted-graph/undirected (map var-name (vars prob)))]) ([constraint (in-constraints prob)] [edge (in-combinations (constraint-names constraint) 2)]) (apply add-edge! gr edge) gr)) -(struct variable (name domain) #:transparent) -(define name? symbol?) +(struct var (name domain) #:transparent) +(define domain var-domain) -(struct checked-var variable (past) #:transparent) -(define cvar checked-var) -(define cvar? checked-var?) +(struct checked-variable var (history) #:transparent) +(define history checked-variable-history) +(define cvar checked-variable) +(define cvar? checked-variable?) -(struct assigned-var variable () #:transparent) +(struct assigned-var var () #:transparent) (define avar assigned-var) (define avar? assigned-var?) (define/contract (make-csp [vars null] [consts null]) - (() ((listof variable?) (listof constraint?)) . ->* . csp?) + (() ((listof var?) (listof constraint?)) . ->* . csp?) (csp vars consts)) -(define/contract (add-variables! prob names-or-procedure [vals-or-procedure empty]) +(define/contract (add-vars! prob names-or-procedure [vals-or-procedure empty]) ((csp? (or/c (listof name?) procedure?)) ((or/c (listof any/c) procedure?)) . ->* . void?) - (for/fold ([vars (csp-vars prob)] - #:result (set-csp-vars! prob vars)) + (for/fold ([vrs (vars prob)] + #:result (set-csp-vars! prob vrs)) ([name (in-list (if (procedure? names-or-procedure) (names-or-procedure) names-or-procedure))]) - (when (memq name (map variable-name vars)) + (when (memq name (map var-name vrs)) (raise-argument-error 'add-vars! "var that doesn't already exist" name)) - (append vars (list (variable name - (if (procedure? vals-or-procedure) - (vals-or-procedure) - vals-or-procedure)))))) + (append vrs (list (var name + (if (procedure? vals-or-procedure) + (vals-or-procedure) + vals-or-procedure)))))) -(define add-vars! add-variables!) - -(define/contract (add-variable! prob name [vals-or-procedure empty]) +(define/contract (add-var! prob name [vals-or-procedure empty]) ((csp? name?) ((or/c (listof any/c) procedure?)) . ->* . void?) (add-vars! prob (list name) vals-or-procedure)) -(define add-var! add-variable!) - (define/contract (add-constraints! prob proc namess [proc-name #false]) ((csp? procedure? (listof (listof name?))) ((or/c #false name?)) . ->* . void?) (set-csp-constraints! prob (append (constraints prob) - (for/list ([names (in-list namess)]) - (for ([name (in-list names)]) - (check-name-in-csp! 'add-constraints! prob name)) - (make-constraint names (if proc-name - (procedure-rename proc proc-name) - proc)))))) + (for/list ([names (in-list namess)]) + (for ([name (in-list names)]) + (check-name-in-csp! 'add-constraints! prob name)) + (make-constraint names (if proc-name + (procedure-rename proc proc-name) + proc)))))) (define/contract (add-pairwise-constraint! prob proc var-names [proc-name #false]) ((csp? procedure? (listof name?)) (name?) . ->* . void?) @@ -112,8 +110,8 @@ (any/c any/c . -> . boolean?) (not (= x y))) -(struct $backtrack (names) #:transparent) -(define (backtrack! [names null]) (raise ($backtrack names))) +(struct backtrack (names) #:transparent) +(define (backtrack! [names null]) (raise (backtrack names))) (define current-select-variable (make-parameter #f)) (define current-order-values (make-parameter #f)) @@ -121,32 +119,33 @@ (define current-solver (make-parameter #f)) (define current-random (make-parameter #t)) (define current-decompose (make-parameter #t)) +(define current-thread-count (make-parameter 4)) (define/contract (check-name-in-csp! caller prob name) (symbol? csp? name? . -> . void?) - (define names (map variable-name (vars prob))) + (define names (map var-name (vars prob))) (unless (memq name names) (raise-argument-error caller (format "one of these existing csp var names: ~v" names) name))) -(define/contract (csp-var prob name) - (csp? name? . -> . variable?) - (check-name-in-csp! 'csp-var prob name) - (for/first ([var (in-vars prob)] - #:when (eq? name (variable-name var))) - var)) +(define/contract (find-var prob name) + (csp? name? . -> . var?) + (check-name-in-csp! 'find-var prob name) + (for/first ([vr (in-vars prob)] + #:when (eq? name (var-name vr))) + vr)) -(define/contract (csp-domain prob name) +(define/contract (find-domain prob name) (csp? name? . -> . (listof any/c)) - (check-name-in-csp! 'csp-vals prob name) - (variable-domain (csp-var prob name))) + (check-name-in-csp! 'find-domain prob name) + (domain (find-var prob name))) (define order-domain-values values) (define/contract (assigned-name? prob name) (csp? name? . -> . any/c) - (for/or ([var (in-vars prob)] - #:when (assigned-var? var)) - (eq? name (variable-name var)))) + (for/or ([vr (in-vars prob)] + #:when (assigned-var? vr)) + (eq? name (var-name vr)))) (define/contract (reduce-function-arity proc pattern) (procedure? (listof any/c) . -> . procedure?) @@ -172,97 +171,91 @@ reduced-arity-name)) (define/contract (reduce-constraint-arity prob [minimum-arity 3]) - ((csp?) ((or/c #false exact-nonnegative-integer?)) . ->* . csp?) - (let ([assigned-name? (curry assigned-name? prob)]) - (define (partially-assigned? constraint) - (ormap assigned-name? (constraint-names constraint))) - (make-csp (vars prob) - (for/list ([const (in-constraints prob)]) - (cond - [(and (or (not minimum-arity) (<= minimum-arity (constraint-arity const))) - (partially-assigned? const)) - (match-define (constraint cnames proc) const) - (constraint (filter-not assigned-name? cnames) - ;; pattern is mix of values and boxed symbols (indicating variables to persist) - ;; use boxes here as cheap way to distinguish id symbols from value symbols - (let ([reduce-arity-pattern (for/list ([cname (in-list cnames)]) - (if (assigned-name? cname) - (first (csp-domain prob cname)) - (box cname)))]) - (reduce-function-arity proc reduce-arity-pattern)))] - [else const]))))) + ((csp?) ((or/c #false natural?)) . ->* . csp?) + (define assigned? (curry assigned-name? prob)) + (define (partially-assigned? constraint) + (ormap assigned? (constraint-names constraint))) + (make-csp (vars prob) + (for/list ([const (in-constraints prob)]) + (cond + ;; no point reducing 2-arity functions because they will be consumed by forward checking + [(and (or (not minimum-arity) (<= minimum-arity (constraint-arity const))) + (partially-assigned? const)) + (match-define (constraint cnames proc) const) + ;; pattern is mix of values and boxed symbols (indicating variables to persist) + ;; use boxes here as cheap way to distinguish id symbols from value symbols + (define reduce-arity-pattern (for/list ([cname (in-list cnames)]) + (if (assigned? cname) + (first (find-domain prob cname)) + (box cname)))) + (constraint (filter-not assigned? cnames) + (reduce-function-arity proc reduce-arity-pattern))] + [else const])))) (define nassns 0) (define (reset-assns!) (set! nassns 0)) +(define nfchecks 0) + +(define (reset-nfcs!) (set! nfchecks 0)) + (define/contract (assign-val prob name val) (csp? name? any/c . -> . csp?) (when-debug (set! nassns (add1 nassns))) (make-csp - (for/list ([var (vars prob)]) - (if (eq? name (variable-name var)) + (for/list ([vr (vars prob)]) + (if (eq? name (var-name vr)) (assigned-var name (list val)) - var)) + vr)) (constraints prob))) (define/contract (unassigned-vars prob) - (csp? . -> . (listof (and/c variable? (not/c assigned-var?)))) + (csp? . -> . (listof (and/c var? (not/c assigned-var?)))) (filter-not assigned-var? (vars prob))) (define/contract (first-unassigned-variable csp) - (csp? . -> . (or/c #false (and/c variable? (not/c assigned-var?)))) + (csp? . -> . (or/c #false (and/c var? (not/c assigned-var?)))) (match (unassigned-vars csp) [(? empty?) #false] - [(cons x _) x])) + [xs (first xs)])) (define/contract (minimum-remaining-values prob) - (csp? . -> . (or/c #false (and/c variable? (not/c assigned-var?)))) + (csp? . -> . (or/c #false (and/c var? (not/c assigned-var?)))) (match (unassigned-vars prob) [(? empty?) #false] - [xs (argmin (λ (var) (length (variable-domain var))) xs)])) + [xs (argmin (λ (var) (length (domain var))) xs)])) (define mrv minimum-remaining-values) (define/contract (var-degree prob var) - (csp? variable? . -> . exact-nonnegative-integer?) + (csp? var? . -> . natural?) (for/sum ([const (in-constraints prob)] - #:when (memq (variable-name var) (constraint-names const))) + #:when (memq (var-name var) (constraint-names const))) 1)) -(define/contract (blended-variable-selector prob) - (csp? . -> . (or/c #false (and/c variable? (not/c assigned-var?)))) - (define uvars (unassigned-vars prob)) - (cond - [(empty? uvars) #false] - [(findf singleton-var? uvars)] - [else (first (let* ([uvars-by-mrv (sort uvars < #:key (λ (var) (length (variable-domain var))))] - [uvars-by-degree (sort uvars-by-mrv > #:key (λ (var) (var-degree prob var)))]) - uvars-by-degree))])) - -(define/contract (remaining-values var) - (variable? . -> . exact-nonnegative-integer?) - (length (variable-domain var))) +(define/contract (domain-length var) + (var? . -> . natural?) + (length (domain var))) (define/contract (mrv-degree-hybrid prob) - (csp? . -> . (or/c #f variable?)) - (define uvars (unassigned-vars prob)) - (cond - [(empty? uvars) #false] - [else + (csp? . -> . (or/c #f var?)) + (match (unassigned-vars prob) + [(? empty?) #false] + [uvars ;; minimum remaining values (MRV) rule - (define mrv-arg (argmin remaining-values uvars)) - (match (filter (λ (var) (= (remaining-values mrv-arg) (remaining-values var))) uvars) + (define mrv-arg (argmin domain-length uvars)) + (match (filter (λ (var) (= (domain-length mrv-arg) (domain-length var))) uvars) [(list winning-uvar) winning-uvar] [(list mrv-uvars ...) ;; use degree as tiebreaker for mrv (define degrees (map (λ (var) (var-degree prob var)) mrv-uvars)) (define max-degree (apply max degrees)) ;; use random tiebreaker for degree - (random-pick (for/list ([var (in-list mrv-uvars)] + (random-pick (for/list ([uv (in-list mrv-uvars)] [degree (in-list degrees)] #:when (= max-degree degree)) - var))])])) + uv))])])) (define first-domain-value values) @@ -277,44 +270,40 @@ (memq name cnames)))) const)) -(define (binary-constraint? const) - (= 2 (constraint-arity const))) +(define (two-arity? const) (= 2 (constraint-arity const))) (define (constraint-relates? const name) (memq name (constraint-names const))) -(define nfchecks 0) -(define (reset-nfcs!) (set! nfchecks 0)) - (define/contract (forward-check prob ref-name) (csp? name? . -> . csp?) - (define aval (first (csp-domain prob ref-name))) - (define (check-var var) - (match var + (define aval (first (find-domain prob ref-name))) + (define (check-var v) + (match v ;; don't check against assigned vars, or the reference var ;; (which is probably assigned but maybe not) - [(? (λ (x) (or (assigned-var? x) (eq? (variable-name x) ref-name)))) var] - [(variable name vals) + [(? (λ (x) (or (assigned-var? x) (eq? (var-name x) ref-name)))) v] + [(var name vals) (match ((constraints prob) . relating-only . (list ref-name name)) - [(? empty?) var] + [(? empty?) v] [constraints (define new-vals (for/list ([val (in-list vals)] - #:when (for/and ([constraint (in-list constraints)]) - (let ([proc (constraint-proc constraint)]) - (if (eq? name (first (constraint-names constraint))) + #:when (for/and ([const (in-list constraints)]) + (let ([proc (constraint-proc const)]) + (if (eq? name (first (constraint-names const))) (proc val aval) (proc aval val))))) val)) - (checked-var name new-vals (cons ref-name (if (checked-var? var) - (checked-var-past var) - null)))])])) + (checked-variable name new-vals (cons ref-name (match v + [(checked-variable _ _ history) history] + [else null])))])])) (define checked-vars (map check-var (vars prob))) (when-debug (set! nfchecks (+ (length checked-vars) nchecks))) - ;; conflict-set will be empty if there are no empty domains - (define conflict-set (for*/list ([var (in-list checked-vars)] - #:when (empty? (variable-domain var)) - [name (in-list (checked-var-past var))]) + ;; conflict-set will be empty if there are no empty domains (as we would hope) + (define conflict-set (for*/list ([cv (in-list checked-vars)] + #:when (empty? (domain cv)) + [name (in-list (history cv))]) name)) ;; for conflict-directed backjumping it's essential to forward-check ALL vars ;; (even after an empty domain is generated) and combine their conflicts @@ -327,43 +316,42 @@ ;; (they have no further use) (define nonsingleton-constraints (for/list ([const (in-constraints prob)] - #:unless (and - (binary-constraint? const) - (constraint-relates? const ref-name) - (let ([other-name (first (remq ref-name (constraint-names const)))]) - (singleton-var? (csp-var prob other-name))))) + #:unless (and (two-arity? const) + (constraint-relates? const ref-name) + (let ([other-name (first (remq ref-name (constraint-names const)))]) + (singleton-var? (find-var prob other-name))))) const)) (make-csp checked-vars nonsingleton-constraints)) -(define/contract (constraint-checkable? c names) +(define/contract (constraint-checkable? const names) (constraint? (listof name?) . -> . any/c) ;; constraint is checkable if all constraint names ;; are in target list of names. - (for/and ([cname (in-list (constraint-names c))]) + (for/and ([cname (in-list (constraint-names const))]) (memq cname names))) (define/contract (constraint-arity const) - (constraint? . -> . exact-nonnegative-integer?) + (constraint? . -> . natural?) (length (constraint-names const))) (define (singleton-var? var) - (= 1 (length (variable-domain var)))) + (= 1 (domain-length var))) (define nchecks 0) (define (reset-nchecks!) (set! nchecks 0)) (define/contract (check-constraints prob [mandatory-names #f] #:conflicts [conflict-count? #f]) - ((csp?) ((listof name?) #:conflicts boolean?) . ->* . (or/c csp? exact-nonnegative-integer?)) + ((csp?) ((listof name?) #:conflicts boolean?) . ->* . (or/c csp? natural?)) ;; this time, we're not limited to assigned variables ;; (that is, vars that have been deliberately assigned in the backtrack process thus far) ;; we also want to use "singleton" vars (that is, vars that have been reduced to a single domain value by forward checking) - (define singleton-varnames (for/list ([var (in-vars prob)] - #:when (singleton-var? var)) - (variable-name var))) + (define singleton-varnames (for/list ([vr (in-vars prob)] + #:when (singleton-var? vr)) + (var-name vr))) (define-values (checkable-consts other-consts) - (partition (λ (c) (and (constraint-checkable? c singleton-varnames) - (or (not mandatory-names) - (for/and ([name (in-list mandatory-names)]) - (constraint-relates? c name))))) + (partition (λ (const) (and (constraint-checkable? const singleton-varnames) + (or (not mandatory-names) + (for/and ([name (in-list mandatory-names)]) + (constraint-relates? const name))))) (constraints prob))) (cond [conflict-count? @@ -374,7 +362,7 @@ (when-debug (set! nchecks (+ conflict-count nchecks))) conflict-count] [else - (for ([(constraint idx) (in-indexed (sort checkable-consts < #:key constraint-arity))] + (for ([(constraint idx) (in-indexed checkable-consts)] #:unless (constraint prob)) (when-debug (set! nchecks (+ (add1 idx) nchecks))) (backtrack!)) @@ -385,16 +373,16 @@ (csp? . -> . csp?) ;; todo: why does this function slow down searches? (make-csp - (for/list ([var (in-vars prob)]) - (match-define (variable name vals) var) + (for/list ([vr (in-vars prob)]) + (match-define (var name vals) vr) (define procs (for*/list ([const (in-constraints prob)] [cnames (in-value (constraint-names const))] #:when (and (= 1 (length cnames)) (eq? name (car cnames)))) (constraint-proc const))) - (variable name - (for*/fold ([vals vals]) - ([proc (in-list procs)]) - (filter proc vals)))) + (var name + (for*/fold ([vals vals]) + ([proc (in-list procs)]) + (filter proc vals)))) (constraints prob))) (define/contract (backtracking-solver @@ -408,15 +396,15 @@ (let loop ([prob prob]) (match (select-unassigned-variable prob) [#false (yield prob)] - [(variable name domain) + [(var name domain) (define (wants-backtrack? exn) - (and ($backtrack? exn) (or (let ([btns ($backtrack-names exn)]) - (or (empty? btns) (memq name btns)))))) + (and (backtrack? exn) (or (let ([btns (backtrack-names exn)]) + (or (empty? btns) (memq name btns)))))) (for/fold ([conflicts null] #:result (void)) ([val (in-list (order-domain-values domain))]) (with-handlers ([wants-backtrack? - (λ (bt) (append conflicts (remq name ($backtrack-names bt))))]) + (λ (bt) (append conflicts (remq name (backtrack-names bt))))]) (let* ([prob (assign-val prob name val)] ;; reduce constraints before inference, ;; to create more forward-checkable (binary) constraints @@ -432,7 +420,7 @@ (define (assign-random-vals prob) (for/fold ([new-csp prob]) ([name (in-variable-names prob)]) - (assign-val new-csp name (random-pick (csp-domain prob name))))) + (assign-val new-csp name (random-pick (find-domain prob name))))) (define (make-min-conflcts-thread prob-start thread-count max-steps [main-thread (current-thread)]) (thread @@ -446,13 +434,13 @@ [(? empty?) (thread-send main-thread prob) (loop)] [names (define name (random-pick names)) - (define val (min-conflicts-value prob name (csp-domain prob-start name))) + (define val (min-conflicts-value prob name (find-domain prob-start name))) (assign-val prob name val)])))))) (define/contract (min-conflicts-solver prob [max-steps 100]) ((csp?) (integer?) . ->* . generator?) (generator () - (for ([thread-count 4]) ; todo: what is ideal thread count? + (for ([thread-count (or (current-thread-count) 1)]) ; todo: what is ideal thread count? (make-min-conflcts-thread prob thread-count max-steps)) (for ([i (in-naturals)]) (yield (thread-receive))))) @@ -461,9 +449,9 @@ (procedure? (listof any/c) . -> . any/c) (define-values (sample candidates) (split-at xs (inexact->exact (floor (* .458 (length xs)))))) (define threshold (argmin proc sample)) - (or (for/first ([c (in-list candidates)] - #:when (<= (proc c) threshold)) - c) + (or (for/first ([candidate (in-list candidates)] + #:when (<= (proc candidate) threshold)) + candidate) (last candidates))) (define/contract (conflicted-variable-names prob) @@ -479,13 +467,13 @@ (define vals-by-conflict (sort vals < #:key (λ (val) (nconflicts prob name val)) #:cache-keys? #true)) (for/first ([val (in-list vals-by-conflict)] - #:unless (equal? val (first (csp-domain prob name)))) ;; but change the value + #:unless (equal? val (first (find-domain prob name)))) ;; but change the value val)) (define no-value-sig (gensym)) (define/contract (nconflicts prob name [val no-value-sig]) - ((csp? name?) (any/c) . ->* . exact-nonnegative-integer?) + ((csp? name?) (any/c) . ->* . natural?) ;; How many conflicts var: val assignment has with other variables. (check-constraints (if (eq? val no-value-sig) prob @@ -493,14 +481,14 @@ (define/contract (csp->assocs prob) (csp? . -> . (listof (cons/c name? any/c))) - (for/list ([var (in-vars prob)]) - (match var - [(variable name (list val)) (cons name val)]))) + (for/list ([vr (in-vars prob)]) + (match vr + [(var name (list val)) (cons name val)]))) (define/contract (combine-csps probs) ((listof csp?) . -> . csp?) (make-csp - (apply append (map csp-vars probs)) + (apply append (map vars probs)) (apply append (map csp-constraints probs)))) (define/contract (make-cartesian-generator solgens) @@ -518,9 +506,9 @@ (define/contract (extract-subcsp prob names) (csp? (listof name?) . -> . csp?) (make-csp - (for/list ([var (in-vars prob)] - #:when (memq (variable-name var) names)) - var) + (for/list ([vr (in-vars prob)] + #:when (memq (var-name vr) names)) + vr) (for/list ([const (in-constraints prob)] #:when (for/and ([cname (in-list (constraint-names const))]) (memq cname names))) @@ -530,7 +518,7 @@ #:finish-proc [finish-proc csp->assocs] #:solver [solver (or (current-solver) backtracking-solver)] #:limit [max-solutions +inf.0]) - ((csp?) (#:finish-proc procedure? #:solver procedure? #:limit exact-nonnegative-integer?) + ((csp?) (#:finish-proc procedure? #:solver procedure? #:limit natural?) . ->* . (listof any/c)) (when-debug (reset-assns!) (reset-nfcs!) (reset-nchecks!)) @@ -548,7 +536,7 @@ #:finish-proc [finish-proc csp->assocs] #:solver [solver (or (current-solver) backtracking-solver)] #:limit [max-solutions 1]) - ((csp?) (#:finish-proc procedure? #:solver procedure? #:limit exact-nonnegative-integer?) + ((csp?) (#:finish-proc procedure? #:solver procedure? #:limit natural?) . ->* . (or/c #false any/c)) (match (solve* prob #:finish-proc finish-proc #:solver solver #:limit max-solutions) [(list solution) solution] From 558c9053931816629594d537c770cb1100ab99a9 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Mon, 22 Oct 2018 22:38:14 -0700 Subject: [PATCH 177/246] yes --- csp/csp/hacs-map.rkt | 1 - csp/csp/hacs.rkt | 184 +++++++++++++++++++++---------------------- 2 files changed, 90 insertions(+), 95 deletions(-) diff --git a/csp/csp/hacs-map.rkt b/csp/csp/hacs-map.rkt index 601f397b..69c3417b 100644 --- a/csp/csp/hacs-map.rkt +++ b/csp/csp/hacs-map.rkt @@ -2,7 +2,6 @@ (require "hacs.rkt" sugar/debug) (module+ test (require rackunit)) - (define (map-coloring-csp colors neighbors) (define names (remove-duplicates (flatten neighbors) eq?)) (define vds (for/list ([name (in-list names)]) diff --git a/csp/csp/hacs.rkt b/csp/csp/hacs.rkt index 8ce556e3..d5a10afb 100644 --- a/csp/csp/hacs.rkt +++ b/csp/csp/hacs.rkt @@ -15,8 +15,8 @@ (let loop ([argss argss][acc empty]) (if (null? argss) (yield (reverse acc)) - (for ([arg (in-list (car argss))]) - (loop (cdr argss) (cons arg acc)))))))) + (for ([arg (car argss)]) + (loop (cdr argss) (cons arg acc)))))))) (struct csp (vars constraints [assignments #:auto] [checks #:auto]) #:mutable #:transparent #:auto-value 0) @@ -33,7 +33,7 @@ (raise-argument-error 'constraint-proc "csp" prob)) ;; apply proc in many-to-many style (for/and ([args (in-cartesian (map (λ (name) (find-domain prob name)) (constraint-names const)))]) - (apply (constraint-proc const) args)))) + (apply (constraint-proc const) args)))) (define name? symbol?) @@ -74,15 +74,15 @@ ((csp? (or/c (listof name?) procedure?)) ((or/c (listof any/c) procedure?)) . ->* . void?) (for/fold ([vrs (vars prob)] #:result (set-csp-vars! prob vrs)) - ([name (in-list (if (procedure? names-or-procedure) - (names-or-procedure) - names-or-procedure))]) + ([name (in-list (match names-or-procedure + [(? procedure? proc) (proc)] + [names names]))]) (when (memq name (map var-name vrs)) (raise-argument-error 'add-vars! "var that doesn't already exist" name)) (append vrs (list (var name - (if (procedure? vals-or-procedure) - (vals-or-procedure) - vals-or-procedure)))))) + (if (procedure? vals-or-procedure) + (vals-or-procedure) + vals-or-procedure)))))) (define/contract (add-var! prob name [vals-or-procedure empty]) ((csp? name?) ((or/c (listof any/c) procedure?)) . ->* . void?) @@ -92,11 +92,11 @@ ((csp? procedure? (listof (listof name?))) ((or/c #false name?)) . ->* . void?) (set-csp-constraints! prob (append (constraints prob) (for/list ([names (in-list namess)]) - (for ([name (in-list names)]) - (check-name-in-csp! 'add-constraints! prob name)) - (make-constraint names (if proc-name - (procedure-rename proc proc-name) - proc)))))) + (for ([name (in-list names)]) + (check-name-in-csp! 'add-constraints! prob name)) + (make-constraint names (if proc-name + (procedure-rename proc proc-name) + proc)))))) (define/contract (add-pairwise-constraint! prob proc var-names [proc-name #false]) ((csp? procedure? (listof name?)) (name?) . ->* . void?) @@ -132,7 +132,7 @@ (check-name-in-csp! 'find-var prob name) (for/first ([vr (in-vars prob)] #:when (eq? name (var-name vr))) - vr)) + vr)) (define/contract (find-domain prob name) (csp? name? . -> . (listof any/c)) @@ -145,7 +145,7 @@ (csp? name? . -> . any/c) (for/or ([vr (in-vars prob)] #:when (assigned-var? vr)) - (eq? name (var-name vr)))) + (eq? name (var-name vr)))) (define/contract (reduce-function-arity proc pattern) (procedure? (listof any/c) . -> . procedure?) @@ -177,20 +177,20 @@ (ormap assigned? (constraint-names constraint))) (make-csp (vars prob) (for/list ([const (in-constraints prob)]) - (cond - ;; no point reducing 2-arity functions because they will be consumed by forward checking - [(and (or (not minimum-arity) (<= minimum-arity (constraint-arity const))) - (partially-assigned? const)) - (match-define (constraint cnames proc) const) - ;; pattern is mix of values and boxed symbols (indicating variables to persist) - ;; use boxes here as cheap way to distinguish id symbols from value symbols - (define reduce-arity-pattern (for/list ([cname (in-list cnames)]) - (if (assigned? cname) - (first (find-domain prob cname)) - (box cname)))) - (constraint (filter-not assigned? cnames) - (reduce-function-arity proc reduce-arity-pattern))] - [else const])))) + (cond + ;; no point reducing 2-arity functions because they will be consumed by forward checking + [(and (or (not minimum-arity) (<= minimum-arity (constraint-arity const))) + (partially-assigned? const)) + (match-define (constraint cnames proc) const) + ;; pattern is mix of values and boxed symbols (indicating variables to persist) + ;; use boxes here as cheap way to distinguish id symbols from value symbols + (define reduce-arity-pattern (for/list ([cname (in-list cnames)]) + (if (assigned? cname) + (first (find-domain prob cname)) + (box cname)))) + (constraint (filter-not assigned? cnames) + (reduce-function-arity proc reduce-arity-pattern))] + [else const])))) (define nassns 0) @@ -200,14 +200,18 @@ (define (reset-nfcs!) (set! nfchecks 0)) +(define nchecks 0) + +(define (reset-nchecks!) (set! nchecks 0)) + (define/contract (assign-val prob name val) (csp? name? any/c . -> . csp?) (when-debug (set! nassns (add1 nassns))) (make-csp - (for/list ([vr (vars prob)]) - (if (eq? name (var-name vr)) - (assigned-var name (list val)) - vr)) + (for/list ([vr (in-vars prob)]) + (if (eq? name (var-name vr)) + (assigned-var name (list val)) + vr)) (constraints prob))) (define/contract (unassigned-vars prob) @@ -232,7 +236,7 @@ (csp? var? . -> . natural?) (for/sum ([const (in-constraints prob)] #:when (memq (var-name var) (constraint-names const))) - 1)) + 1)) (define/contract (domain-length var) (var? . -> . natural?) @@ -255,7 +259,7 @@ (random-pick (for/list ([uv (in-list mrv-uvars)] [degree (in-list degrees)] #:when (= max-degree degree)) - uv))])])) + uv))])])) (define first-domain-value values) @@ -267,8 +271,8 @@ [cnames (in-value (constraint-names const))] #:when (and (= (length names) (length cnames)) (for/and ([name (in-list names)]) - (memq name cnames)))) - const)) + (memq name cnames)))) + const)) (define (two-arity? const) (= 2 (constraint-arity const))) @@ -278,33 +282,33 @@ (define/contract (forward-check prob ref-name) (csp? name? . -> . csp?) (define aval (first (find-domain prob ref-name))) - (define (check-var v) - (match v + (define (check-var vr) + (match vr ;; don't check against assigned vars, or the reference var ;; (which is probably assigned but maybe not) - [(? (λ (x) (or (assigned-var? x) (eq? (var-name x) ref-name)))) v] + [(? (λ (x) (or (assigned-var? x) (eq? (var-name x) ref-name)))) vr] [(var name vals) (match ((constraints prob) . relating-only . (list ref-name name)) - [(? empty?) v] + [(? empty?) vr] [constraints (define new-vals (for/list ([val (in-list vals)] #:when (for/and ([const (in-list constraints)]) - (let ([proc (constraint-proc const)]) - (if (eq? name (first (constraint-names const))) - (proc val aval) - (proc aval val))))) - val)) - (checked-variable name new-vals (cons ref-name (match v + (let ([proc (constraint-proc const)]) + (if (eq? name (first (constraint-names const))) + (proc val aval) + (proc aval val))))) + val)) + (checked-variable name new-vals (cons ref-name (match vr [(checked-variable _ _ history) history] [else null])))])])) (define checked-vars (map check-var (vars prob))) (when-debug (set! nfchecks (+ (length checked-vars) nchecks))) ;; conflict-set will be empty if there are no empty domains (as we would hope) - (define conflict-set (for*/list ([cv (in-list checked-vars)] - #:when (empty? (domain cv)) - [name (in-list (history cv))]) - name)) + (define conflict-set (for*/list ([cvr (in-list checked-vars)] + #:when (empty? (domain cvr)) + [name (in-list (history cvr))]) + name)) ;; for conflict-directed backjumping it's essential to forward-check ALL vars ;; (even after an empty domain is generated) and combine their conflicts ;; so we can discover the *most recent past var* that could be the culprit. @@ -320,7 +324,7 @@ (constraint-relates? const ref-name) (let ([other-name (first (remq ref-name (constraint-names const)))]) (singleton-var? (find-var prob other-name))))) - const)) + const)) (make-csp checked-vars nonsingleton-constraints)) (define/contract (constraint-checkable? const names) @@ -328,7 +332,7 @@ ;; constraint is checkable if all constraint names ;; are in target list of names. (for/and ([cname (in-list (constraint-names const))]) - (memq cname names))) + (memq cname names))) (define/contract (constraint-arity const) (constraint? . -> . natural?) @@ -337,8 +341,6 @@ (define (singleton-var? var) (= 1 (domain-length var))) -(define nchecks 0) -(define (reset-nchecks!) (set! nchecks 0)) (define/contract (check-constraints prob [mandatory-names #f] #:conflicts [conflict-count? #f]) ((csp?) ((listof name?) #:conflicts boolean?) . ->* . (or/c csp? natural?)) ;; this time, we're not limited to assigned variables @@ -346,26 +348,26 @@ ;; we also want to use "singleton" vars (that is, vars that have been reduced to a single domain value by forward checking) (define singleton-varnames (for/list ([vr (in-vars prob)] #:when (singleton-var? vr)) - (var-name vr))) + (var-name vr))) (define-values (checkable-consts other-consts) (partition (λ (const) (and (constraint-checkable? const singleton-varnames) (or (not mandatory-names) (for/and ([name (in-list mandatory-names)]) - (constraint-relates? const name))))) + (constraint-relates? const name))))) (constraints prob))) (cond [conflict-count? (define conflict-count (for/sum ([constraint (in-list checkable-consts)] #:unless (constraint prob)) - 1)) + 1)) (when-debug (set! nchecks (+ conflict-count nchecks))) conflict-count] [else (for ([(constraint idx) (in-indexed checkable-consts)] #:unless (constraint prob)) - (when-debug (set! nchecks (+ (add1 idx) nchecks))) - (backtrack!)) + (when-debug (set! nchecks (+ (add1 idx) nchecks))) + (backtrack!)) ;; discard checked constraints, since they have no further reason to live (make-csp (vars prob) other-consts)])) @@ -374,15 +376,15 @@ ;; todo: why does this function slow down searches? (make-csp (for/list ([vr (in-vars prob)]) - (match-define (var name vals) vr) - (define procs (for*/list ([const (in-constraints prob)] - [cnames (in-value (constraint-names const))] - #:when (and (= 1 (length cnames)) (eq? name (car cnames)))) - (constraint-proc const))) - (var name - (for*/fold ([vals vals]) - ([proc (in-list procs)]) - (filter proc vals)))) + (match-define (var name vals) vr) + (define procs (for*/list ([const (in-constraints prob)] + [cnames (in-value (constraint-names const))] + #:when (and (= 1 (length cnames)) (eq? name (car cnames)))) + (constraint-proc const))) + (var name + (for*/fold ([vals vals]) + ([proc (in-list procs)]) + (filter proc vals)))) (constraints prob))) (define/contract (backtracking-solver @@ -441,9 +443,9 @@ ((csp?) (integer?) . ->* . generator?) (generator () (for ([thread-count (or (current-thread-count) 1)]) ; todo: what is ideal thread count? - (make-min-conflcts-thread prob thread-count max-steps)) + (make-min-conflcts-thread prob thread-count max-steps)) (for ([i (in-naturals)]) - (yield (thread-receive))))) + (yield (thread-receive))))) (define/contract (optimal-stop-min proc xs) (procedure? (listof any/c) . -> . any/c) @@ -451,7 +453,7 @@ (define threshold (argmin proc sample)) (or (for/first ([candidate (in-list candidates)] #:when (<= (proc candidate) threshold)) - candidate) + candidate) (last candidates))) (define/contract (conflicted-variable-names prob) @@ -459,7 +461,7 @@ ;; Return a list of variables in current assignment that are conflicted (for/list ([name (in-variable-names prob)] #:when (positive? (nconflicts prob name))) - name)) + name)) (define/contract (min-conflicts-value prob name vals) (csp? name? (listof any/c) . -> . any/c) @@ -468,7 +470,7 @@ #:cache-keys? #true)) (for/first ([val (in-list vals-by-conflict)] #:unless (equal? val (first (find-domain prob name)))) ;; but change the value - val)) + val)) (define no-value-sig (gensym)) @@ -482,8 +484,8 @@ (define/contract (csp->assocs prob) (csp? . -> . (listof (cons/c name? any/c))) (for/list ([vr (in-vars prob)]) - (match vr - [(var name (list val)) (cons name val)]))) + (match vr + [(var name (list val)) (cons name val)]))) (define/contract (combine-csps probs) ((listof csp?) . -> . csp?) @@ -491,28 +493,17 @@ (apply append (map vars probs)) (apply append (map csp-constraints probs)))) -(define/contract (make-cartesian-generator solgens) - ((listof generator?) . -> . generator?) - (generator () - (define solstreams (for/list ([solgen (in-list solgens)]) - (for/stream ([sol (in-producer solgen (void))]) - sol))) - (let loop ([solstreams solstreams][sols empty]) - (if (null? solstreams) - (yield (combine-csps (reverse sols))) - (for ([sol (in-stream (car solstreams))]) - (loop (cdr solstreams) (cons sol sols))))))) (define/contract (extract-subcsp prob names) (csp? (listof name?) . -> . csp?) (make-csp (for/list ([vr (in-vars prob)] #:when (memq (var-name vr) names)) - vr) + vr) (for/list ([const (in-constraints prob)] #:when (for/and ([cname (in-list (constraint-names const))]) - (memq cname names))) - const))) + (memq cname names))) + const))) (define/contract (solve* prob #:finish-proc [finish-proc csp->assocs] @@ -525,12 +516,17 @@ (define subcsps ; decompose into independent csps. `cc` determines "connected components" (if (current-decompose) (for/list ([nodeset (in-list (cc (csp->graph prob)))]) - (extract-subcsp prob nodeset)) + (extract-subcsp prob nodeset)) (list prob))) + + (define solgens (map solver subcsps)) + (define solstreams (for/list ([solgen (in-list solgens)]) + (for/stream ([sol (in-producer solgen (void))]) + sol))) - (for/list ([solution (in-producer (make-cartesian-generator (map solver subcsps)) (void))] + (for/list ([solution-pieces (in-cartesian solstreams)] [idx (in-range max-solutions)]) - (finish-proc solution))) + (finish-proc (combine-csps solution-pieces)))) (define/contract (solve prob #:finish-proc [finish-proc csp->assocs] From 7ef8d6937eeb557b1e33986a4c0e4952181e1e4d Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Tue, 23 Oct 2018 15:38:25 -0700 Subject: [PATCH 178/246] ac-3 etc --- csp/csp/csp.rkt | 4 +- csp/csp/hacs-test-workbench.rkt | 53 +++--- csp/csp/hacs-test.rkt | 4 +- csp/csp/hacs.rkt | 295 ++++++++++++++++++++------------ 4 files changed, 218 insertions(+), 138 deletions(-) diff --git a/csp/csp/csp.rkt b/csp/csp/csp.rkt index 2f222df9..21858619 100644 --- a/csp/csp/csp.rkt +++ b/csp/csp/csp.rkt @@ -177,7 +177,9 @@ (define/contract (terminating-at arcs name) ((listof $arc?) $var-name? . -> . (listof $arc?)) (for/list ([arc (in-list arcs)] - #:when (eq? name (second ($constraint-names ($arc-constraint arc))))) + #:when (and + (memq name ($constraint-names ($arc-constraint arc))) + (not (eq? name ($arc-name arc))))) arc)) (define/contract (constraint-assigned? csp constraint) diff --git a/csp/csp/hacs-test-workbench.rkt b/csp/csp/hacs-test-workbench.rkt index e8a05ca8..dfc19d45 100644 --- a/csp/csp/hacs-test-workbench.rkt +++ b/csp/csp/hacs-test-workbench.rkt @@ -6,26 +6,33 @@ (current-order-values shuffle) (current-random #true) -;; queens problem -;; place queens on chessboard so they do not intersect - -(define board-size 8) - -(define queens (make-csp)) -(define qs (for/list ([q board-size]) (string->symbol (format "q~a" q)))) -(define rows (range (length qs))) -(add-vars! queens qs rows) -(define (q-col q) (string->number (string-trim (symbol->string q) "q"))) -(for* ([qs (in-combinations qs 2)]) - (match-define (list qa qb) qs) - (match-define (list qa-col qb-col) (map q-col qs)) - (add-constraint! queens - (λ (qa-row qb-row) - (not (= (abs (- qa-row qb-row)) (abs (- (q-col qa) (q-col qb)))))) ; same diag? - (list qa qb)) - (add-constraint! queens (negate =) (list qa qb))) - -(current-multithreaded #t) -(time-avg 10 (solve queens)) -(parameterize ([current-solver min-conflicts-solver]) - (time-avg 10 (solve queens))) \ No newline at end of file +(define (word-value . xs) + (for/sum ([(x idx) (in-indexed (reverse xs))]) + (* x (expt 10 idx)))) + + +(define smm (make-csp)) + +(define vs '(s e n d m o r y)) +(add-vars! smm vs (λ () (range 10))) + +(add-constraint! smm positive? '(s)) +(add-constraint! smm positive? '(m)) +(add-constraint! smm (λ (d e y) (= (modulo (+ d e) 10) y)) '(d e y)) +(add-constraint! smm (λ (n d r e y) + (= (modulo (+ (word-value n d) (word-value r e)) 100) + (word-value e y))) '(n d r e y)) +(add-constraint! smm (λ (e n d o r y) + (= (modulo (+ (word-value e n d) (word-value o r e)) 1000) (word-value n e y))) '(e n d o r y)) +(add-constraint! smm (λ (s e n d m o r y) + (= (+ (word-value s e n d) (word-value m o r e)) + (word-value m o n e y))) '(s e n d m o r y)) +(add-pairwise-constraint! smm alldiff= '(s e n d m o r y)) +(parameterize ([current-select-variable mrv-degree-hybrid] + [current-node-consistency make-nodes-consistent]) ; todo: why is plain mrv so bad on this problem? + (time-named (solve smm))) + +nassns +nfchecks +nchecks + diff --git a/csp/csp/hacs-test.rkt b/csp/csp/hacs-test.rkt index 47e48d61..15997254 100644 --- a/csp/csp/hacs-test.rkt +++ b/csp/csp/hacs-test.rkt @@ -5,6 +5,8 @@ (current-select-variable mrv-degree-hybrid) (current-order-values shuffle) (current-random #true) +(current-node-consistency #f) +(current-arity-reduction #t) (check-equal? (first-unassigned-variable (csp (list (var 'a (range 3)) (var 'b (range 3))) null)) (var 'a (range 3))) @@ -287,7 +289,7 @@ ((nationality-4 . spaniard) (color-4 . ivory) (drink-4 . orange-juice) (smoke-4 . luckystrike) (pet-4 . dogs)))) (module+ main - (when-debug + (begin (define-syntax n (λ (stx) #'10)) (time-avg n (void (solve quarters))) (time-avg n (void (solve* xsum))) diff --git a/csp/csp/hacs.rkt b/csp/csp/hacs.rkt index d5a10afb..89e12a90 100644 --- a/csp/csp/hacs.rkt +++ b/csp/csp/hacs.rkt @@ -4,7 +4,7 @@ (define-syntax when-debug (let () - (define debug #f) + (define debug #t) (if debug (make-rename-transformer #'begin) (λ (stx) (syntax-case stx () @@ -16,24 +16,23 @@ (if (null? argss) (yield (reverse acc)) (for ([arg (car argss)]) - (loop (cdr argss) (cons arg acc)))))))) + (loop (cdr argss) (cons arg acc)))))))) -(struct csp (vars constraints [assignments #:auto] [checks #:auto]) - #:mutable #:transparent #:auto-value 0) +(struct csp (vars constraints) #:mutable #:transparent) (define constraints csp-constraints) (define vars csp-vars) (define-syntax-rule (in-constraints csp) (in-list (csp-constraints csp))) (define-syntax-rule (in-vars csp) (in-list (vars csp))) -(define-syntax-rule (in-variable-names csp) (in-list (map var-name (vars csp)))) +(define-syntax-rule (in-var-names csp) (in-list (map var-name (vars csp)))) (struct constraint (names proc) #:transparent #:property prop:procedure (λ (const prob) (unless (csp? prob) - (raise-argument-error 'constraint-proc "csp" prob)) + (raise-argument-error 'constraint "csp" prob)) ;; apply proc in many-to-many style (for/and ([args (in-cartesian (map (λ (name) (find-domain prob name)) (constraint-names const)))]) - (apply (constraint-proc const) args)))) + (apply (constraint-proc const) args)))) (define name? symbol?) @@ -92,15 +91,15 @@ ((csp? procedure? (listof (listof name?))) ((or/c #false name?)) . ->* . void?) (set-csp-constraints! prob (append (constraints prob) (for/list ([names (in-list namess)]) - (for ([name (in-list names)]) - (check-name-in-csp! 'add-constraints! prob name)) - (make-constraint names (if proc-name - (procedure-rename proc proc-name) - proc)))))) + (for ([name (in-list names)]) + (check-name-in-csp! 'add-constraints! prob name)) + (make-constraint names (if proc-name + (procedure-rename proc proc-name) + proc)))))) -(define/contract (add-pairwise-constraint! prob proc var-names [proc-name #false]) +(define/contract (add-pairwise-constraint! prob proc names [proc-name #false]) ((csp? procedure? (listof name?)) (name?) . ->* . void?) - (add-constraints! prob proc (combinations var-names 2) proc-name)) + (add-constraints! prob proc (combinations names 2) proc-name)) (define/contract (add-constraint! prob proc names [proc-name #false]) ((csp? procedure? (listof name?)) (name?) . ->* . void?) @@ -120,6 +119,8 @@ (define current-random (make-parameter #t)) (define current-decompose (make-parameter #t)) (define current-thread-count (make-parameter 4)) +(define current-node-consistency (make-parameter #f)) +(define current-arity-reduction (make-parameter #t)) (define/contract (check-name-in-csp! caller prob name) (symbol? csp? name? . -> . void?) @@ -132,7 +133,7 @@ (check-name-in-csp! 'find-var prob name) (for/first ([vr (in-vars prob)] #:when (eq? name (var-name vr))) - vr)) + vr)) (define/contract (find-domain prob name) (csp? name? . -> . (listof any/c)) @@ -145,7 +146,7 @@ (csp? name? . -> . any/c) (for/or ([vr (in-vars prob)] #:when (assigned-var? vr)) - (eq? name (var-name vr)))) + (eq? name (var-name vr)))) (define/contract (reduce-function-arity proc pattern) (procedure? (listof any/c) . -> . procedure?) @@ -177,31 +178,27 @@ (ormap assigned? (constraint-names constraint))) (make-csp (vars prob) (for/list ([const (in-constraints prob)]) - (cond - ;; no point reducing 2-arity functions because they will be consumed by forward checking - [(and (or (not minimum-arity) (<= minimum-arity (constraint-arity const))) - (partially-assigned? const)) - (match-define (constraint cnames proc) const) - ;; pattern is mix of values and boxed symbols (indicating variables to persist) - ;; use boxes here as cheap way to distinguish id symbols from value symbols - (define reduce-arity-pattern (for/list ([cname (in-list cnames)]) - (if (assigned? cname) - (first (find-domain prob cname)) - (box cname)))) - (constraint (filter-not assigned? cnames) - (reduce-function-arity proc reduce-arity-pattern))] - [else const])))) + (cond + ;; no point reducing 2-arity functions because they will be consumed by forward checking + [(and (or (not minimum-arity) (<= minimum-arity (constraint-arity const))) + (partially-assigned? const)) + (match-define (constraint cnames proc) const) + ;; pattern is mix of values and boxed symbols (indicating variables to persist) + ;; use boxes here as cheap way to distinguish id symbols from value symbols + (define arity-reduction-pattern (for/list ([cname (in-list cnames)]) + (if (assigned? cname) + (first (find-domain prob cname)) + (box cname)))) + (constraint (filter-not assigned? cnames) + (reduce-function-arity proc arity-reduction-pattern))] + [else const])))) (define nassns 0) - -(define (reset-assns!) (set! nassns 0)) - (define nfchecks 0) - -(define (reset-nfcs!) (set! nfchecks 0)) - (define nchecks 0) +(define (reset-nassns!) (set! nassns 0)) +(define (reset-nfchecks!) (set! nfchecks 0)) (define (reset-nchecks!) (set! nchecks 0)) (define/contract (assign-val prob name val) @@ -209,9 +206,9 @@ (when-debug (set! nassns (add1 nassns))) (make-csp (for/list ([vr (in-vars prob)]) - (if (eq? name (var-name vr)) - (assigned-var name (list val)) - vr)) + (if (eq? name (var-name vr)) + (assigned-var name (list val)) + vr)) (constraints prob))) (define/contract (unassigned-vars prob) @@ -236,7 +233,7 @@ (csp? var? . -> . natural?) (for/sum ([const (in-constraints prob)] #:when (memq (var-name var) (constraint-names const))) - 1)) + 1)) (define/contract (domain-length var) (var? . -> . natural?) @@ -259,7 +256,7 @@ (random-pick (for/list ([uv (in-list mrv-uvars)] [degree (in-list degrees)] #:when (= max-degree degree)) - uv))])])) + uv))])])) (define first-domain-value values) @@ -271,44 +268,122 @@ [cnames (in-value (constraint-names const))] #:when (and (= (length names) (length cnames)) (for/and ([name (in-list names)]) - (memq name cnames)))) - const)) + (memq name cnames)))) + const)) +(define (one-arity? const) (= 1 (constraint-arity const))) (define (two-arity? const) (= 2 (constraint-arity const))) (define (constraint-relates? const name) (memq name (constraint-names const))) +(struct arc (name const) #:transparent) + +(define/contract (two-arity-constraints->arcs constraints) + ((listof (and/c constraint? two-arity?)) . -> . (listof arc?)) + (for*/list ([const (in-list constraints)] + [name (in-list (constraint-names const))]) + (arc name const))) + +(require sugar/debug) +(define/contract (reduce-domain prob ark) + (csp? arc? . -> . csp?) + (match-define (arc name (constraint names constraint-proc)) ark) + (match-define (list other-name) (remove name names)) + (define proc (if (eq? name (first names)) ; name is on left + constraint-proc ; so val stays on left + (λ (val other-val) (constraint-proc other-val val)))) ; otherwise reverse arg order + (define (satisfies-arc? val) + (for/or ([other-val (in-list (find-domain prob other-name))]) + (proc val other-val))) + (make-csp + (for/list ([vr (in-vars prob)]) + (cond + [(assigned-var? vr) vr] + [(eq? name (var-name vr)) + (var name (match (filter satisfies-arc? (domain vr)) + [(? empty?) (backtrack!)] + [vals vals]))] + [else vr])) + (constraints prob))) + +(define/contract (terminating-at? arcs name) + ((listof arc?) name? . -> . (listof arc?)) + (for/list ([arc (in-list arcs)] + #:when (and + (memq name (constraint-names (arc-const arc))) + (not (eq? name (arc-name arc))))) + arc)) + +(define/contract (ac-3 prob . _) + ((csp?) (any/c) . ->* . csp?) + ;; csp is arc-consistent if every pair of variables (x y) + ;; has values in their domain that satisfy every binary constraint + (define starting-arcs (two-arity-constraints->arcs (filter two-arity? (constraints prob)))) + (for/fold ([prob prob] + [arcs starting-arcs] + #:result (prune-singleton-constraints prob)) + ([i (in-naturals)] + #:break (empty? arcs)) + (length starting-arcs) + (match-define (cons (arc name proc) other-arcs) arcs) + (length other-arcs) + (define reduced-csp (reduce-domain prob (arc name proc))) + (values reduced-csp (if (= (length (find-domain prob name)) (length (find-domain reduced-csp name))) + ;; revision did not reduce the domain, so keep going + other-arcs + ;; revision reduced the domain, so supplement the list of arcs + (remove-duplicates (append (starting-arcs . terminating-at? . name) other-arcs)))))) + + +(define/contract (forward-check-var prob ref-name vr) + (csp? name? var? . -> . var?) + (cond + ;; don't check against assigned vars, or the reference var + ;; (which is probably assigned but maybe not) + [(assigned-var? vr) vr] + [(eq? (var-name vr) ref-name) vr] + [else + (match-define (var name vals) vr) + (match ((constraints prob) . relating-only . (list ref-name name)) + [(? empty?) vr] + [constraints + (define new-vals + (for/list ([val (in-list vals)] + #:when (for/and ([const (in-list constraints)]) + (let ([proc (constraint-proc const)] + [ref-val (first (find-domain prob ref-name))]) + (if (eq? name (first (constraint-names const))) + (proc val ref-val) + (proc ref-val val))))) + val)) + (checked-variable name new-vals (cons ref-name (match vr + [(checked-variable _ _ history) history] + [else null])))])])) + +(define/contract (prune-singleton-constraints prob [ref-name #false]) + ((csp?) ((or/c #false name?)) . ->* . csp?) + (define singleton-var-names (for/list ([vr (in-vars prob)] + #:when (singleton-var? vr)) + (var-name vr))) + (make-csp + (vars prob) + (for/list ([const (in-constraints prob)] + #:unless (and (two-arity? const) + (or (not ref-name) (constraint-relates? const ref-name)) + (for/and ([cname (in-list (constraint-names const))]) + (memq cname singleton-var-names)))) + const))) + (define/contract (forward-check prob ref-name) (csp? name? . -> . csp?) - (define aval (first (find-domain prob ref-name))) - (define (check-var vr) - (match vr - ;; don't check against assigned vars, or the reference var - ;; (which is probably assigned but maybe not) - [(? (λ (x) (or (assigned-var? x) (eq? (var-name x) ref-name)))) vr] - [(var name vals) - (match ((constraints prob) . relating-only . (list ref-name name)) - [(? empty?) vr] - [constraints - (define new-vals - (for/list ([val (in-list vals)] - #:when (for/and ([const (in-list constraints)]) - (let ([proc (constraint-proc const)]) - (if (eq? name (first (constraint-names const))) - (proc val aval) - (proc aval val))))) - val)) - (checked-variable name new-vals (cons ref-name (match vr - [(checked-variable _ _ history) history] - [else null])))])])) - (define checked-vars (map check-var (vars prob))) + (define checked-vars (map (λ (vr) (forward-check-var prob ref-name vr)) (vars prob))) (when-debug (set! nfchecks (+ (length checked-vars) nchecks))) ;; conflict-set will be empty if there are no empty domains (as we would hope) (define conflict-set (for*/list ([cvr (in-list checked-vars)] #:when (empty? (domain cvr)) [name (in-list (history cvr))]) - name)) + name)) ;; for conflict-directed backjumping it's essential to forward-check ALL vars ;; (even after an empty domain is generated) and combine their conflicts ;; so we can discover the *most recent past var* that could be the culprit. @@ -318,27 +393,21 @@ (backtrack! conflict-set)) ;; Discard constraints that have produced singleton domains ;; (they have no further use) - (define nonsingleton-constraints - (for/list ([const (in-constraints prob)] - #:unless (and (two-arity? const) - (constraint-relates? const ref-name) - (let ([other-name (first (remq ref-name (constraint-names const)))]) - (singleton-var? (find-var prob other-name))))) - const)) - (make-csp checked-vars nonsingleton-constraints)) + (prune-singleton-constraints (make-csp checked-vars (constraints prob)) ref-name)) (define/contract (constraint-checkable? const names) (constraint? (listof name?) . -> . any/c) ;; constraint is checkable if all constraint names ;; are in target list of names. (for/and ([cname (in-list (constraint-names const))]) - (memq cname names))) + (memq cname names))) (define/contract (constraint-arity const) (constraint? . -> . natural?) (length (constraint-names const))) -(define (singleton-var? var) +(define/contract (singleton-var? var) + (var? . -> . boolean?) (= 1 (domain-length var))) (define/contract (check-constraints prob [mandatory-names #f] #:conflicts [conflict-count? #f]) @@ -348,44 +417,43 @@ ;; we also want to use "singleton" vars (that is, vars that have been reduced to a single domain value by forward checking) (define singleton-varnames (for/list ([vr (in-vars prob)] #:when (singleton-var? vr)) - (var-name vr))) + (var-name vr))) (define-values (checkable-consts other-consts) (partition (λ (const) (and (constraint-checkable? const singleton-varnames) (or (not mandatory-names) (for/and ([name (in-list mandatory-names)]) - (constraint-relates? const name))))) + (constraint-relates? const name))))) (constraints prob))) (cond [conflict-count? (define conflict-count (for/sum ([constraint (in-list checkable-consts)] #:unless (constraint prob)) - 1)) + 1)) (when-debug (set! nchecks (+ conflict-count nchecks))) conflict-count] [else (for ([(constraint idx) (in-indexed checkable-consts)] #:unless (constraint prob)) - (when-debug (set! nchecks (+ (add1 idx) nchecks))) - (backtrack!)) + (when-debug (set! nchecks (+ (add1 idx) nchecks))) + (backtrack!)) ;; discard checked constraints, since they have no further reason to live (make-csp (vars prob) other-consts)])) (define/contract (make-nodes-consistent prob) (csp? . -> . csp?) - ;; todo: why does this function slow down searches? - (make-csp - (for/list ([vr (in-vars prob)]) - (match-define (var name vals) vr) - (define procs (for*/list ([const (in-constraints prob)] - [cnames (in-value (constraint-names const))] - #:when (and (= 1 (length cnames)) (eq? name (car cnames)))) - (constraint-proc const))) - (var name - (for*/fold ([vals vals]) - ([proc (in-list procs)]) - (filter proc vals)))) - (constraints prob))) + (define-values (unary-constraints other-constraints) + (partition one-arity? (constraints prob))) + (if (empty? unary-constraints) + prob + (make-csp + (for/list ([vr (in-vars prob)]) + (match-define (var name vals) vr) + (var name (for/fold ([vals vals]) + ([const (in-list unary-constraints)] + #:when (constraint-relates? const name)) + (filter (constraint-proc const) vals)))) + other-constraints))) (define/contract (backtracking-solver prob @@ -395,7 +463,8 @@ #:inference [inference (or (current-inference) no-inference)]) ((csp?) (#:select-variable procedure? #:order-values procedure? #:inference procedure?) . ->* . generator?) (generator () - (let loop ([prob prob]) + (define reduce-arity-proc (if (current-arity-reduction) reduce-constraint-arity values)) + (let loop ([prob ((if (current-node-consistency) make-nodes-consistent values) prob)]) (match (select-unassigned-variable prob) [#false (yield prob)] [(var name domain) @@ -410,7 +479,7 @@ (let* ([prob (assign-val prob name val)] ;; reduce constraints before inference, ;; to create more forward-checkable (binary) constraints - [prob (reduce-constraint-arity prob)] + [prob (reduce-arity-proc prob)] [prob (inference prob name)] [prob (check-constraints prob)]) (loop prob))) @@ -421,7 +490,7 @@ (define (assign-random-vals prob) (for/fold ([new-csp prob]) - ([name (in-variable-names prob)]) + ([name (in-var-names prob)]) (assign-val new-csp name (random-pick (find-domain prob name))))) (define (make-min-conflcts-thread prob-start thread-count max-steps [main-thread (current-thread)]) @@ -443,9 +512,9 @@ ((csp?) (integer?) . ->* . generator?) (generator () (for ([thread-count (or (current-thread-count) 1)]) ; todo: what is ideal thread count? - (make-min-conflcts-thread prob thread-count max-steps)) + (make-min-conflcts-thread prob thread-count max-steps)) (for ([i (in-naturals)]) - (yield (thread-receive))))) + (yield (thread-receive))))) (define/contract (optimal-stop-min proc xs) (procedure? (listof any/c) . -> . any/c) @@ -453,15 +522,15 @@ (define threshold (argmin proc sample)) (or (for/first ([candidate (in-list candidates)] #:when (<= (proc candidate) threshold)) - candidate) + candidate) (last candidates))) (define/contract (conflicted-variable-names prob) (csp? . -> . (listof name?)) ;; Return a list of variables in current assignment that are conflicted - (for/list ([name (in-variable-names prob)] + (for/list ([name (in-var-names prob)] #:when (positive? (nconflicts prob name))) - name)) + name)) (define/contract (min-conflicts-value prob name vals) (csp? name? (listof any/c) . -> . any/c) @@ -470,7 +539,7 @@ #:cache-keys? #true)) (for/first ([val (in-list vals-by-conflict)] #:unless (equal? val (first (find-domain prob name)))) ;; but change the value - val)) + val)) (define no-value-sig (gensym)) @@ -484,8 +553,8 @@ (define/contract (csp->assocs prob) (csp? . -> . (listof (cons/c name? any/c))) (for/list ([vr (in-vars prob)]) - (match vr - [(var name (list val)) (cons name val)]))) + (match vr + [(var name (list val)) (cons name val)]))) (define/contract (combine-csps probs) ((listof csp?) . -> . csp?) @@ -499,11 +568,11 @@ (make-csp (for/list ([vr (in-vars prob)] #:when (memq (var-name vr) names)) - vr) + vr) (for/list ([const (in-constraints prob)] #:when (for/and ([cname (in-list (constraint-names const))]) - (memq cname names))) - const))) + (memq cname names))) + const))) (define/contract (solve* prob #:finish-proc [finish-proc csp->assocs] @@ -511,22 +580,22 @@ #:limit [max-solutions +inf.0]) ((csp?) (#:finish-proc procedure? #:solver procedure? #:limit natural?) . ->* . (listof any/c)) - (when-debug (reset-assns!) (reset-nfcs!) (reset-nchecks!)) + (when-debug (reset-nassns!) (reset-nfchecks!) (reset-nchecks!)) (define subcsps ; decompose into independent csps. `cc` determines "connected components" (if (current-decompose) (for/list ([nodeset (in-list (cc (csp->graph prob)))]) - (extract-subcsp prob nodeset)) + (extract-subcsp prob nodeset)) (list prob))) (define solgens (map solver subcsps)) (define solstreams (for/list ([solgen (in-list solgens)]) - (for/stream ([sol (in-producer solgen (void))]) - sol))) + (for/stream ([sol (in-producer solgen (void))]) + sol))) (for/list ([solution-pieces (in-cartesian solstreams)] [idx (in-range max-solutions)]) - (finish-proc (combine-csps solution-pieces)))) + (finish-proc (combine-csps solution-pieces)))) (define/contract (solve prob #:finish-proc [finish-proc csp->assocs] From 11d6298d217791f67f0bfc42509038ffd0ed1881 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Tue, 23 Oct 2018 18:14:58 -0700 Subject: [PATCH 179/246] improve ac-3 --- csp/csp/hacs.rkt | 15 +++++++++------ 1 file changed, 9 insertions(+), 6 deletions(-) diff --git a/csp/csp/hacs.rkt b/csp/csp/hacs.rkt index 89e12a90..050eae89 100644 --- a/csp/csp/hacs.rkt +++ b/csp/csp/hacs.rkt @@ -315,19 +315,22 @@ (not (eq? name (arc-name arc))))) arc)) -(define/contract (ac-3 prob . _) - ((csp?) (any/c) . ->* . csp?) +(define/contract (ac-3 prob ref-name) + (csp? name? . -> . csp?) ;; csp is arc-consistent if every pair of variables (x y) ;; has values in their domain that satisfy every binary constraint - (define starting-arcs (two-arity-constraints->arcs (filter two-arity? (constraints prob)))) + (define checkable-names (cons ref-name (filter-not (λ (vn) (assigned-name? prob vn)) (map var-name (vars prob))))) + (define starting-arcs (two-arity-constraints->arcs (for/list ([const (in-constraints prob)] + #:when (and (two-arity? const) + (for/and ([cname (in-list (constraint-names const))]) + (memq cname checkable-names)))) + const))) (for/fold ([prob prob] - [arcs starting-arcs] + [arcs (sort starting-arcs < #:key (λ (a) (length (find-domain prob (arc-name a)))) #:cache-keys? #true)] #:result (prune-singleton-constraints prob)) ([i (in-naturals)] #:break (empty? arcs)) - (length starting-arcs) (match-define (cons (arc name proc) other-arcs) arcs) - (length other-arcs) (define reduced-csp (reduce-domain prob (arc name proc))) (values reduced-csp (if (= (length (find-domain prob name)) (length (find-domain reduced-csp name))) ;; revision did not reduce the domain, so keep going From 5d75fe54a9d3780f1a89658ec06972ef66c61145 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Tue, 23 Oct 2018 21:20:27 -0700 Subject: [PATCH 180/246] nits --- csp/csp/hacs-test-queens.rkt | 11 +++++++++-- csp/csp/hacs.rkt | 16 +++++++++++----- 2 files changed, 20 insertions(+), 7 deletions(-) diff --git a/csp/csp/hacs-test-queens.rkt b/csp/csp/hacs-test-queens.rkt index 1bce97c7..14aa0a1b 100644 --- a/csp/csp/hacs-test-queens.rkt +++ b/csp/csp/hacs-test-queens.rkt @@ -25,7 +25,14 @@ (list qa qb)) (add-constraint! queens (negate =) (list qa qb))) +(define (sol->string sol) + (define assocs (csp->assocs sol)) + (string-join (for/list ([q (in-list (sort assocs stringstring car)))]) + (apply string (add-between (for/list ([idx (in-range board-size)]) + (if (= idx (cdr q)) #\@ #\·)) #\space))) "\n")) + (current-thread-count 4) -(time-avg 10 (solve queens)) +(displayln (solve queens #:finish-proc sol->string)) (parameterize ([current-solver min-conflicts-solver]) - (time-avg 10 (solve queens))) \ No newline at end of file + (time (solve queens))) + diff --git a/csp/csp/hacs.rkt b/csp/csp/hacs.rkt index 050eae89..c32a9363 100644 --- a/csp/csp/hacs.rkt +++ b/csp/csp/hacs.rkt @@ -514,6 +514,7 @@ (define/contract (min-conflicts-solver prob [max-steps 100]) ((csp?) (integer?) . ->* . generator?) (generator () + (for ([thread-count (or (current-thread-count) 1)]) ; todo: what is ideal thread count? (make-min-conflcts-thread prob thread-count max-steps)) (for ([i (in-naturals)]) @@ -553,11 +554,16 @@ prob (assign-val prob name val)) (list name) #:conflicts #true)) -(define/contract (csp->assocs prob) - (csp? . -> . (listof (cons/c name? any/c))) - (for/list ([vr (in-vars prob)]) +(define/contract (csp->assocs prob [keys #f]) + ((csp?) ((listof name?)) . ->* . (listof (cons/c name? any/c))) + (define assocs + (for/list ([vr (in-vars prob)]) (match vr [(var name (list val)) (cons name val)]))) + (if keys + (for/list ([key (in-list keys)]) + (assq key assocs)) + assocs)) (define/contract (combine-csps probs) ((listof csp?) . -> . csp?) @@ -578,7 +584,7 @@ const))) (define/contract (solve* prob - #:finish-proc [finish-proc csp->assocs] + #:finish-proc [finish-proc (λ (p) (csp->assocs p (map var-name (vars prob))))] #:solver [solver (or (current-solver) backtracking-solver)] #:limit [max-solutions +inf.0]) ((csp?) (#:finish-proc procedure? #:solver procedure? #:limit natural?) @@ -601,7 +607,7 @@ (finish-proc (combine-csps solution-pieces)))) (define/contract (solve prob - #:finish-proc [finish-proc csp->assocs] + #:finish-proc [finish-proc (λ (p) (csp->assocs p (map var-name (vars prob))))] #:solver [solver (or (current-solver) backtracking-solver)] #:limit [max-solutions 1]) ((csp?) (#:finish-proc procedure? #:solver procedure? #:limit natural?) From 0c373f56bea3c5bc98ae3d53859de6d70990d0b1 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Wed, 24 Oct 2018 00:28:22 -0700 Subject: [PATCH 181/246] tpy --- csp/csp/expander.rkt | 29 +++++++++++++++++++++++++++++ csp/csp/main.rkt | 4 ++++ csp/csp/test-lang.rkt | 14 ++++++++++++++ 3 files changed, 47 insertions(+) create mode 100644 csp/csp/expander.rkt create mode 100644 csp/csp/test-lang.rkt diff --git a/csp/csp/expander.rkt b/csp/csp/expander.rkt new file mode 100644 index 00000000..2d9f33f7 --- /dev/null +++ b/csp/csp/expander.rkt @@ -0,0 +1,29 @@ +#lang br/quicklang +(require csp racket/stxparam racket/splicing) +(provide (all-defined-out) + (except-out (all-from-out br/quicklang) #%module-begin) + (rename-out [mb #%module-begin])) + +(define-syntax-parameter PROB (λ (stx) (error 'not-parameterized))) +(define-syntax-parameter SOLVE (make-rename-transformer #'solve)) + +(define-macro (mb EXPR0 ... #:output ID EXPR ...) + (with-syntax ([prob #'ID]) + #'(#%module-begin + (require csp) + (provide prob SOLVE) + (define prob (make-csp)) + (println prob) + (splicing-syntax-parameterize ([PROB (make-rename-transformer #'ID)]) + EXPR0 ... + EXPR ...)))) + +(define-macro (define-variable VID DOMAIN) + #'(begin + (define VID DOMAIN) + (add-var! PROB 'VID DOMAIN))) + +(define-macro (define-constraint CID FUNC VARSYMS) + #'(begin + (define CID (constraint FUNC VARSYMS)) + (add-constraint! PROB FUNC VARSYMS))) \ No newline at end of file diff --git a/csp/csp/main.rkt b/csp/csp/main.rkt index 334cb23a..374aaafe 100644 --- a/csp/csp/main.rkt +++ b/csp/csp/main.rkt @@ -1,4 +1,8 @@ #lang racket/base (require "hacs.rkt") + +(module reader syntax/module-reader + csp/expander) + (provide (all-from-out "hacs.rkt")) diff --git a/csp/csp/test-lang.rkt b/csp/csp/test-lang.rkt new file mode 100644 index 00000000..29dee7d7 --- /dev/null +++ b/csp/csp/test-lang.rkt @@ -0,0 +1,14 @@ +#lang csp +(require csp racket/list) + +#:output foo + +(define-variable q (range 33)) + +foo + +(define-variable n (range 33)) + +(define-constraint c (λ (q n) (= (+ q n) 33)) '(q n)) + +(solve foo) \ No newline at end of file From 0371737102afe28f48e34e6bcbd176109566946a Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Wed, 24 Oct 2018 16:19:47 -0700 Subject: [PATCH 182/246] learning experiment --- csp/csp/hacs-test-workbench.rkt | 10 ++--- csp/csp/hacs-test.rkt | 15 +++++--- csp/csp/hacs.rkt | 67 +++++++++++++++++++++++++-------- 3 files changed, 63 insertions(+), 29 deletions(-) diff --git a/csp/csp/hacs-test-workbench.rkt b/csp/csp/hacs-test-workbench.rkt index dfc19d45..5061afa9 100644 --- a/csp/csp/hacs-test-workbench.rkt +++ b/csp/csp/hacs-test-workbench.rkt @@ -28,11 +28,7 @@ (= (+ (word-value s e n d) (word-value m o r e)) (word-value m o n e y))) '(s e n d m o r y)) (add-pairwise-constraint! smm alldiff= '(s e n d m o r y)) -(parameterize ([current-select-variable mrv-degree-hybrid] - [current-node-consistency make-nodes-consistent]) ; todo: why is plain mrv so bad on this problem? +(parameterize ([current-select-variable mrv-degree-hybrid] ; todo: why is plain mrv bad here? + #;[current-node-consistency make-nodes-consistent]) ; todo: why is node consistency bad here? (time-named (solve smm))) - -nassns -nfchecks -nchecks - +(print-debug-info) diff --git a/csp/csp/hacs-test.rkt b/csp/csp/hacs-test.rkt index 15997254..8ae7601f 100644 --- a/csp/csp/hacs-test.rkt +++ b/csp/csp/hacs-test.rkt @@ -19,20 +19,20 @@ (csp-vars (forward-check (csp (list (avar 'a '(1)) (var 'b (range 2))) null) 'a)) (list (avar 'a '(1)) (var 'b '(0 1)))) -(check-equal? +#;(check-equal? (csp-vars (forward-check (forward-check (csp (list (avar 'a '(1)) (avar 'b '(0)) (var 'c '(0 1 2))) (list (constraint '(a c) (negate =)) (constraint '(b c) (negate =)))) 'a) 'b)) (list (avar 'a '(1)) (avar 'b '(0)) (cvar 'c '(2) '(b a)))) -(check-equal? +#;(check-equal? ;; no inconsistency: b≠c not checked when fc is relative to a (csp-vars (forward-check (csp (list (avar 'a '(1)) (var 'b (range 2)) (var 'c '(0))) (list (constraint '(a b) (negate =)) (constraint '(b c) (negate =)))) 'a)) (list (avar 'a '(1)) (cvar 'b '(0) '(a)) (var 'c '(0)))) -(check-equal? +#;(check-equal? ;; no inconsistency: a≠b not checked when fc ignores a, which is already assigned (csp-vars (forward-check (csp (list (avar 'a '(1)) (avar 'b '(1)) (var 'c (range 2))) (list (constraint '(a b) (negate =)) @@ -45,7 +45,7 @@ (list (constraint '(a b) (negate =)))) 'a)))) -(check-equal? (csp-vars (forward-check (csp (list (var 'a '(0)) +#;(check-equal? (csp-vars (forward-check (csp (list (var 'a '(0)) (var 'b (range 3))) (list (constraint '(a b) <))) 'a)) (list (var 'a '(0)) (cvar 'b '(1 2) '(a)))) @@ -82,6 +82,7 @@ (add-constraint! quarters (λ (d q) (= 17 (+ d (* 0.25 q)))) '(dollars quarters)) (check-equal? (time-named (solve quarters)) '((dollars . 14) (quarters . 12))) +(print-debug-info) ;; xsum @@ -105,7 +106,7 @@ (add-pairwise-constraint! xsum alldiff= '(l1 l2 l3 l4 r1 r2 r3 r4 x)) (check-equal? (length (time-named (solve* xsum))) 8) - +(print-debug-info) ;; send more money problem @@ -139,7 +140,7 @@ (add-pairwise-constraint! smm alldiff= '(s e n d m o r y)) (check-equal? (parameterize ([current-select-variable mrv-degree-hybrid]) ; todo: why is plain mrv so bad on this problem? (time-named (solve smm))) '((s . 9) (e . 5) (n . 6) (d . 7) (m . 1) (o . 0) (r . 8) (y . 2))) - +(print-debug-info) ;; queens problem ;; place queens on chessboard so they do not intersect @@ -159,6 +160,7 @@ (list qa qb))) (check-equal? 92 (length (time-named (solve* queens)))) +(print-debug-info) #| # There are no tricks, just pure logic, so good luck and don't give up. @@ -287,6 +289,7 @@ ((nationality-2 . englishman) (color-2 . red) (drink-2 . milk) (smoke-2 . oldgold) (pet-2 . snails)) ((nationality-3 . japanese) (color-3 . green) (drink-3 . coffee) (smoke-3 . parliaments) (pet-3 . zebra)) ((nationality-4 . spaniard) (color-4 . ivory) (drink-4 . orange-juice) (smoke-4 . luckystrike) (pet-4 . dogs)))) +(print-debug-info) (module+ main (begin diff --git a/csp/csp/hacs.rkt b/csp/csp/hacs.rkt index c32a9363..64603e8e 100644 --- a/csp/csp/hacs.rkt +++ b/csp/csp/hacs.rkt @@ -10,6 +10,10 @@ (λ (stx) (syntax-case stx () [(_ . rest) #'(void)]))))) +(define (print-debug-info) + (when-debug + (displayln (format "assignments: ~a forward checks ~a checks: ~a " nassns nchecks nfchecks)))) + (define-syntax-rule (in-cartesian x) (in-generator (let ([argss x]) (let loop ([argss argss][acc empty]) @@ -109,7 +113,7 @@ (any/c any/c . -> . boolean?) (not (= x y))) -(struct backtrack (names) #:transparent) +(struct backtrack (histories) #:transparent) (define (backtrack! [names null]) (raise (backtrack names))) (define current-select-variable (make-parameter #f)) @@ -121,6 +125,7 @@ (define current-thread-count (make-parameter 4)) (define current-node-consistency (make-parameter #f)) (define current-arity-reduction (make-parameter #t)) +(define current-learning (make-parameter #f)) (define/contract (check-name-in-csp! caller prob name) (symbol? csp? name? . -> . void?) @@ -351,18 +356,18 @@ (match ((constraints prob) . relating-only . (list ref-name name)) [(? empty?) vr] [constraints + (define ref-val (first (find-domain prob ref-name))) (define new-vals (for/list ([val (in-list vals)] #:when (for/and ([const (in-list constraints)]) - (let ([proc (constraint-proc const)] - [ref-val (first (find-domain prob ref-name))]) + (let ([proc (constraint-proc const)]) (if (eq? name (first (constraint-names const))) (proc val ref-val) (proc ref-val val))))) val)) - (checked-variable name new-vals (cons ref-name (match vr - [(checked-variable _ _ history) history] - [else null])))])])) + (checked-variable name new-vals (cons (cons ref-name ref-val) (match vr + [(checked-variable _ _ history) history] + [else null])))])])) (define/contract (prune-singleton-constraints prob [ref-name #false]) ((csp?) ((or/c #false name?)) . ->* . csp?) @@ -383,10 +388,9 @@ (define checked-vars (map (λ (vr) (forward-check-var prob ref-name vr)) (vars prob))) (when-debug (set! nfchecks (+ (length checked-vars) nchecks))) ;; conflict-set will be empty if there are no empty domains (as we would hope) - (define conflict-set (for*/list ([cvr (in-list checked-vars)] - #:when (empty? (domain cvr)) - [name (in-list (history cvr))]) - name)) + (define conflict-set (for/list ([cvr (in-list checked-vars)] + #:when (empty? (domain cvr))) + (history cvr))) ;; for conflict-directed backjumping it's essential to forward-check ALL vars ;; (even after an empty domain is generated) and combine their conflicts ;; so we can discover the *most recent past var* that could be the culprit. @@ -458,6 +462,16 @@ (filter (constraint-proc const) vals)))) other-constraints))) +(define ((make-hist-proc assocs) . xs) + (not + (for/and ([x (in-list xs)] + [val (in-list (map cdr assocs))]) + (equal? x val)))) + +(define (history->constraint hst) + (constraint (map car hst) (make-hist-proc hst))) + + (define/contract (backtracking-solver prob #:select-variable [select-unassigned-variable @@ -467,19 +481,40 @@ ((csp?) (#:select-variable procedure? #:order-values procedure? #:inference procedure?) . ->* . generator?) (generator () (define reduce-arity-proc (if (current-arity-reduction) reduce-constraint-arity values)) + (define learned-constraints null) + (define learning? (current-learning)) (let loop ([prob ((if (current-node-consistency) make-nodes-consistent values) prob)]) (match (select-unassigned-variable prob) [#false (yield prob)] [(var name domain) (define (wants-backtrack? exn) - (and (backtrack? exn) (or (let ([btns (backtrack-names exn)]) - (or (empty? btns) (memq name btns)))))) + (and (backtrack? exn) (or (let ([bths (backtrack-histories exn)]) + (or (empty? bths) (for*/or ([bth bths] + [rec bth]) + (eq? name (car rec)))))))) (for/fold ([conflicts null] #:result (void)) ([val (in-list (order-domain-values domain))]) (with-handlers ([wants-backtrack? - (λ (bt) (append conflicts (remq name (backtrack-names bt))))]) + (λ (bt) + (define bths (backtrack-histories bt)) + (when learning? + (set! learned-constraints (append + (map history->constraint (filter (λ (bth) (<= 2 (length bth) 4)) bths)) + learned-constraints))) + (append conflicts (remq name (remove-duplicates + (for*/list ([bth bths] + [rec bth]) + (car rec)) eq?))))]) (let* ([prob (assign-val prob name val)] + [prob (if learning? + (and (for ([lc learned-constraints] + #:when (for/and ([cname (constraint-names lc)]) + (memq cname (map var-name (filter assigned-var? (vars prob)))))) + (unless (lc prob) + (println 'boing) + (backtrack!))) prob) + prob)] ;; reduce constraints before inference, ;; to create more forward-checkable (binary) constraints [prob (reduce-arity-proc prob)] @@ -558,11 +593,11 @@ ((csp?) ((listof name?)) . ->* . (listof (cons/c name? any/c))) (define assocs (for/list ([vr (in-vars prob)]) - (match vr - [(var name (list val)) (cons name val)]))) + (match vr + [(var name (list val)) (cons name val)]))) (if keys (for/list ([key (in-list keys)]) - (assq key assocs)) + (assq key assocs)) assocs)) (define/contract (combine-csps probs) From 0dcccdf50f3068a8b40194199ef33ef77772e6ee Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Thu, 25 Oct 2018 13:02:43 -0700 Subject: [PATCH 183/246] docs --- csp/csp/scribblings/csp.scrbl | 131 ++++++++++++++++++++++++++++++++-- 1 file changed, 127 insertions(+), 4 deletions(-) diff --git a/csp/csp/scribblings/csp.scrbl b/csp/csp/scribblings/csp.scrbl index 6216c9da..f258b80f 100644 --- a/csp/csp/scribblings/csp.scrbl +++ b/csp/csp/scribblings/csp.scrbl @@ -1,9 +1,9 @@ #lang scribble/manual -@(require scribble/eval (for-label racket csp)) +@(require scribble/eval (for-label racket csp (except-in math/number-theory permutations))) @(define my-eval (make-base-eval)) -@(my-eval `(require csp)) +@(my-eval `(require csp racket/list)) @title{Constraint-satisfaction problems} @@ -13,9 +13,9 @@ @margin-note{This package is in development. I make no commitment to maintaining the public interface documented below.} -A simple solver for constraint-satisfaction problems. +Simple solvers for simple constraint-satisfaction problems. It uses the forward-checking + conflict-directed backjumping algorithm described in @link["http://citeseerx.ist.psu.edu/viewdoc/download?doi=10.1.1.225.3123&rep=rep1&type=pdf"]{@italic{Hybrid Algorithms for the Constraint Satisfaction Problem}} by Patrick Prosser. Plus other improvements of my own devising. -@section{Installation} +@section{Installation & usage} At the command line: @verbatim{raco pkg install csp} @@ -23,6 +23,129 @@ At the command line: After that, you can update the package like so: @verbatim{raco pkg update csp} +Import into your program like so: +@verbatim{(require csp)} + +@section{Introduction} + +A @deftech{constraint-satisfaction problem} (often shortened to @deftech{CSP}) has two ingredients. The first is a set of @deftech{variables}, each associated with a set of possible values (called a @deftech{domain}). The other is a set of @deftech{constraints} that define relationships between the variables. + +Solving a CSP means finding a value for each variable from its domain that @deftech{satisfies} (that is, doesn't violate) any constraints. This selection of values is also known as an @deftech{assignment}. A CSP may have any number of assignments that solve the problem (including zero). + +Even if the name is new, the idea of a CSP is probably familiar. For instance, many brain teasers — like Sudoku or crosswords or logic puzzles — are really just constraint-satisfaction problems. (Indeed, you can use this package to ruin all of them.) + +When the computer solves a CSP, it's using an analogous process of deductive reasoning to eliminate impossible assignments, eventually converging on a solution (or determining that no solution exists). + +@section{Example} + +Suppose we wanted to find @link["http://www.friesian.com/pythag.htm"]{Pythagorean triples} with sides between 10 and 49, inclusive. + +First we create a new CSP called @racket[triples], using @racket[make-csp]: + +@examples[#:eval my-eval +(define triples (make-csp)) +] + + +Then we need variables to represent the values in the triple. For that, we use @racket[add-var!], where each variable has a @tech{symbol} for its name and a list of values for its domain: + +@examples[#:eval my-eval +(add-var! triples 'a (range 10 50)) +(add-var! triples 'b (range 10 50)) +(add-var! triples 'c (range 10 50)) +] + +Then we need our constraint. We make a function called @racket[valid-triple?] that tests three values to see if they qualify as a Pythagorean triple. Then we insert this function as a constraint using @racket[add-constraint!], where we pass in the function we want to use for the constraint, and a list of variable names that the constraint applies to. + +@examples[#:eval my-eval +(define (valid-triple? x y z) + (= (expt z 2) (+ (expt x 2) (expt y 2)))) + +(add-constraint! triples valid-triple? '(a b c)) +] + +The argument names used within the constraint function have nothing to do with the CSP variable names that are passed to the function. This makes sense — we might want constraints that apply the same function to different groups of CSP variables. What's important is that the @tech{arity} of the constraint matches the number of variable names. + +Finally we call @racket[solve], which finds a solution (if it exists): + +@examples[#:eval my-eval +(solve triples) +] + +``But that's just the 5--12--13 triple, doubled.'' True. If we wanted to ensure that the values in our solution have no common factors, we can add a new @racket[coprime?] constraint: + +@examples[#:eval my-eval +(require math/number-theory) +(add-constraint! triples coprime? '(a b c)) +] + +And we can @racket[solve] again to see the new result: + +@examples[#:eval my-eval +(solve triples) +] + +Maybe we become curious to see how many of these triples exist. We can use @racket[solve*] to find all four solutions: + +@examples[#:eval my-eval +(solve* triples) +] + +``But really there's only two solutions — the values for @racket[a] and @racket[b] are swapped in the other two.'' Fair enough. We might say that this problem is @deftech{symmetric} relative to variables @racket[a] and @racket[b], because they have the same domains and are constrained the same way. We can break the symmetry by adding a constraint that forces @racket[a] to be less than or equal to @racket[b]: + +@examples[#:eval my-eval +(add-constraint! triples <= '(a b)) + +(solve* triples) +] + +Now our list of solutions doesn't have any symmetric duplicates. + +By the way, what if we had accidentally included @racket[c] in the last constraint? + +@examples[#:eval my-eval +(add-constraint! triples <= '(a b c)) + +(solve* triples) +] + +Nothing changes. Why? Because @racket[c] is necessarily going to be larger because of the existing @racket[valid-triple?] constraint, so it always meets this constraint too. Still, it's good practice to minimize constraints — no need for the ``belt and suspenders'' approach. + +We should use @racket[solve*] with care. It can't finish until the CSP solver examines every possible assignment of values in the problem, which can be a big number. Specifically, it's the product of the domain sizes of each variable, which in this case is 40 × 40 × 40 = 64,000. This realm of possible assignments is also known as the CSP's @deftech{state space}. We can also get this number from @racket[state-count]: + +@examples[#:eval my-eval +(state-count triples) +] + +It's easy for a CSP to have a state count in the zillions. For this reason we can supply @racket[solve*] with an optional @racket[#:limit] argument that will only generate a certain number of solutions: + +@examples[#:eval my-eval +(time (solve* triples)) +(time (solve* triples #:limit 2)) +] + +Here, the answers are the same. But the second call to @racket[solve*] finishes sooner, because it quits as soon as it's found two solutions. + +Of course, when we use ordinary @racket[solve], we don't know how many assignments it will have to try before it finds a solution. If the problem is impossible, even @racket[solve] will have to examine every possible assignment before it knows for sure. For instance, let's see what happens if we add a constraint that's impossible to meet: + +@examples[#:eval my-eval +(add-constraint! triples = '(a b c)) + +(solve triples) +] + +Disappointing but accurate. + +@section{Making & solving CSPs} + + +@section{Sideshows} + + +@section{Parameters} + + + @section{License & source code} This module is licensed under the LGPL. From cef3ac0fbee118e3c50281bda504345e3b42e538 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Thu, 25 Oct 2018 13:03:04 -0700 Subject: [PATCH 184/246] update --- csp/csp/hacs-test.rkt | 16 ++++++++-------- csp/csp/hacs.rkt | 9 +++++++-- 2 files changed, 15 insertions(+), 10 deletions(-) diff --git a/csp/csp/hacs-test.rkt b/csp/csp/hacs-test.rkt index 8ae7601f..b51435c2 100644 --- a/csp/csp/hacs-test.rkt +++ b/csp/csp/hacs-test.rkt @@ -19,25 +19,25 @@ (csp-vars (forward-check (csp (list (avar 'a '(1)) (var 'b (range 2))) null) 'a)) (list (avar 'a '(1)) (var 'b '(0 1)))) -#;(check-equal? +(check-equal? (csp-vars (forward-check (forward-check (csp (list (avar 'a '(1)) (avar 'b '(0)) (var 'c '(0 1 2))) (list (constraint '(a c) (negate =)) (constraint '(b c) (negate =)))) 'a) 'b)) - (list (avar 'a '(1)) (avar 'b '(0)) (cvar 'c '(2) '(b a)))) + (list (avar 'a '(1)) (avar 'b '(0)) (cvar 'c '(2) '((b . 0) (a . 1))))) -#;(check-equal? +(check-equal? ;; no inconsistency: b≠c not checked when fc is relative to a (csp-vars (forward-check (csp (list (avar 'a '(1)) (var 'b (range 2)) (var 'c '(0))) (list (constraint '(a b) (negate =)) (constraint '(b c) (negate =)))) 'a)) - (list (avar 'a '(1)) (cvar 'b '(0) '(a)) (var 'c '(0)))) + (list (avar 'a '(1)) (cvar 'b '(0) '((a . 1))) (var 'c '(0)))) -#;(check-equal? +(check-equal? ;; no inconsistency: a≠b not checked when fc ignores a, which is already assigned (csp-vars (forward-check (csp (list (avar 'a '(1)) (avar 'b '(1)) (var 'c (range 2))) (list (constraint '(a b) (negate =)) (constraint '(b c) (negate =)))) 'b)) - (list (avar 'a '(1)) (avar 'b '(1)) (cvar 'c '(0) '(b)))) + (list (avar 'a '(1)) (avar 'b '(1)) (cvar 'c '(0) '((b . 1))))) (check-exn backtrack? (λ () (csp-vars (forward-check (csp (list (avar 'a '(1)) @@ -45,10 +45,10 @@ (list (constraint '(a b) (negate =)))) 'a)))) -#;(check-equal? (csp-vars (forward-check (csp (list (var 'a '(0)) +(check-equal? (csp-vars (forward-check (csp (list (var 'a '(0)) (var 'b (range 3))) (list (constraint '(a b) <))) 'a)) - (list (var 'a '(0)) (cvar 'b '(1 2) '(a)))) + (list (var 'a '(0)) (cvar 'b '(1 2) '((a . 0))))) (check-equal? (parameterize ([current-inference forward-check]) diff --git a/csp/csp/hacs.rkt b/csp/csp/hacs.rkt index 64603e8e..9ccaef66 100644 --- a/csp/csp/hacs.rkt +++ b/csp/csp/hacs.rkt @@ -244,6 +244,11 @@ (var? . -> . natural?) (length (domain var))) +(define/contract (state-count csp) + (csp? . -> . natural?) + (for/product ([var (in-vars csp)]) + (domain-length var))) + (define/contract (mrv-degree-hybrid prob) (csp? . -> . (or/c #f var?)) (match (unassigned-vars prob) @@ -649,8 +654,8 @@ . ->* . (or/c #false any/c)) (match (solve* prob #:finish-proc finish-proc #:solver solver #:limit max-solutions) [(list solution) solution] - [(list solutions ...) solutions] - [else #false])) + [(list) #false] + [(list solutions ...) solutions])) (define (<> a b) (not (= a b))) (define (neq? a b) (not (eq? a b))) From d65248e80c07ca9544a41162ced7a1fc3a8fd864 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Thu, 25 Oct 2018 13:03:10 -0700 Subject: [PATCH 185/246] purge --- csp/csp/port/constraint.rkt | 129 -- csp/csp/port/domain.rkt | 63 - csp/csp/port/helper.rkt | 83 - csp/csp/port/main.rkt | 13 - csp/csp/port/problem.rkt | 118 -- csp/csp/port/solver.rkt | 120 -- csp/csp/port/test-classes.rkt | 74 - csp/csp/port/test-einstein.rkt | 168 -- csp/csp/port/test-problems.rkt | 152 -- csp/csp/port/variable.rkt | 17 - .../API Documentation.webloc | 8 - csp/csp/python-constraint/LICENSE | 23 - csp/csp/python-constraint/MANIFEST.in | 2 - csp/csp/python-constraint/PKG-INFO | 13 - csp/csp/python-constraint/README | 1 - csp/csp/python-constraint/constraint.py | 1469 ----------------- csp/csp/python-constraint/examples/abc/abc.py | 30 - .../python-constraint/examples/coins/coins.py | 30 - .../examples/crosswords/crosswords.py | 153 -- .../examples/crosswords/large.mask | 27 - .../examples/crosswords/medium.mask | 19 - .../examples/crosswords/python.mask | 8 - .../examples/crosswords/small.mask | 8 - .../examples/einstein/einstein.py | 201 --- .../examples/einstein/einstein2.py | 190 --- .../examples/queens/queens.py | 47 - .../python-constraint/examples/rooks/rooks.py | 49 - .../examples/studentdesks/studentdesks.py | 39 - .../examples/sudoku/sudoku.py | 61 - .../examples/wordmath/seisseisdoze.py | 32 - .../examples/wordmath/sendmoremoney.py | 34 - .../examples/wordmath/twotwofour.py | 28 - .../python-constraint/examples/xsum/xsum.py | 37 - csp/csp/python-constraint/setup.cfg | 6 - csp/csp/python-constraint/setup.py | 21 - csp/csp/python-constraint/testconstraint.py | 13 - csp/csp/python-constraint/trials/abcd.py | 29 - csp/csp/python-constraint/trials/coins.py | 30 - .../python-constraint/trials/constraint.py | 1434 ---------------- .../python-constraint/trials/crosswords.py | 153 -- csp/csp/python-constraint/trials/einstein.py | 201 --- csp/csp/python-constraint/trials/einstein2.py | 190 --- csp/csp/python-constraint/trials/large.mask | 27 - csp/csp/python-constraint/trials/medium.mask | 19 - csp/csp/python-constraint/trials/python.mask | 8 - csp/csp/python-constraint/trials/queens.py | 47 - csp/csp/python-constraint/trials/rooks.py | 49 - .../python-constraint/trials/seisseisdoze.py | 32 - .../python-constraint/trials/sendmoremoney.py | 34 - csp/csp/python-constraint/trials/small.mask | 8 - .../python-constraint/trials/studentdesks.py | 39 - csp/csp/python-constraint/trials/sudoku.py | 61 - .../python-constraint/trials/twotwofour.py | 28 - csp/csp/python-constraint/trials/xsum.py | 37 - 54 files changed, 5912 deletions(-) delete mode 100644 csp/csp/port/constraint.rkt delete mode 100644 csp/csp/port/domain.rkt delete mode 100644 csp/csp/port/helper.rkt delete mode 100644 csp/csp/port/main.rkt delete mode 100644 csp/csp/port/problem.rkt delete mode 100644 csp/csp/port/solver.rkt delete mode 100644 csp/csp/port/test-classes.rkt delete mode 100644 csp/csp/port/test-einstein.rkt delete mode 100644 csp/csp/port/test-problems.rkt delete mode 100644 csp/csp/port/variable.rkt delete mode 100644 csp/csp/python-constraint/API Documentation.webloc delete mode 100644 csp/csp/python-constraint/LICENSE delete mode 100644 csp/csp/python-constraint/MANIFEST.in delete mode 100644 csp/csp/python-constraint/PKG-INFO delete mode 100644 csp/csp/python-constraint/README delete mode 100644 csp/csp/python-constraint/constraint.py delete mode 100755 csp/csp/python-constraint/examples/abc/abc.py delete mode 100755 csp/csp/python-constraint/examples/coins/coins.py delete mode 100755 csp/csp/python-constraint/examples/crosswords/crosswords.py delete mode 100644 csp/csp/python-constraint/examples/crosswords/large.mask delete mode 100644 csp/csp/python-constraint/examples/crosswords/medium.mask delete mode 100644 csp/csp/python-constraint/examples/crosswords/python.mask delete mode 100644 csp/csp/python-constraint/examples/crosswords/small.mask delete mode 100755 csp/csp/python-constraint/examples/einstein/einstein.py delete mode 100755 csp/csp/python-constraint/examples/einstein/einstein2.py delete mode 100755 csp/csp/python-constraint/examples/queens/queens.py delete mode 100755 csp/csp/python-constraint/examples/rooks/rooks.py delete mode 100755 csp/csp/python-constraint/examples/studentdesks/studentdesks.py delete mode 100644 csp/csp/python-constraint/examples/sudoku/sudoku.py delete mode 100755 csp/csp/python-constraint/examples/wordmath/seisseisdoze.py delete mode 100755 csp/csp/python-constraint/examples/wordmath/sendmoremoney.py delete mode 100755 csp/csp/python-constraint/examples/wordmath/twotwofour.py delete mode 100755 csp/csp/python-constraint/examples/xsum/xsum.py delete mode 100644 csp/csp/python-constraint/setup.cfg delete mode 100755 csp/csp/python-constraint/setup.py delete mode 100644 csp/csp/python-constraint/testconstraint.py delete mode 100755 csp/csp/python-constraint/trials/abcd.py delete mode 100755 csp/csp/python-constraint/trials/coins.py delete mode 100644 csp/csp/python-constraint/trials/constraint.py delete mode 100755 csp/csp/python-constraint/trials/crosswords.py delete mode 100755 csp/csp/python-constraint/trials/einstein.py delete mode 100755 csp/csp/python-constraint/trials/einstein2.py delete mode 100644 csp/csp/python-constraint/trials/large.mask delete mode 100644 csp/csp/python-constraint/trials/medium.mask delete mode 100644 csp/csp/python-constraint/trials/python.mask delete mode 100755 csp/csp/python-constraint/trials/queens.py delete mode 100755 csp/csp/python-constraint/trials/rooks.py delete mode 100755 csp/csp/python-constraint/trials/seisseisdoze.py delete mode 100755 csp/csp/python-constraint/trials/sendmoremoney.py delete mode 100644 csp/csp/python-constraint/trials/small.mask delete mode 100755 csp/csp/python-constraint/trials/studentdesks.py delete mode 100644 csp/csp/python-constraint/trials/sudoku.py delete mode 100755 csp/csp/python-constraint/trials/twotwofour.py delete mode 100755 csp/csp/python-constraint/trials/xsum.py diff --git a/csp/csp/port/constraint.rkt b/csp/csp/port/constraint.rkt deleted file mode 100644 index d73fcd2e..00000000 --- a/csp/csp/port/constraint.rkt +++ /dev/null @@ -1,129 +0,0 @@ -#lang racket/base -(require racket/class racket/bool sugar/unstable/container sugar/list sugar/debug racket/list "helper.rkt" "variable.rkt") -(provide (all-defined-out)) - -(define constraint% - (class object% - (super-new) - - (define/public (is-true? variables domains assignments [forward-check? #f]) - ;; Perform the constraint checking - - ;; If the forwardcheck parameter is not false, besides telling if - ;; the constraint is currently broken or not, the constraint - ;; implementation may choose to hide values from the domains of - ;; unassigned variables to prevent them from being used, and thus - ;; prune the search space. - #t) - - (define/public (preprocess variables domains constraints vconstraints) - ;; todo: functionalize this - ;; Preprocess variable domains - ;; This method is called before starting to look for solutions, - ;; and is used to prune domains with specific constraint logic - ;; when possible. For instance, any constraints with a single - ;; variable may be applied on all possible values and removed, - ;; since they may act on individual values even without further - ;; knowledge about other assignments. - (when (= (length variables) 1) - (define variable (car variables)) - (define domain (hash-ref domains variable)) - (set-field! _list domain - (for/fold ([domain-values (domain)]) - ([value (in-list (domain))] - #:unless (is-true? variables domains (make-hash (list (cons variable value))))) - (remove value domain-values))) - (set! constraints (remove (list this variables) constraints)) - (hash-update! vconstraints variable (λ(val) (remove (list this variables) val))))) - - ;; Helper method for generic forward checking - ;; Currently, this method acts only when there's a single - ;; unassigned variable. - (define/public (forward-check variables domains assignments [_unassigned Unassigned]) - (define unassigned-variables - (filter-not (λ(v) (hash-has-key? assignments v)) variables)) - (cond - ;; Remove from the unassigned variable's domain - ;; all values that break our variable's constraints. - [(= (length unassigned-variables) 1) - (define unassigned-variable (car unassigned-variables)) - (define unassigned-variable-domain (hash-ref domains unassigned-variable)) - (for ([value (in-list (unassigned-variable-domain))]) - (hash-set! assignments unassigned-variable value) - (unless (is-true? variables domains assignments) - (send unassigned-variable-domain hide-value value))) - (hash-remove! assignments unassigned-variable) - (not (empty? unassigned-variable-domain))] ; if domain had no remaining values, the constraint will be impossible to meet, so return #f - [else #t])) - )) - -(define constraint%? (is-a?/c constraint%)) - -(define function-constraint% - (class constraint% - (super-new) - - (init-field func [assigned #t]) - - (field [_func func][_assigned assigned]) - - (inherit forward-check) - - (define/override (is-true? variables domains assignments [forward-check? #f] [_unassigned Unassigned]) - (define parms (map (λ(v) (hash-ref assignments v _unassigned)) variables)) - (define missing (length (filter (λ(p) (equal? p _unassigned)) parms))) - (if (> missing 0) - (and (or _assigned (apply _func parms)) - (or (not forward-check?) (not (= missing 1)) - (forward-check variables domains assignments))) - (apply _func parms))))) - -(define function-constraint%? (is-a?/c function-constraint%)) - -;; Constraint enforcing that values of all given variables are different -(define all-different-constraint% - (class constraint% - (super-new) - - (define/override (is-true? variables domains assignments [forward-check? #f] [_unassigned Unassigned]) - (define-values (assigned-vars unassigned-vars) - (partition (λ(var) (hash-has-key? assignments var)) variables)) - (define assigned-values (map (λ(var) (hash-ref assignments var)) assigned-vars)) - (cond - [(not (members-unique? assigned-values)) #f] ; constraint failed because they're not all different - [(and forward-check? - (for*/or ([unassigned-var-domain (in-list (map (λ(uv) (hash-ref domains uv)) unassigned-vars))] - [assigned-value (in-list assigned-values)] - #:when (member assigned-value (unassigned-var-domain))) - (send unassigned-var-domain hide-value assigned-value) - (empty? unassigned-var-domain))) #f] ; if domain had no remaining values, the constraint will be impossible to meet, so return #f - [else #t])))) - -(define all-different-constraint%? (is-a?/c all-different-constraint%)) - -;; Constraint enforcing that values of all given variables are different -(define all-equal-constraint% - (class constraint% - (super-new) - - (define/override (is-true? variables domains assignments [forward-check? #f] [_unassigned Unassigned]) - (define-values (assigned-vars unassigned-vars) - (partition (λ(var) (hash-has-key? assignments var)) variables)) - (define assigned-values (map (λ(var) (hash-ref assignments var)) assigned-vars)) - (define single-value (if (not (empty? assigned-values)) - (car assigned-values) - _unassigned)) - (cond - [(not (andmap (λ(v) (equal? single-value v)) assigned-values)) #f] ; constraint broken: not all values the same - [(and forward-check? (not (equal? single-value _unassigned))) - (for/and ([unassigned-var-domain (in-list (map (λ(uv) (hash-ref domains uv)) unassigned-vars))]) - ;; if single-value is not a member of each domain, constraint will be broken later, so bail out - (and (member single-value (unassigned-var-domain)) - (for ([value (in-list (unassigned-var-domain))] - #:unless (equal? value single-value)) - (send unassigned-var-domain hide-value value))))] ; otherwise hide nonconforming values - [else #t])))) - - -(define all-equal-constraint%? (is-a?/c all-equal-constraint%)) - diff --git a/csp/csp/port/domain.rkt b/csp/csp/port/domain.rkt deleted file mode 100644 index dccc55d9..00000000 --- a/csp/csp/port/domain.rkt +++ /dev/null @@ -1,63 +0,0 @@ -#lang racket/base -(require racket/class racket/list "helper.rkt") -(provide (all-defined-out)) - -;; Class used to control possible values for variables -;; When list or tuples are used as domains, they are automatically -;; converted to an instance of that class. -(define domain% - (class* object% (printable<%> (make-proc<%> get-values)) - (super-new) - (init-field set) - (field [_list set][_hidden null][_states null]) - - (define (repr) (format "" _list)) - (define/public (custom-print out quoting-depth) (print (repr) out)) - (define/public (custom-display out) (displayln (repr) out)) - (define/public (custom-write out) (write (repr) out)) - - (define/public (reset-state) - ;; Reset to the original domain state, including all possible values - (py-extend! _list _hidden) - (set! _hidden null) - (set! _states null)) - - (define/public (push-state) - ;; Save current domain state - ;; Variables hidden after that call are restored when that state - ;; is popped from the stack. - (py-append! _states (length _list))) - - (define/public (pop-state) - ;; Restore domain state from the top of the stack - - ;; Variables hidden since the last popped state are then available - ;; again. - (define diff (- (py-pop! _states) (length _list))) - (when (not (= 0 diff)) - (py-extend! _list (take-right _hidden diff)) - (set! _hidden (take _hidden (- (length _hidden) diff))))) - - (define/public (hide-value value) - ;; Hide the given value from the domain - - ;; After that call the given value won't be seen as a possible value - ;; on that domain anymore. The hidden value will be restored when the - ;; previous saved state is popped. - (set! _list (remove value _list)) - (py-append! _hidden value)) - - (define/public (get-values) - _list) - - (define/public (domain-pop!) - (py-pop! _list)) - - (define/public (copy) - (define copied-domain (new domain% [set _list])) - (set-field! _hidden copied-domain _hidden) - (set-field! _states copied-domain _states) - copied-domain))) - -(define domain%? (is-a?/c domain%)) - diff --git a/csp/csp/port/helper.rkt b/csp/csp/port/helper.rkt deleted file mode 100644 index c607c9ea..00000000 --- a/csp/csp/port/helper.rkt +++ /dev/null @@ -1,83 +0,0 @@ -#lang racket/base -(require racket/class racket/list (for-syntax racket/base racket/syntax)) -(provide (all-defined-out)) -(require rackunit) - -(define-syntax-rule (forever expr ...) - (for ([i (in-naturals)]) - expr ...)) - -(define-syntax-rule (forever/until expr ...) - (for/or ([i (in-naturals)]) - expr ...)) - -(define-syntax-rule (for-each-send proc objects) - (for-each (λ(o) (send o proc)) objects)) - -(define-syntax-rule (make-proc<%> proc-name) - (interface* () - ([prop:procedure - (λ(this . args) - (send/apply this proc-name args))]) - proc-name)) - -(define-simple-check (check-hash-items h1 h2) - (for/and ([(k1 v1) (in-hash h1)]) - (equal? (hash-ref h2 k1) v1))) - -(define (list-comparator xs ys) - ;; For use in sort. Compares two lists element by element. - (cond - [(equal? xs ys) #f] ; elements are same, so no sort preference - [(and (null? xs) (not (null? ys))) #t] ; ys is longer, so #t - [(and (not (null? xs)) (null? ys)) #f] ; xs is longer, so #f makes it sort later - [else (let ([x (car xs)][y (car ys)]) - (cond - [(equal? x y) (list-comparator (cdr xs) (cdr ys))] - [(and (real? x) (real? y)) (< x y)] - [(and (symbol? x) (symbol? y)) (apply stringstring (list x y)))] - [(and (string? x) (string? y)) (stringm void?)] - [set-solver (solver%? . ->m . void?)] - [get-solver (->m solver%?)] - [add-variable (any/c (or/c list? domain%?) . ->m . void?)] - [add-variables ((listof any/c) (or/c list? domain%?) . ->m . void?)] - [add-constraint (((or/c constraint%? procedure?)) ((listof any/c)) . ->*m . void?)] - [get-solution (->m any/c)] - [get-solutions (->m list?)]) - - (class* object% (printable<%>) - (super-new) - - (init-field [solver #f]) - (field [_solver (or solver (new backtracking-solver%))] - [_constraints #f] - [_variable-domains #f]) - - (reset) ; use method rather than manually set up fields - - ;; implement object printing - (define (repr) (format "" (hash-keys _variable-domains))) - (define/public (custom-print out quoting-depth) (print (repr) out)) - (define/public (custom-display out) (displayln (repr) out)) - (define/public (custom-write out) (write (repr) out)) - - ;; Reset the current problem definition - (define/public (reset) - (set! _constraints null) - (set! _variable-domains (make-hash))) - - ;; Set the problem solver currently in use - (define/public (set-solver solver) - (set! _solver solver)) - - ;; Get the problem solver currently in use - (define/public (get-solver) - _solver) - - ;; Add a variable to the problem - ;; Contract insures input is Domain object or list of values. - (define/public (add-variable variable domain-or-values) - (when (hash-has-key? _variable-domains variable) - (error 'add-variable (format "Tried to insert duplicated variable ~a" variable))) - (define domain (if (domain%? domain-or-values) - (send domain-or-values copy) - (new domain% [set domain-or-values]))) - (when (null? (domain)) - (error 'add-variable "domain value is null")) - (hash-set! _variable-domains variable domain)) - - ;; Add one or more variables to the problem - (define/public (add-variables variables domain) - (define in-thing (cond - [(string? variables) in-string] - [(list? variables) in-list] - [else (error 'add-variables (format "Don’t know what to do with ~a" variables))])) - (for ([var (in-thing variables)]) - (add-variable var domain))) - - ;; Add a constraint to the problem - ;; contract guarantees input is procedure or constraint% object - (define/public (add-constraint constraint-or-proc [variables null]) - (define constraint (if (procedure? constraint-or-proc) - (new function-constraint% [func constraint-or-proc]) - constraint-or-proc)) - (py-append! _constraints (list constraint variables))) - - (define-syntax-rule (solution-macro solution-proc null-proc) - (begin - (define-values (domains constraints vconstraints) (get-args)) - (if (null? domains) - (if null-proc (null-proc null) null) - (send _solver solution-proc domains constraints vconstraints)))) - - ;; Find and return a solution to the problem - (define/public (get-solution) - (solution-macro get-solution #f)) - - ;; Find and return all solutions to the problem - (define/public (get-solutions) - (solution-macro get-solutions #f)) - - ;; Return an iterator to the solutions of the problem - (define/public (get-solution-iter) - (solution-macro get-solution-iter yield)) - - (define/private (get-args) - (define variable-domains (hash-copy _variable-domains)) - - (define constraints - (let ([all-variables (hash-keys variable-domains)]) - (for/list ([(constraint variables) (in-parallel (map first _constraints) (map second _constraints))]) - (list constraint (if (null? variables) all-variables variables))))) - - (define vconstraints - (hash-copy ; converts for/hash to mutable hash - (for/hash ([variable (in-hash-keys variable-domains)]) - (values variable null)))) - - (for* ([(constraint variables) (in-parallel (map first constraints) (map second constraints))] - [variable (in-list variables)]) - (hash-update! vconstraints variable (λ(val) (cons (list constraint variables) val)))) - - (for ([(constraint variables) (in-parallel (map first constraints) (map second constraints))]) - (send constraint preprocess variables variable-domains constraints vconstraints)) - - (if (for/or ([domain (in-hash-values variable-domains)]) - (send domain reset-state) - (null? (domain))) - (values null null null) - (values variable-domains constraints vconstraints))))) \ No newline at end of file diff --git a/csp/csp/port/solver.rkt b/csp/csp/port/solver.rkt deleted file mode 100644 index 742e63bd..00000000 --- a/csp/csp/port/solver.rkt +++ /dev/null @@ -1,120 +0,0 @@ -#lang racket/base -(require racket/class sugar/unstable/container sugar/debug racket/list - racket/bool racket/generator racket/match "helper.rkt") -(provide (all-defined-out)) - -(define solver% - ;; Abstract base class for solvers - (class object% - (super-new) - (abstract get-solution) - (abstract get-solutions) - (abstract get-solution-iter))) - -(define solver%? (is-a?/c solver%)) - -(struct vvp (variable values pushdomains)) -(define-syntax-rule (pop-vvp-values! vvps) - (if (empty? vvps) - (error 'pop-vvp-values! (format "~a is null" vvps)) - (let ([vvp (car vvps)]) - (set! vvps (cdr vvps)) - (values (vvp-variable vvp) (vvp-values vvp) (vvp-pushdomains vvp))))) - -#| -(define (recursive-backtracking assignment csp) - (if (complete? assignment) - assignment - (let ([var (select-unassigned-variable csp-variables, assignment, csp)]) - (for/or ([value (in-list (order-domain-values var assignment csp))]) - if ((value . consistent-with? . assignment csp-constraints)) - (add-to assignment var value) - (define result (recursive-backtracking assignment csp)) - (when result - (and result (remove-from assignment var value))) - #f)))) -|# - -(define backtracking-solver% - ;; Problem solver with backtracking capabilities - (class solver% - (super-new) - (init-field [forwardcheck #t]) - (field [_forwardcheck forwardcheck]) - - (define/override (get-solution-iter domains constraints vconstraints) - (define sorted-variables (sort (hash-keys domains) list-comparator - #:key (λ(var) - (list (- (length (hash-ref vconstraints var))) - (length ((hash-ref domains var))) - var)))) - ;; state-retention variables - (define possible-solution (make-hash)) - (define variable-queue null) - (define variable #f) - (define values null) - (define pushdomains null) - - (define (get-next-unassigned-variable) - (for/first ([sorted-variable (in-list sorted-variables)] - #:unless (hash-has-key? possible-solution sorted-variable)) - (set! variable sorted-variable) - (set! values ((hash-ref domains variable))) - (set! pushdomains - (if _forwardcheck - (for/list ([(var domain) (in-hash domains)] - #:unless (and (equal? variable var) - (hash-has-key? possible-solution var))) - domain) - null)) - variable)) - - (define (set!-previous-variable) - (set!-values (variable values pushdomains) (pop-vvp-values! variable-queue)) - (for-each-send pop-state pushdomains)) - - (let/ec exit-k - ;; mix the degree and minimum-remaining-values (MRV) heuristics - (forever - (unless (get-next-unassigned-variable) - (yield (hash-copy possible-solution)) ; if there are no unassigned variables, solution is complete. - (if (empty? variable-queue) - (exit-k) ; all done, no other solutions possible. - (set!-previous-variable))) ; otherwise return to previous variable - - (let value-checking-loop () ; we have a variable. Do we have any values left? - (when (empty? values) ; no, so try going back to last variable and getting some values - (forever/until - (when (empty? variable-queue) (exit-k)) ; no variables left, so solver is done - (hash-remove! possible-solution variable) - (set!-previous-variable) - (not (empty? values)))) - - ;; Got a value. Check it. - (hash-set! possible-solution variable (car-pop! values)) - (for-each-send push-state pushdomains) - (unless (for/and ([constraint+variables (in-list (hash-ref vconstraints variable))]) - (let ([constraint (car constraint+variables)] - [variables (cadr constraint+variables)]) - (send constraint is-true? variables domains possible-solution pushdomains))) - ;; constraint failed, so try again - (for-each-send pop-state pushdomains) - (value-checking-loop))) - - ;; Push state before looking for next variable. - (set! variable-queue (cons (vvp variable values pushdomains) variable-queue))) - (error 'get-solution-iter "impossible to reach this")) - (void)) - - - (define (call-solution-generator domains constraints vconstraints #:first-only [first-only #f]) - (for/list ([solution (in-generator (get-solution-iter domains constraints vconstraints))] #:final first-only) - solution)) - - (define/override (get-solution . args) - (car (apply call-solution-generator #:first-only #t args))) - - (define/override (get-solutions . args) - (apply call-solution-generator args)))) - -(define backtracking-solver%? (is-a?/c backtracking-solver%)) diff --git a/csp/csp/port/test-classes.rkt b/csp/csp/port/test-classes.rkt deleted file mode 100644 index 21e129e4..00000000 --- a/csp/csp/port/test-classes.rkt +++ /dev/null @@ -1,74 +0,0 @@ -#lang racket -(require rackunit "main.rkt") - - -;; Problem: fields -(check-equal? (get-field _solver (new problem% [solver 'solver-in])) 'solver-in) -(check-equal? (get-field _constraints (new problem%)) null) -(check-equal? (get-field _variable-domains (new problem%)) (make-hash)) - -(define problem null) - -;; Problem: reset -(set! problem (new problem%)) -(define early-solutions (send problem get-solutions)) -(send problem add-variable "a" (range 3)) -(check-not-equal? (send problem get-solutions) early-solutions) -(send problem reset) -(check-equal? (send problem get-solutions) early-solutions) - -;; Problem: setSolver & get-solver -(define solver (new backtracking-solver%)) -(set! problem (new problem% [solver solver])) -(check-true (solver%? (send problem get-solver))) - -;; Problem: add-variable -(set! problem (new problem%)) -(send problem add-variable "a" '(1 2)) -(check-true (or (= (hash-ref (send problem get-solution) "a") 1) - (= (hash-ref (send problem get-solution) "a") 2))) -(check-exn exn:fail? (λ () (send problem add-variable "b" null))) ;; empty domain - - -;; Problem: add-variables -(set! problem (new problem%)) -(send problem add-variables '("a" "b") '(1 2 3)) -(check-equal? (length (send problem get-solutions)) 9) - -;; Problem: add-constraint -(set! problem (new problem%)) -(send problem add-variables '("a" "b") '(1 2 3)) -(send problem add-constraint (λ(a b) (= a (add1 b)))) -(check-equal? (length (send problem get-solutions)) 2) - - -;; FunctionConstraint, two ways: implicit and explicit -(send problem reset) -(send problem add-variables '(a b) '(1 2)) -(send problem add-constraint <) ; implicit -(check-true (let ([s (sort (hash->list (send problem get-solution)) #:key cdr <)]) - (or (equal? s '((a . 1) (b . 2))) (equal? s '((b . 1) (a . 2)))))) -(send problem reset) -(send problem add-variables '(a b) '(1 2)) -(send problem add-constraint (new function-constraint% [func <])) ; explicit -(check-true (let ([s (sort (hash->list (send problem get-solution)) #:key cdr <)]) - (or (equal? s '((a . 1) (b . 2))) (equal? s '((b . 1) (a . 2)))))) - -;; AllDifferentConstraint -(send problem reset) -(send problem add-variables '(a b) '(1 2)) -(send problem add-constraint (new all-different-constraint%)) -(let ([solutions (send problem get-solutions)]) - (check-equal? (hash-ref (first solutions) 'a) (hash-ref (second solutions) 'b)) - (check-equal? (hash-ref (second solutions) 'a) (hash-ref (first solutions) 'b))) - - -;; AllEqualConstraint -(send problem reset) -(send problem add-variables '(a b) '(1 2)) -(send problem add-constraint (new all-equal-constraint%)) -(let ([solutions (send problem get-solutions)]) - (check-equal? (hash-ref (first solutions) 'a) (hash-ref (first solutions) 'b)) - (check-equal? (hash-ref (second solutions) 'a) (hash-ref (second solutions) 'b))) - - diff --git a/csp/csp/port/test-einstein.rkt b/csp/csp/port/test-einstein.rkt deleted file mode 100644 index aeef4b4d..00000000 --- a/csp/csp/port/test-einstein.rkt +++ /dev/null @@ -1,168 +0,0 @@ -#lang racket - -(require "problem.rkt" "constraint.rkt" sugar/debug) - -#| -# There are no tricks, just pure logic, so good luck and don't give up. -# -# 1. In a street there are five houses, painted five different colours. -# 2. In each house lives a person of different nationality -# 3. These five homeowners each drink a different kind of beverage, smoke -# different brand of cigar and keep a different pet. -# -# THE QUESTION: WHO OWNS THE zebra? -# -# HINTS -# -# 1. The englishman lives in a red house. -# 2. The spaniard keeps dogs as pets. -# 5. The owner of the Green house drinks coffee. -# 3. The ukrainian drinks tea. -# 4. The Green house is on the left of the ivory house. -# 6. The person who smokes oldgold rears snails. -# 7. The owner of the Yellow house smokes kools. -# 8. The man living in the centre house drinks milk. -# 9. The Norwegian lives in the first house. -# 10. The man who smokes chesterfields lives next to the one who keeps foxes. -# 11. The man who keeps horses lives next to the man who smokes kools. -# 12. The man who smokes luckystrike drinks orangejuice. -# 13. The japanese smokes parliaments. -# 14. The Norwegian lives next to the blue house. -# 15. The man who smokes chesterfields has a neighbour who drinks water. -|# - -(define ep (new problem%)) - -(for ([idx '(1 2 3 4 5)]) - (send ep add-variable (format "color~a" idx) '("red" "ivory" "green" "yellow" "blue")) - - (send ep add-variable (format "nationality~a" idx) '("englishman" "spaniard" "ukrainian" "norwegian" "japanese")) - - (send ep add-variable (format "drink~a" idx) '("tea" "coffee" "milk" "orangejuice" "water")) - - (send ep add-variable (format "smoke~a" idx) '("oldgold" "kools" "chesterfields" "luckystrike" "parliaments")) - - (send ep add-variable (format "pet~a" idx) '("dogs" "snails" "foxes" "horses" "zebra"))) - -(for ([name '("color" "nationality" "drink" "smoke" "pet")]) - (send ep add-constraint (new all-different-constraint%) - (map (λ(idx) (format "~a~a" name idx)) '(1 2 3 4 5)))) - - -(for ([idx '(1 2 3 4 5)]) - (send ep add-constraint - (λ(n c) (or (not (equal? n "englishman")) (equal? c "red"))) - (list (format "nationality~a" idx) (format "color~a" idx))) - - - (send ep add-constraint - (λ(n p) (or (not (equal? n "spaniard")) (equal? p "dogs"))) - (list (format "nationality~a" idx) (format "pet~a" idx))) - - (send ep add-constraint - (λ(n d) (or (not (equal? n "ukrainian")) (equal? d "tea"))) - (list (format "nationality~a" idx) (format "drink~a" idx))) - - (if (< idx 5) - (send ep add-constraint - (λ(ca cb) (or (not (equal? ca "green")) (equal? cb "ivory"))) - (list (format "color~a" idx) (format "color~a" (add1 idx)))) - (send ep add-constraint - (λ(c) (not (equal? c "green"))) - (list (format "color~a" idx)))) - - (send ep add-constraint - (λ(c d) (or (not (equal? c "green")) (equal? d "coffee"))) - (list (format "color~a" idx) (format "drink~a" idx))) - - (send ep add-constraint - (λ(s p) (or (not (equal? s "oldgold")) (equal? p "snails"))) - (list (format "smoke~a" idx) (format "pet~a" idx))) - - (send ep add-constraint - (λ(c s) (or (not (equal? c "yellow")) (equal? s "kools"))) - (list (format "color~a" idx) (format "smoke~a" idx))) - - (when (= idx 3) - (send ep add-constraint - (λ(d) (equal? d "milk")) - (list (format "drink~a" idx)))) - - (when (= idx 1) - (send ep add-constraint - (λ(n) (equal? n "norwegian")) - (list (format "nationality~a" idx)))) - - (if (< 1 idx 5) - (send ep add-constraint - (λ(s pa pb) (or (not (equal? s "chesterfields")) (equal? pa "foxes") (equal? pb "foxes"))) - (list (format "smoke~a" idx) (format "pet~a" (add1 idx)) (format "pet~a" (sub1 idx)))) - (send ep add-constraint - (λ(s p) (or (not (equal? s "chesterfields")) (equal? p "foxes"))) - (list (format "smoke~a" idx) (format "pet~a" (if (= idx 1) 2 4))))) - - (if (< 1 idx 5) - (send ep add-constraint - (λ(p sa sb) (or (not (equal? p "horses")) (equal? sa "kools") (equal? sb "kools"))) - (list (format "pet~a" idx) (format "smoke~a" (add1 idx)) (format "smoke~a" (sub1 idx)))) - (send ep add-constraint - (λ(p s) (or (not (equal? p "horses")) (equal? s "kools"))) - (list (format "pet~a" idx) (format "smoke~a" (if (= idx 1) 2 4))))) - - (send ep add-constraint - (λ(s d) (or (not (equal? s "luckystrike")) (equal? d "orangejuice"))) - (list (format "smoke~a" idx) (format "drink~a" idx))) - - (send ep add-constraint - (λ(n s) (or (not (equal? n "japanese")) (equal? s "parliaments"))) - (list (format "nationality~a" idx) (format "smoke~a" idx))) - - - (if (< 1 idx 5) - (send ep add-constraint - (λ(n ca cb) (or (not (equal? n "norwegian")) (equal? ca "blue") (equal? cb "blue"))) - (list (format "nationality~a" idx) (format "color~a" (add1 idx)) (format "color~a" (sub1 idx)))) - (send ep add-constraint - (λ(n c) (or (not (equal? n "norwegian")) (equal? c "blue"))) - (list (format "nationality~a" idx) (format "color~a" (if (= idx 1) 2 4))))) - - - ) - - -(module+ main - (require rackunit) - -(define s (time (send ep get-solution))) - -(define result - (for*/list ([idx '(1 2 3 4 5)] - [name '("nationality" "color" "drink" "smoke" "pet")]) - (define key (format "~a~a" name idx)) - (format "~a ~a" key (hash-ref s key)))) - -(check-equal? result '("nationality1 norwegian" - "color1 yellow" - "drink1 water" - "smoke1 kools" - "pet1 foxes" - "nationality2 ukrainian" - "color2 blue" - "drink2 tea" - "smoke2 chesterfields" - "pet2 horses" - "nationality3 englishman" - "color3 red" - "drink3 milk" - "smoke3 oldgold" - "pet3 snails" - "nationality4 japanese" - "color4 green" - "drink4 coffee" - "smoke4 parliaments" - "pet4 zebra" - "nationality5 spaniard" - "color5 ivory" - "drink5 orangejuice" - "smoke5 luckystrike" - "pet5 dogs"))) \ No newline at end of file diff --git a/csp/csp/port/test-problems.rkt b/csp/csp/port/test-problems.rkt deleted file mode 100644 index aec12564..00000000 --- a/csp/csp/port/test-problems.rkt +++ /dev/null @@ -1,152 +0,0 @@ -#lang racket -(require "main.rkt" "test-classes.rkt") -(require rackunit) - - -;; ABC problem: -;; what is the minimum value of - -;; ABC -;; ------- -;; A+B+C - - -(define abc-problem (new problem%)) -(send abc-problem add-variables '("a" "b" "c") (range 1 10)) -(define (test-solution s) (let ([a (hash-ref s "a")] - [b (hash-ref s "b")] - [c (hash-ref s "c")]) - (/ (+ (* 100 a) (* 10 b) c) (+ a b c)))) - -(check-hash-items (argmin test-solution (send abc-problem get-solutions)) - #hash(("c" . 9) ("b" . 9) ("a" . 1))) - - -;; quarter problem: -;; 26 coins, dollars and quarters -;; that add up to $17. - -(define quarter-problem (new problem%)) -(send quarter-problem add-variables '("dollars" "quarters") (range 1 27)) -(send quarter-problem add-constraint (λ(d q) (= 17 (+ d (* 0.25 q)))) '("dollars" "quarters")) -(send quarter-problem add-constraint (λ(d q) (= 26 (+ d q))) '("dollars" "quarters")) -(check-hash-items (send quarter-problem get-solution) '#hash(("dollars" . 14) ("quarters" . 12))) - -;; coin problem 2 -#| -A collection of 33 coins, consisting of nickels, dimes, and quarters, has a value of $3.30. If there are three times as many nickels as quarters, and one-half as many dimes as nickels, how many coins of each kind are there? -|# - -(define nickel-problem (new problem%)) -(send nickel-problem add-variables '(nickels dimes quarters) (range 1 34)) -(send nickel-problem add-constraint (λ(n d q) (= 33 (+ n d q))) '(nickels dimes quarters)) -(send nickel-problem add-constraint (λ(n d q) (= 3.30 (+ (* 0.05 n) (* 0.1 d) (* 0.25 q)))) '(nickels dimes quarters)) -(send nickel-problem add-constraint (λ(n q) (= n (* 3 q))) '(nickels quarters)) -(send nickel-problem add-constraint (λ(d n) (= n (* 2 d))) '(dimes nickels)) -(check-hash-items (send nickel-problem get-solution) #hash((nickels . 18) (quarters . 6) (dimes . 9))) - -;; word math -#| -# Assign equal values to equal letters, and different values to -# different letters, in a way that satisfies the following sum: -# -# TWO -# + TWO -# ----- -# FOUR -|# - - -(define two-four-problem (new problem%)) -(send two-four-problem add-variables '(t w o f u r) (range 10)) -(send two-four-problem add-constraint (new all-different-constraint%)) -(send two-four-problem add-constraint (λ(t w o) (> (word-value t w o) 99)) '(t w o)) -(send two-four-problem add-constraint (λ(f o u r) (> (word-value f o u r) 999)) '(f o u r)) -(send two-four-problem add-constraint - (λ (t w o f u r) - (let ([two (word-value t w o)] - [four (word-value f o u r)]) - ((two . + . two) . = . four))) '(t w o f u r)) -(check-equal? (length (send two-four-problem get-solutions)) 7) -(send two-four-problem add-constraint (λ(r) (= r 0)) '(r)) -(check-hash-items (send two-four-problem get-solution) #hash((o . 5) (w . 6) (u . 3) (f . 1) (r . 0) (t . 7))) - - -;; xsum -#| -# Reorganize the following numbers in a way that each line of -# 5 numbers sum to 27. -# -# 1 6 -# 2 7 -# 3 -# 8 4 -# 9 5 -# -|# - -(define xsum (new problem%)) -(send xsum add-variables '(l1 l2 l3 l4 r1 r2 r3 r4 x) (range 10)) -(send xsum add-constraint (λ (l1 l2 l3 l4 x) - (and (< l1 l2 l3 l4) - (= 27 (+ l1 l2 l3 l4 x)))) '(l1 l2 l3 l4 x)) -(send xsum add-constraint (λ (r1 r2 r3 r4 x) - (and (< r1 r2 r3 r4) - (= 27 (+ r1 r2 r3 r4 x)))) '(r1 r2 r3 r4 x)) -(send xsum add-constraint (new all-different-constraint%)) -(check-equal? (length (send xsum get-solutions)) 8) - - - -;; send more money problem -#| -# Assign equal values to equal letters, and different values to -# different letters, in a way that satisfies the following sum: -# -# SEND -# + MORE -# ------ -# MONEY -|# - - -(define smm (new problem%)) -(send smm add-variables '(s e n d m o r y) (range 10)) -(send smm add-constraint (λ(x) (> x 0)) '(s)) -(send smm add-constraint (λ(x) (> x 0)) '(m)) -(send smm add-constraint (λ(d e y) (= (modulo (+ d e) 10) y)) '(d e y)) -(send smm add-constraint (λ(n d r e y) - (= (modulo (+ (word-value n d) (word-value r e)) 100) - (word-value e y))) '(n d r e y)) -(send smm add-constraint (λ(e n d o r y) - (= (modulo (+ (word-value e n d) (word-value o r e)) 1000) (word-value n e y))) '(e n d o r y)) -(send smm add-constraint (λ(s e n d m o r y) (= - (+ (word-value s e n d) - (word-value m o r e)) - (word-value m o n e y))) '(s e n d m o r y)) -#;(send smm add-constraint (new all-different-constraint%)) -(send smm add-constraint (λ xs (= (length (remove-duplicates xs)) (length xs))) '(s e n d m o r y)) - -(check-hash-items (send smm get-solution) '#hash((m . 1) (e . 5) (r . 8) (n . 6) (y . 2) (o . 0) (d . 7) (s . 9))) - - - - -;; queens problem -;; place queens on chessboard so they do not intersect - -(define queens-problem (new problem%)) -(define cols (range 8)) -(define rows (range 8)) -(send queens-problem add-variables cols rows) -(for* ([col1 (in-list cols)] [col2 (in-list cols)] #:when (< col1 col2)) - (send queens-problem add-constraint (λ(row1 row2 [col1 col1][col2 col2]) - (and - ;; test if two cells are on a diagonal - (not (= (abs (- row1 row2)) (abs (- col1 col2)))) - ;; test if two cells are in same row - (not (= row1 row2)))) (list col1 col2))) -(check-equal? (length (send queens-problem get-solutions)) 92) - -(module+ main - (displayln "Tests passed")) \ No newline at end of file diff --git a/csp/csp/port/variable.rkt b/csp/csp/port/variable.rkt deleted file mode 100644 index 727a469e..00000000 --- a/csp/csp/port/variable.rkt +++ /dev/null @@ -1,17 +0,0 @@ -#lang racket/base -(require racket/class "helper.rkt") -(provide (all-defined-out)) - -(define variable% - (class* object% (printable<%>) - (super-new) - (define (repr) (format "" _name)) - (define/public (custom-print out quoting-depth) (print (repr) out)) - (define/public (custom-display out) (displayln (repr) out)) - (define/public (custom-write out) (write (repr) out)) - - (init-field name) - (field [_name name]))) -(define variable%? (is-a?/c variable%)) - -(define Unassigned (new variable% [name "Unassigned"])) \ No newline at end of file diff --git a/csp/csp/python-constraint/API Documentation.webloc b/csp/csp/python-constraint/API Documentation.webloc deleted file mode 100644 index 3cae8191..00000000 --- a/csp/csp/python-constraint/API Documentation.webloc +++ /dev/null @@ -1,8 +0,0 @@ - - - - - URL - http://labix.org/doc/constraint/ - - diff --git a/csp/csp/python-constraint/LICENSE b/csp/csp/python-constraint/LICENSE deleted file mode 100644 index 1551a23a..00000000 --- a/csp/csp/python-constraint/LICENSE +++ /dev/null @@ -1,23 +0,0 @@ -Copyright (c) 2005-2014 - Gustavo Niemeyer - -All rights reserved. - -Redistribution and use in source and binary forms, with or without -modification, are permitted provided that the following conditions are met: - -1. Redistributions of source code must retain the above copyright notice, this - list of conditions and the following disclaimer. -2. Redistributions in binary form must reproduce the above copyright notice, - this list of conditions and the following disclaimer in the documentation - and/or other materials provided with the distribution. - -THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND -ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED -WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE -DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR -ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES -(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; -LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND -ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT -(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS -SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/csp/csp/python-constraint/MANIFEST.in b/csp/csp/python-constraint/MANIFEST.in deleted file mode 100644 index 18b718a2..00000000 --- a/csp/csp/python-constraint/MANIFEST.in +++ /dev/null @@ -1,2 +0,0 @@ -include constraint.py setup.py setup.cfg README LICENSE MANIFEST.in -recursive-include examples *.py *.mask diff --git a/csp/csp/python-constraint/PKG-INFO b/csp/csp/python-constraint/PKG-INFO deleted file mode 100644 index f3a51345..00000000 --- a/csp/csp/python-constraint/PKG-INFO +++ /dev/null @@ -1,13 +0,0 @@ -Metadata-Version: 1.0 -Name: python-constraint -Version: 1.2 -Summary: Python module for handling Constraint Solving Problems -Home-page: http://labix.org/python-constraint -Author: Gustavo Niemeyer -Author-email: gustavo@niemeyer.net -License: Simplified BSD -Description: - python-constraint is a module implementing support for handling CSPs - (Constraint Solving Problems) over finite domains. - -Platform: UNKNOWN diff --git a/csp/csp/python-constraint/README b/csp/csp/python-constraint/README deleted file mode 100644 index 625e7075..00000000 --- a/csp/csp/python-constraint/README +++ /dev/null @@ -1 +0,0 @@ -See http://labix.org/constraint diff --git a/csp/csp/python-constraint/constraint.py b/csp/csp/python-constraint/constraint.py deleted file mode 100644 index 462b6bc4..00000000 --- a/csp/csp/python-constraint/constraint.py +++ /dev/null @@ -1,1469 +0,0 @@ -#!/usr/bin/python -# -# Copyright (c) 2005-2014 - Gustavo Niemeyer -# -# All rights reserved. -# -# Redistribution and use in source and binary forms, with or without -# modification, are permitted provided that the following conditions are met: -# -# 1. Redistributions of source code must retain the above copyright notice, this -# list of conditions and the following disclaimer. -# 2. Redistributions in binary form must reproduce the above copyright notice, -# this list of conditions and the following disclaimer in the documentation -# and/or other materials provided with the distribution. -# -# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" -# AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE -# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE -# DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE -# FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL -# DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR -# SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER -# CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, -# OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE -# OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -""" -@var Unassigned: Helper object instance representing unassigned values - -@sort: Problem, Variable, Domain -@group Solvers: Solver, - BacktrackingSolver, - RecursiveBacktrackingSolver, - MinConflictsSolver -@group Constraints: Constraint, - FunctionConstraint, - AllDifferentConstraint, - AllEqualConstraint, - MaxSumConstraint, - ExactSumConstraint, - MinSumConstraint, - InSetConstraint, - NotInSetConstraint, - SomeInSetConstraint, - SomeNotInSetConstraint -""" -import random -import copy - -__all__ = ["Problem", "Variable", "Domain", "Unassigned", - "Solver", "BacktrackingSolver", "RecursiveBacktrackingSolver", - "MinConflictsSolver", "Constraint", "FunctionConstraint", - "AllDifferentConstraint", "AllEqualConstraint", "MaxSumConstraint", - "ExactSumConstraint", "MinSumConstraint", "InSetConstraint", - "NotInSetConstraint", "SomeInSetConstraint", - "SomeNotInSetConstraint"] - -class Problem(object): - """ - Class used to define a problem and retrieve solutions - """ - - def __init__(self, solver=None): - """ - @param solver: Problem solver used to find solutions - (default is L{BacktrackingSolver}) - @type solver: instance of a L{Solver} subclass - """ - self._solver = solver or BacktrackingSolver() - self._constraints = [] - self._variables = {} - - def reset(self): - """ - Reset the current problem definition - - Example: - - >>> problem = Problem() - >>> problem.addVariable("a", [1, 2]) - >>> problem.reset() - >>> problem.getSolution() - >>> - """ - del self._constraints[:] - self._variables.clear() - - def setSolver(self, solver): - """ - Change the problem solver currently in use - - Example: - - >>> solver = BacktrackingSolver() - >>> problem = Problem(solver) - >>> problem.getSolver() is solver - True - - @param solver: New problem solver - @type solver: instance of a C{Solver} subclass - """ - self._solver = solver - - def getSolver(self): - """ - Obtain the problem solver currently in use - - Example: - - >>> solver = BacktrackingSolver() - >>> problem = Problem(solver) - >>> problem.getSolver() is solver - True - - @return: Solver currently in use - @rtype: instance of a L{Solver} subclass - """ - return self._solver - - def addVariable(self, variable, domain): - """ - Add a variable to the problem - - Example: - - >>> problem = Problem() - >>> problem.addVariable("a", [1, 2]) - >>> problem.getSolution() in ({'a': 1}, {'a': 2}) - True - - @param variable: Object representing a problem variable - @type variable: hashable object - @param domain: Set of items defining the possible values that - the given variable may assume - @type domain: list, tuple, or instance of C{Domain} - """ - if variable in self._variables: - raise ValueError, "Tried to insert duplicated variable %s" % \ - repr(variable) - if type(domain) in (list, tuple): - domain = Domain(domain) - elif isinstance(domain, Domain): - domain = copy.copy(domain) - else: - raise TypeError, "Domains must be instances of subclasses of "\ - "the Domain class" - if not domain: - raise ValueError, "Domain is empty" - self._variables[variable] = domain - - def addVariables(self, variables, domain): - """ - Add one or more variables to the problem - - Example: - - >>> problem = Problem() - >>> problem.addVariables(["a", "b"], [1, 2, 3]) - >>> solutions = problem.getSolutions() - >>> len(solutions) - 9 - >>> {'a': 3, 'b': 1} in solutions - True - - @param variables: Any object containing a sequence of objects - represeting problem variables - @type variables: sequence of hashable objects - @param domain: Set of items defining the possible values that - the given variables may assume - @type domain: list, tuple, or instance of C{Domain} - """ - for variable in variables: - self.addVariable(variable, domain) - - def addConstraint(self, constraint, variables=None): - """ - Add a constraint to the problem - - Example: - - >>> problem = Problem() - >>> problem.addVariables(["a", "b"], [1, 2, 3]) - >>> problem.addConstraint(lambda a, b: b == a+1, ["a", "b"]) - >>> solutions = problem.getSolutions() - >>> - - @param constraint: Constraint to be included in the problem - @type constraint: instance a L{Constraint} subclass or a - function to be wrapped by L{FunctionConstraint} - @param variables: Variables affected by the constraint (default to - all variables). Depending on the constraint type - the order may be important. - @type variables: set or sequence of variables - """ - print "self._constraints", self._constraints - if not isinstance(constraint, Constraint): - if callable(constraint): - constraint = FunctionConstraint(constraint) - else: - raise ValueError, "Constraints must be instances of "\ - "subclasses of the Constraint class" - self._constraints.append((constraint, variables)) - print "self._constraints", self._constraints - - def getSolution(self): - """ - Find and return a solution to the problem - - Example: - - >>> problem = Problem() - >>> problem.getSolution() is None - True - >>> problem.addVariables(["a"], [42]) - >>> problem.getSolution() - {'a': 42} - - @return: Solution for the problem - @rtype: dictionary mapping variables to values - """ - domains, constraints, vconstraints = self._getArgs() - if not domains: - return None - return self._solver.getSolution(domains, constraints, vconstraints) - - def getSolutions(self): - """ - Find and return all solutions to the problem - - Example: - - >>> problem = Problem() - >>> problem.getSolutions() == [] - True - >>> problem.addVariables(["a"], [42]) - >>> problem.getSolutions() - [{'a': 42}] - - @return: All solutions for the problem - @rtype: list of dictionaries mapping variables to values - """ - domains, constraints, vconstraints = self._getArgs() - if not domains: - return [] - return self._solver.getSolutions(domains, constraints, vconstraints) - - def getSolutionIter(self): - """ - Return an iterator to the solutions of the problem - - Example: - - >>> problem = Problem() - >>> list(problem.getSolutionIter()) == [] - True - >>> problem.addVariables(["a"], [42]) - >>> iter = problem.getSolutionIter() - >>> iter.next() - {'a': 42} - >>> iter.next() - Traceback (most recent call last): - File "", line 1, in ? - StopIteration - """ - domains, constraints, vconstraints = self._getArgs() - if not domains: - return iter(()) - return self._solver.getSolutionIter(domains, constraints, - vconstraints) - - def _getArgs(self): - domains = self._variables.copy() - allvariables = domains.keys() - constraints = [] - for constraint, variables in self._constraints: - if not variables: - variables = allvariables - constraints.append((constraint, variables)) - vconstraints = {} - for variable in domains: - vconstraints[variable] = [] - for constraint, variables in constraints: - for variable in variables: - vconstraints[variable].append((constraint, variables)) - for constraint, variables in constraints[:]: - constraint.preProcess(variables, domains, - constraints, vconstraints) - for domain in domains.values(): - domain.resetState() - if not domain: - return None, None, None - #doArc8(getArcs(domains, constraints), domains, {}) - return domains, constraints, vconstraints - -# ---------------------------------------------------------------------- -# Solvers -# ---------------------------------------------------------------------- - -def getArcs(domains, constraints): - """ - Return a dictionary mapping pairs (arcs) of constrained variables - - @attention: Currently unused. - """ - arcs = {} - for x in constraints: - constraint, variables = x - if len(variables) == 2: - variable1, variable2 = variables - arcs.setdefault(variable1, {})\ - .setdefault(variable2, [])\ - .append(x) - arcs.setdefault(variable2, {})\ - .setdefault(variable1, [])\ - .append(x) - return arcs - -def doArc8(arcs, domains, assignments): - """ - Perform the ARC-8 arc checking algorithm and prune domains - - @attention: Currently unused. - """ - check = dict.fromkeys(domains, True) - while check: - variable, _ = check.popitem() - if variable not in arcs or variable in assignments: - continue - domain = domains[variable] - arcsvariable = arcs[variable] - for othervariable in arcsvariable: - arcconstraints = arcsvariable[othervariable] - if othervariable in assignments: - otherdomain = [assignments[othervariable]] - else: - otherdomain = domains[othervariable] - if domain: - changed = False - for value in domain[:]: - assignments[variable] = value - if otherdomain: - for othervalue in otherdomain: - assignments[othervariable] = othervalue - for constraint, variables in arcconstraints: - if not constraint(variables, domains, - assignments, True): - break - else: - # All constraints passed. Value is safe. - break - else: - # All othervalues failed. Kill value. - domain.hideValue(value) - changed = True - del assignments[othervariable] - del assignments[variable] - #if changed: - # check.update(dict.fromkeys(arcsvariable)) - if not domain: - return False - return True - -class Solver(object): - """ - Abstract base class for solvers - - @sort: getSolution, getSolutions, getSolutionIter - """ - - def getSolution(self, domains, constraints, vconstraints): - """ - Return one solution for the given problem - - @param domains: Dictionary mapping variables to their domains - @type domains: dict - @param constraints: List of pairs of (constraint, variables) - @type constraints: list - @param vconstraints: Dictionary mapping variables to a list of - constraints affecting the given variables. - @type vconstraints: dict - """ - NotImplementedError, \ - "%s is an abstract class" % self.__class__.__name__ - - def getSolutions(self, domains, constraints, vconstraints): - """ - Return all solutions for the given problem - - @param domains: Dictionary mapping variables to domains - @type domains: dict - @param constraints: List of pairs of (constraint, variables) - @type constraints: list - @param vconstraints: Dictionary mapping variables to a list of - constraints affecting the given variables. - @type vconstraints: dict - """ - raise NotImplementedError, \ - "%s provides only a single solution" % self.__class__.__name__ - - def getSolutionIter(self, domains, constraints, vconstraints): - """ - Return an iterator for the solutions of the given problem - - @param domains: Dictionary mapping variables to domains - @type domains: dict - @param constraints: List of pairs of (constraint, variables) - @type constraints: list - @param vconstraints: Dictionary mapping variables to a list of - constraints affecting the given variables. - @type vconstraints: dict - """ - raise NotImplementedError, \ - "%s doesn't provide iteration" % self.__class__.__name__ - -class BacktrackingSolver(Solver): - """ - Problem solver with backtracking capabilities - - Examples: - - >>> result = [[('a', 1), ('b', 2)], - ... [('a', 1), ('b', 3)], - ... [('a', 2), ('b', 3)]] - - >>> problem = Problem(BacktrackingSolver()) - >>> problem.addVariables(["a", "b"], [1, 2, 3]) - >>> problem.addConstraint(lambda a, b: b > a, ["a", "b"]) - - >>> solution = problem.getSolution() - >>> sorted(solution.items()) in result - True - - >>> for solution in problem.getSolutionIter(): - ... sorted(solution.items()) in result - True - True - True - - >>> for solution in problem.getSolutions(): - ... sorted(solution.items()) in result - True - True - True - """#""" - - def __init__(self, forwardcheck=True): - """ - @param forwardcheck: If false forward checking will not be requested - to constraints while looking for solutions - (default is true) - @type forwardcheck: bool - """ - self._forwardcheck = forwardcheck - - def getSolutionIter(self, domains, constraints, vconstraints): - forwardcheck = self._forwardcheck - assignments = {} - - queue = [] - - - while True: - #print "starting while loop 1" - - # Mix the Degree and Minimum Remaing Values (MRV) heuristics - lst = [(-len(vconstraints[variable]), - len(domains[variable]), variable) for variable in domains] - lst.sort() - #print "lst", lst - for item in lst: - if item[-1] not in assignments: - # Found unassigned variable - variable = item[-1] - #print "unassigned variable", variable - values = domains[variable][:] - if forwardcheck: - pushdomains = [domains[x] for x in domains - if x not in assignments and - x != variable] - else: - pushdomains = None - break - else: - # No unassigned variables. We've got a solution. Go back - # to last variable, if there's one. - #print "solution time" - #print "solution assignments", assignments - yield assignments.copy() - #print "queue", queue - if not queue: - return - variable, values, pushdomains = queue.pop() - if pushdomains: - for domain in pushdomains: - domain.popState() - - #print "variable-preloop-2", variable - #print "assignments-preloop-2", assignments - while True: - #print "starting while loop 2" - # We have a variable. Do we have any values left? - #print "values tested", values - if not values: - # No. Go back to last variable, if there's one. - del assignments[variable] - while queue: - variable, values, pushdomains = queue.pop() - if pushdomains: - for domain in pushdomains: - domain.popState() - if values: - break - del assignments[variable] - else: - return - - # Got a value. Check it. - assignments[variable] = values.pop() - - if pushdomains: - for domain in pushdomains: - domain.pushState() - #print "pushdomains1", pushdomains - #print "domains1", domains - - for constraint, variables in vconstraints[variable]: - the_result = constraint(variables, domains, assignments, - pushdomains) - #print "pushdomains2", pushdomains - #print "domains2", domains - #print "the_result", the_result - if not the_result: - # Value is not good. - break - else: - #print "now breaking loop 2" - break - - if pushdomains: - for domain in pushdomains: - domain.popState() - - # Push state before looking for next variable. - queue.append((variable, values, pushdomains)) - #print "new queue", queue - - raise RuntimeError, "Can't happen" - - def getSolution(self, domains, constraints, vconstraints): - iter = self.getSolutionIter(domains, constraints, vconstraints) - try: - return iter.next() - except StopIteration: - return None - - def getSolutions(self, domains, constraints, vconstraints): - return list(self.getSolutionIter(domains, constraints, vconstraints)) - - -class RecursiveBacktrackingSolver(Solver): - """ - Recursive problem solver with backtracking capabilities - - Examples: - - >>> result = [[('a', 1), ('b', 2)], - ... [('a', 1), ('b', 3)], - ... [('a', 2), ('b', 3)]] - - >>> problem = Problem(RecursiveBacktrackingSolver()) - >>> problem.addVariables(["a", "b"], [1, 2, 3]) - >>> problem.addConstraint(lambda a, b: b > a, ["a", "b"]) - - >>> solution = problem.getSolution() - >>> sorted(solution.items()) in result - True - - >>> for solution in problem.getSolutions(): - ... sorted(solution.items()) in result - True - True - True - - >>> problem.getSolutionIter() - Traceback (most recent call last): - ... - NotImplementedError: RecursiveBacktrackingSolver doesn't provide iteration - """#""" - - def __init__(self, forwardcheck=True): - """ - @param forwardcheck: If false forward checking will not be requested - to constraints while looking for solutions - (default is true) - @type forwardcheck: bool - """ - self._forwardcheck = forwardcheck - - def recursiveBacktracking(self, solutions, domains, vconstraints, - assignments, single): - - - # Mix the Degree and Minimum Remaing Values (MRV) heuristics - lst = [(-len(vconstraints[variable]), - len(domains[variable]), variable) for variable in domains] - lst.sort() - for item in lst: - if item[-1] not in assignments: - # Found an unassigned variable. Let's go. - breakit - else: - # No unassigned variables. We've got a solution. - solutions.append(assignments.copy()) - return solutions - - variable = item[-1] - assignments[variable] = None - - forwardcheck = self._forwardcheck - if forwardcheck: - pushdomains = [domains[x] for x in domains if x not in assignments] - else: - pushdomains = None - - for value in domains[variable]: - assignments[variable] = value - if pushdomains: - for domain in pushdomains: - domain.pushState() - for constraint, variables in vconstraints[variable]: - if not constraint(variables, domains, assignments, - pushdomains): - # Value is not good. - break - else: - # Value is good. Recurse and get next variable. - self.recursiveBacktracking(solutions, domains, vconstraints, - assignments, single) - if solutions and single: - return solutions - if pushdomains: - for domain in pushdomains: - domain.popState() - del assignments[variable] - return solutions - - def getSolution(self, domains, constraints, vconstraints): - solutions = self.recursiveBacktracking([], domains, vconstraints, - {}, True) - return solutions and solutions[0] or None - - def getSolutions(self, domains, constraints, vconstraints): - return self.recursiveBacktracking([], domains, vconstraints, - {}, False) - - -class MinConflictsSolver(Solver): - """ - Problem solver based on the minimum conflicts theory - - Examples: - - >>> result = [[('a', 1), ('b', 2)], - ... [('a', 1), ('b', 3)], - ... [('a', 2), ('b', 3)]] - - >>> problem = Problem(MinConflictsSolver()) - >>> problem.addVariables(["a", "b"], [1, 2, 3]) - >>> problem.addConstraint(lambda a, b: b > a, ["a", "b"]) - - >>> solution = problem.getSolution() - >>> sorted(solution.items()) in result - True - - >>> problem.getSolutions() - Traceback (most recent call last): - ... - NotImplementedError: MinConflictsSolver provides only a single solution - - >>> problem.getSolutionIter() - Traceback (most recent call last): - ... - NotImplementedError: MinConflictsSolver doesn't provide iteration - """#""" - - def __init__(self, steps=1000): - """ - @param steps: Maximum number of steps to perform before giving up - when looking for a solution (default is 1000) - @type steps: int - """ - self._steps = steps - - def getSolution(self, domains, constraints, vconstraints): - assignments = {} - # Initial assignment - for variable in domains: - assignments[variable] = random.choice(domains[variable]) - for _ in xrange(self._steps): - conflicted = False - lst = domains.keys() - random.shuffle(lst) - for variable in lst: - # Check if variable is not in conflict - for constraint, variables in vconstraints[variable]: - if not constraint(variables, domains, assignments): - break - else: - continue - # Variable has conflicts. Find values with less conflicts. - mincount = len(vconstraints[variable]) - minvalues = [] - for value in domains[variable]: - assignments[variable] = value - count = 0 - for constraint, variables in vconstraints[variable]: - if not constraint(variables, domains, assignments): - count += 1 - if count == mincount: - minvalues.append(value) - elif count < mincount: - mincount = count - del minvalues[:] - minvalues.append(value) - # Pick a random one from these values. - assignments[variable] = random.choice(minvalues) - conflicted = True - if not conflicted: - return assignments - return None - -# ---------------------------------------------------------------------- -# Variables -# ---------------------------------------------------------------------- - -class Variable(object): - """ - Helper class for variable definition - - Using this class is optional, since any hashable object, - including plain strings and integers, may be used as variables. - """ - - def __init__(self, name): - """ - @param name: Generic variable name for problem-specific purposes - @type name: string - """ - self.name = name - - def __repr__(self): - return self.name - -Unassigned = Variable("Unassigned") - -# ---------------------------------------------------------------------- -# Domains -# ---------------------------------------------------------------------- - -class Domain(list): - """ - Class used to control possible values for variables - - When list or tuples are used as domains, they are automatically - converted to an instance of that class. - """ - - def __init__(self, set): - """ - @param set: Set of values that the given variables may assume - @type set: set of objects comparable by equality - """ - list.__init__(self, set) - self._hidden = [] - self._states = [] - - def resetState(self): - """ - Reset to the original domain state, including all possible values - """ - self.extend(self._hidden) - del self._hidden[:] - del self._states[:] - - def pushState(self): - """ - Save current domain state - - Variables hidden after that call are restored when that state - is popped from the stack. - """ - self._states.append(len(self)) - - def popState(self): - """ - Restore domain state from the top of the stack - - Variables hidden since the last popped state are then available - again. - """ - diff = self._states.pop()-len(self) - if diff: - self.extend(self._hidden[-diff:]) - del self._hidden[-diff:] - - def hideValue(self, value): - """ - Hide the given value from the domain - - After that call the given value won't be seen as a possible value - on that domain anymore. The hidden value will be restored when the - previous saved state is popped. - - @param value: Object currently available in the domain - """ - list.remove(self, value) - self._hidden.append(value) - -# ---------------------------------------------------------------------- -# Constraints -# ---------------------------------------------------------------------- - -class Constraint(object): - """ - Abstract base class for constraints - """ - - def __call__(self, variables, domains, assignments, forwardcheck=False): - """ - Perform the constraint checking - - If the forwardcheck parameter is not false, besides telling if - the constraint is currently broken or not, the constraint - implementation may choose to hide values from the domains of - unassigned variables to prevent them from being used, and thus - prune the search space. - - @param variables: Variables affected by that constraint, in the - same order provided by the user - @type variables: sequence - @param domains: Dictionary mapping variables to their domains - @type domains: dict - @param assignments: Dictionary mapping assigned variables to their - current assumed value - @type assignments: dict - @param forwardcheck: Boolean value stating whether forward checking - should be performed or not - @return: Boolean value stating if this constraint is currently - broken or not - @rtype: bool - """#""" - return True - - def preProcess(self, variables, domains, constraints, vconstraints): - """ - Preprocess variable domains - - This method is called before starting to look for solutions, - and is used to prune domains with specific constraint logic - when possible. For instance, any constraints with a single - variable may be applied on all possible values and removed, - since they may act on individual values even without further - knowledge about other assignments. - - @param variables: Variables affected by that constraint, in the - same order provided by the user - @type variables: sequence - @param domains: Dictionary mapping variables to their domains - @type domains: dict - @param constraints: List of pairs of (constraint, variables) - @type constraints: list - @param vconstraints: Dictionary mapping variables to a list of - constraints affecting the given variables. - @type vconstraints: dict - """#""" - if len(variables) == 1: - variable = variables[0] - domain = domains[variable] - for value in domain[:]: - if not self(variables, domains, {variable: value}): - domain.remove(value) - constraints.remove((self, variables)) - vconstraints[variable].remove((self, variables)) - - def forwardCheck(self, variables, domains, assignments, - _unassigned=Unassigned): - """ - Helper method for generic forward checking - - Currently, this method acts only when there's a single - unassigned variable. - - @param variables: Variables affected by that constraint, in the - same order provided by the user - @type variables: sequence - @param domains: Dictionary mapping variables to their domains - @type domains: dict - @param assignments: Dictionary mapping assigned variables to their - current assumed value - @type assignments: dict - @return: Boolean value stating if this constraint is currently - broken or not - @rtype: bool - """#""" - unassignedvariable = _unassigned - #print "assignments", assignments - for variable in variables: - if variable not in assignments: - if unassignedvariable is _unassigned: - #print "boom" - unassignedvariable = variable - else: - break - else: - if unassignedvariable is not _unassigned: - # Remove from the unassigned variable domain's all - # values which break our variable's constraints. - domain = domains[unassignedvariable] - #print "domain-fc", domain - if domain: - for value in domain[:]: - assignments[unassignedvariable] = value - if not self(variables, domains, assignments): - domain.hideValue(value) - del assignments[unassignedvariable] - if not domain: - return False - return True - -class FunctionConstraint(Constraint): - """ - Constraint which wraps a function defining the constraint logic - - Examples: - - >>> problem = Problem() - >>> problem.addVariables(["a", "b"], [1, 2]) - >>> def func(a, b): - ... return b > a - >>> problem.addConstraint(func, ["a", "b"]) - >>> problem.getSolution() - {'a': 1, 'b': 2} - - >>> problem = Problem() - >>> problem.addVariables(["a", "b"], [1, 2]) - >>> def func(a, b): - ... return b > a - >>> problem.addConstraint(FunctionConstraint(func), ["a", "b"]) - >>> problem.getSolution() - {'a': 1, 'b': 2} - """#""" - - def __init__(self, func, assigned=True): - """ - @param func: Function wrapped and queried for constraint logic - @type func: callable object - @param assigned: Whether the function may receive unassigned - variables or not - @type assigned: bool - """ - self._func = func - self._assigned = assigned - - def __call__(self, variables, domains, assignments, forwardcheck=False, - _unassigned=Unassigned): - #print "in call" - #print "assignments-before", assignments - parms = [assignments.get(x, _unassigned) for x in variables] - #print "assignments-after", assignments - missing = parms.count(_unassigned) - #print "dang" - if missing: - #print "missing", missing - #print "self._assigned", self._assigned - #print "parms", parms - #print "self._func(*parms)", self._func(*parms) - #print "forwardcheck", forwardcheck - #print "assignments-to-fc", assignments - return ((self._assigned or self._func(*parms)) and - (not forwardcheck or missing != 1 or - self.forwardCheck(variables, domains, assignments))) - return self._func(*parms) - -class AllDifferentConstraint(Constraint): - """ - Constraint enforcing that values of all given variables are different - - Example: - - >>> problem = Problem() - >>> problem.addVariables(["a", "b"], [1, 2]) - >>> problem.addConstraint(AllDifferentConstraint()) - >>> sorted(sorted(x.items()) for x in problem.getSolutions()) - [[('a', 1), ('b', 2)], [('a', 2), ('b', 1)]] - """#""" - - def __call__(self, variables, domains, assignments, forwardcheck=False, - _unassigned=Unassigned): - seen = {} - for variable in variables: - value = assignments.get(variable, _unassigned) - if value is not _unassigned: - if value in seen: - return False - seen[value] = True - if forwardcheck: - for variable in variables: - if variable not in assignments: - domain = domains[variable] - for value in seen: - if value in domain: - domain.hideValue(value) - if not domain: - return False - return True - -class AllEqualConstraint(Constraint): - """ - Constraint enforcing that values of all given variables are equal - - Example: - - >>> problem = Problem() - >>> problem.addVariables(["a", "b"], [1, 2]) - >>> problem.addConstraint(AllEqualConstraint()) - >>> sorted(sorted(x.items()) for x in problem.getSolutions()) - [[('a', 1), ('b', 1)], [('a', 2), ('b', 2)]] - """#""" - - def __call__(self, variables, domains, assignments, forwardcheck=False, - _unassigned=Unassigned): - singlevalue = _unassigned - for variable in variables: - value = assignments.get(variable, _unassigned) - if singlevalue is _unassigned: - singlevalue = value - elif value is not _unassigned and value != singlevalue: - return False - if forwardcheck and singlevalue is not _unassigned: - for variable in variables: - if variable not in assignments: - domain = domains[variable] - if singlevalue not in domain: - return False - for value in domain[:]: - if value != singlevalue: - domain.hideValue(value) - return True - -class MaxSumConstraint(Constraint): - """ - Constraint enforcing that values of given variables sum up to - a given amount - - Example: - - >>> problem = Problem() - >>> problem.addVariables(["a", "b"], [1, 2]) - >>> problem.addConstraint(MaxSumConstraint(3)) - >>> sorted(sorted(x.items()) for x in problem.getSolutions()) - [[('a', 1), ('b', 1)], [('a', 1), ('b', 2)], [('a', 2), ('b', 1)]] - """#""" - - def __init__(self, maxsum, multipliers=None): - """ - @param maxsum: Value to be considered as the maximum sum - @type maxsum: number - @param multipliers: If given, variable values will be multiplied by - the given factors before being summed to be checked - @type multipliers: sequence of numbers - """ - self._maxsum = maxsum - self._multipliers = multipliers - - def preProcess(self, variables, domains, constraints, vconstraints): - Constraint.preProcess(self, variables, domains, - constraints, vconstraints) - multipliers = self._multipliers - maxsum = self._maxsum - if multipliers: - for variable, multiplier in zip(variables, multipliers): - domain = domains[variable] - for value in domain[:]: - if value*multiplier > maxsum: - domain.remove(value) - else: - for variable in variables: - domain = domains[variable] - for value in domain[:]: - if value > maxsum: - domain.remove(value) - - def __call__(self, variables, domains, assignments, forwardcheck=False): - multipliers = self._multipliers - maxsum = self._maxsum - sum = 0 - if multipliers: - for variable, multiplier in zip(variables, multipliers): - if variable in assignments: - sum += assignments[variable]*multiplier - if type(sum) is float: - sum = round(sum, 10) - if sum > maxsum: - return False - if forwardcheck: - for variable, multiplier in zip(variables, multipliers): - if variable not in assignments: - domain = domains[variable] - for value in domain[:]: - if sum+value*multiplier > maxsum: - domain.hideValue(value) - if not domain: - return False - else: - for variable in variables: - if variable in assignments: - sum += assignments[variable] - if type(sum) is float: - sum = round(sum, 10) - if sum > maxsum: - return False - if forwardcheck: - for variable in variables: - if variable not in assignments: - domain = domains[variable] - for value in domain[:]: - if sum+value > maxsum: - domain.hideValue(value) - if not domain: - return False - return True - -class ExactSumConstraint(Constraint): - """ - Constraint enforcing that values of given variables sum exactly - to a given amount - - Example: - - >>> problem = Problem() - >>> problem.addVariables(["a", "b"], [1, 2]) - >>> problem.addConstraint(ExactSumConstraint(3)) - >>> sorted(sorted(x.items()) for x in problem.getSolutions()) - [[('a', 1), ('b', 2)], [('a', 2), ('b', 1)]] - """#""" - - def __init__(self, exactsum, multipliers=None): - """ - @param exactsum: Value to be considered as the exact sum - @type exactsum: number - @param multipliers: If given, variable values will be multiplied by - the given factors before being summed to be checked - @type multipliers: sequence of numbers - """ - self._exactsum = exactsum - self._multipliers = multipliers - - def preProcess(self, variables, domains, constraints, vconstraints): - Constraint.preProcess(self, variables, domains, - constraints, vconstraints) - multipliers = self._multipliers - exactsum = self._exactsum - if multipliers: - for variable, multiplier in zip(variables, multipliers): - domain = domains[variable] - for value in domain[:]: - if value*multiplier > exactsum: - domain.remove(value) - else: - for variable in variables: - domain = domains[variable] - for value in domain[:]: - if value > exactsum: - domain.remove(value) - - def __call__(self, variables, domains, assignments, forwardcheck=False): - multipliers = self._multipliers - exactsum = self._exactsum - sum = 0 - missing = False - if multipliers: - for variable, multiplier in zip(variables, multipliers): - if variable in assignments: - sum += assignments[variable]*multiplier - else: - missing = True - if type(sum) is float: - sum = round(sum, 10) - if sum > exactsum: - return False - if forwardcheck and missing: - for variable, multiplier in zip(variables, multipliers): - if variable not in assignments: - domain = domains[variable] - for value in domain[:]: - if sum+value*multiplier > exactsum: - domain.hideValue(value) - if not domain: - return False - else: - for variable in variables: - if variable in assignments: - sum += assignments[variable] - else: - missing = True - if type(sum) is float: - sum = round(sum, 10) - if sum > exactsum: - return False - if forwardcheck and missing: - for variable in variables: - if variable not in assignments: - domain = domains[variable] - for value in domain[:]: - if sum+value > exactsum: - domain.hideValue(value) - if not domain: - return False - if missing: - return sum <= exactsum - else: - return sum == exactsum - -class MinSumConstraint(Constraint): - """ - Constraint enforcing that values of given variables sum at least - to a given amount - - Example: - - >>> problem = Problem() - >>> problem.addVariables(["a", "b"], [1, 2]) - >>> problem.addConstraint(MinSumConstraint(3)) - >>> sorted(sorted(x.items()) for x in problem.getSolutions()) - [[('a', 1), ('b', 2)], [('a', 2), ('b', 1)], [('a', 2), ('b', 2)]] - """#""" - - def __init__(self, minsum, multipliers=None): - """ - @param minsum: Value to be considered as the minimum sum - @type minsum: number - @param multipliers: If given, variable values will be multiplied by - the given factors before being summed to be checked - @type multipliers: sequence of numbers - """ - self._minsum = minsum - self._multipliers = multipliers - - def __call__(self, variables, domains, assignments, forwardcheck=False): - for variable in variables: - if variable not in assignments: - return True - else: - multipliers = self._multipliers - minsum = self._minsum - sum = 0 - if multipliers: - for variable, multiplier in zip(variables, multipliers): - sum += assignments[variable]*multiplier - else: - for variable in variables: - sum += assignments[variable] - if type(sum) is float: - sum = round(sum, 10) - return sum >= minsum - -class InSetConstraint(Constraint): - """ - Constraint enforcing that values of given variables are present in - the given set - - Example: - - >>> problem = Problem() - >>> problem.addVariables(["a", "b"], [1, 2]) - >>> problem.addConstraint(InSetConstraint([1])) - >>> sorted(sorted(x.items()) for x in problem.getSolutions()) - [[('a', 1), ('b', 1)]] - """#""" - - def __init__(self, set): - """ - @param set: Set of allowed values - @type set: set - """ - self._set = set - - def __call__(self, variables, domains, assignments, forwardcheck=False): - # preProcess() will remove it. - raise RuntimeError, "Can't happen" - - def preProcess(self, variables, domains, constraints, vconstraints): - set = self._set - for variable in variables: - domain = domains[variable] - for value in domain[:]: - if value not in set: - domain.remove(value) - vconstraints[variable].remove((self, variables)) - constraints.remove((self, variables)) - -class NotInSetConstraint(Constraint): - """ - Constraint enforcing that values of given variables are not present in - the given set - - Example: - - >>> problem = Problem() - >>> problem.addVariables(["a", "b"], [1, 2]) - >>> problem.addConstraint(NotInSetConstraint([1])) - >>> sorted(sorted(x.items()) for x in problem.getSolutions()) - [[('a', 2), ('b', 2)]] - """#""" - - def __init__(self, set): - """ - @param set: Set of disallowed values - @type set: set - """ - self._set = set - - def __call__(self, variables, domains, assignments, forwardcheck=False): - # preProcess() will remove it. - raise RuntimeError, "Can't happen" - - def preProcess(self, variables, domains, constraints, vconstraints): - set = self._set - for variable in variables: - domain = domains[variable] - for value in domain[:]: - if value in set: - domain.remove(value) - vconstraints[variable].remove((self, variables)) - constraints.remove((self, variables)) - -class SomeInSetConstraint(Constraint): - """ - Constraint enforcing that at least some of the values of given - variables must be present in a given set - - Example: - - >>> problem = Problem() - >>> problem.addVariables(["a", "b"], [1, 2]) - >>> problem.addConstraint(SomeInSetConstraint([1])) - >>> sorted(sorted(x.items()) for x in problem.getSolutions()) - [[('a', 1), ('b', 1)], [('a', 1), ('b', 2)], [('a', 2), ('b', 1)]] - """#""" - - def __init__(self, set, n=1, exact=False): - """ - @param set: Set of values to be checked - @type set: set - @param n: Minimum number of assigned values that should be present - in set (default is 1) - @type n: int - @param exact: Whether the number of assigned values which are - present in set must be exactly C{n} - @type exact: bool - """ - self._set = set - self._n = n - self._exact = exact - - def __call__(self, variables, domains, assignments, forwardcheck=False): - set = self._set - missing = 0 - found = 0 - for variable in variables: - if variable in assignments: - found += assignments[variable] in set - else: - missing += 1 - if missing: - if self._exact: - if not (found <= self._n <= missing+found): - return False - else: - if self._n > missing+found: - return False - if forwardcheck and self._n-found == missing: - # All unassigned variables must be assigned to - # values in the set. - for variable in variables: - if variable not in assignments: - domain = domains[variable] - for value in domain[:]: - if value not in set: - domain.hideValue(value) - if not domain: - return False - else: - if self._exact: - if found != self._n: - return False - else: - if found < self._n: - return False - return True - -class SomeNotInSetConstraint(Constraint): - """ - Constraint enforcing that at least some of the values of given - variables must not be present in a given set - - Example: - - >>> problem = Problem() - >>> problem.addVariables(["a", "b"], [1, 2]) - >>> problem.addConstraint(SomeNotInSetConstraint([1])) - >>> sorted(sorted(x.items()) for x in problem.getSolutions()) - [[('a', 1), ('b', 2)], [('a', 2), ('b', 1)], [('a', 2), ('b', 2)]] - """#""" - - def __init__(self, set, n=1, exact=False): - """ - @param set: Set of values to be checked - @type set: set - @param n: Minimum number of assigned values that should not be present - in set (default is 1) - @type n: int - @param exact: Whether the number of assigned values which are - not present in set must be exactly C{n} - @type exact: bool - """ - self._set = set - self._n = n - self._exact = exact - - def __call__(self, variables, domains, assignments, forwardcheck=False): - set = self._set - missing = 0 - found = 0 - for variable in variables: - if variable in assignments: - found += assignments[variable] not in set - else: - missing += 1 - if missing: - if self._exact: - if not (found <= self._n <= missing+found): - return False - else: - if self._n > missing+found: - return False - if forwardcheck and self._n-found == missing: - # All unassigned variables must be assigned to - # values not in the set. - for variable in variables: - if variable not in assignments: - domain = domains[variable] - for value in domain[:]: - if value in set: - domain.hideValue(value) - if not domain: - return False - else: - if self._exact: - if found != self._n: - return False - else: - if found < self._n: - return False - return True - -if __name__ == "__main__": - import doctest - doctest.testmod() - diff --git a/csp/csp/python-constraint/examples/abc/abc.py b/csp/csp/python-constraint/examples/abc/abc.py deleted file mode 100755 index ddc23bb7..00000000 --- a/csp/csp/python-constraint/examples/abc/abc.py +++ /dev/null @@ -1,30 +0,0 @@ -#!/usr/bin/python -# -# What's the minimum value for: -# -# ABC -# ------- -# A+B+C -# -# From http://www.umassd.edu/mathcontest/abc.cfm -# -from constraint import * - -def main(): - problem = Problem() - problem.addVariables("abc", range(1,10)) - print min(problem.getSolutions()) - minvalue = 999/(9*3) - minsolution = {} - for solution in problem.getSolutions(): - a = solution["a"] - b = solution["b"] - c = solution["c"] - value = (a*100+b*10+c)/(a+b+c) - if value < minvalue: - minsolution = solution - print minvalue - print minsolution - -if __name__ == "__main__": - main() diff --git a/csp/csp/python-constraint/examples/coins/coins.py b/csp/csp/python-constraint/examples/coins/coins.py deleted file mode 100755 index 1102f3ac..00000000 --- a/csp/csp/python-constraint/examples/coins/coins.py +++ /dev/null @@ -1,30 +0,0 @@ -#!/usr/bin/python -# -# 100 coins must sum to $5.00 -# -# That's kind of a country-specific problem, since depending on the -# country there are different values for coins. Here is presented -# the solution for a given set. -# -from constraint import * -import sys - -def main(): - problem = Problem() - total = 5.00 - variables = ("0.01", "0.05", "0.10", "0.50", "1.00") - values = [float(x) for x in variables] - for variable, value in zip(variables, values): - problem.addVariable(variable, range(int(total/value))) - problem.addConstraint(ExactSumConstraint(total, values), variables) - problem.addConstraint(ExactSumConstraint(100)) - solutions = problem.getSolutionIter() - for i, solution in enumerate(solutions): - sys.stdout.write("%03d -> " % (i+1)) - for variable in variables: - sys.stdout.write("%s:%d " % (variable, solution[variable])) - sys.stdout.write("\n") - -if __name__ == "__main__": - main() - diff --git a/csp/csp/python-constraint/examples/crosswords/crosswords.py b/csp/csp/python-constraint/examples/crosswords/crosswords.py deleted file mode 100755 index 5cb502f0..00000000 --- a/csp/csp/python-constraint/examples/crosswords/crosswords.py +++ /dev/null @@ -1,153 +0,0 @@ -#!/usr/bin/python -from constraint import * -import random -import sys - -MINLEN = 3 - -def main(puzzle, lines): - puzzle = puzzle.rstrip().splitlines() - while puzzle and not puzzle[0]: - del puzzle[0] - - # Extract horizontal words - horizontal = [] - word = [] - predefined = {} - for row in range(len(puzzle)): - for col in range(len(puzzle[row])): - char = puzzle[row][col] - if not char.isspace(): - word.append((row, col)) - if char != "#": - predefined[row, col] = char - elif word: - if len(word) > MINLEN: - horizontal.append(word[:]) - del word[:] - if word: - if len(word) > MINLEN: - horizontal.append(word[:]) - del word[:] - - # Extract vertical words - vertical = [] - validcol = True - col = 0 - while validcol: - validcol = False - for row in range(len(puzzle)): - if col >= len(puzzle[row]): - if word: - if len(word) > MINLEN: - vertical.append(word[:]) - del word[:] - else: - validcol = True - char = puzzle[row][col] - if not char.isspace(): - word.append((row, col)) - if char != "#": - predefined[row, col] = char - elif word: - if len(word) > MINLEN: - vertical.append(word[:]) - del word[:] - if word: - if len(word) > MINLEN: - vertical.append(word[:]) - del word[:] - col += 1 - - hnames = ["h%d" % i for i in range(len(horizontal))] - vnames = ["v%d" % i for i in range(len(vertical))] - - #problem = Problem(MinConflictsSolver()) - problem = Problem() - - for hi, hword in enumerate(horizontal): - for vi, vword in enumerate(vertical): - for hchar in hword: - if hchar in vword: - hci = hword.index(hchar) - vci = vword.index(hchar) - problem.addConstraint(lambda hw, vw, hci=hci, vci=vci: - hw[hci] == vw[vci], - ("h%d" % hi, "v%d" % vi)) - - for char, letter in predefined.items(): - for hi, hword in enumerate(horizontal): - if char in hword: - hci = hword.index(char) - problem.addConstraint(lambda hw, hci=hci, letter=letter: - hw[hci] == letter, ("h%d" % hi,)) - for vi, vword in enumerate(vertical): - if char in vword: - vci = vword.index(char) - problem.addConstraint(lambda vw, vci=vci, letter=letter: - vw[vci] == letter, ("v%d" % vi,)) - - wordsbylen = {} - for hword in horizontal: - wordsbylen[len(hword)] = [] - for vword in vertical: - wordsbylen[len(vword)] = [] - - for line in lines: - line = line.strip() - l = len(line) - if l in wordsbylen: - wordsbylen[l].append(line.upper()) - - for hi, hword in enumerate(horizontal): - words = wordsbylen[len(hword)] - random.shuffle(words) - problem.addVariable("h%d" % hi, words) - for vi, vword in enumerate(vertical): - words = wordsbylen[len(vword)] - random.shuffle(words) - problem.addVariable("v%d" % vi, words) - - problem.addConstraint(AllDifferentConstraint()) - - solution = problem.getSolution() - if not solution: - print "No solution found!" - - maxcol = 0 - maxrow = 0 - for hword in horizontal: - for row, col in hword: - if row > maxrow: - maxrow = row - if col > maxcol: - maxcol = col - for vword in vertical: - for row, col in vword: - if row > maxrow: - maxrow = row - if col > maxcol: - maxcol = col - - matrix = [] - for row in range(maxrow+1): - matrix.append([" "]*(maxcol+1)) - - for variable in solution: - if variable[0] == "v": - word = vertical[int(variable[1:])] - else: - word = horizontal[int(variable[1:])] - for (row, col), char in zip(word, solution[variable]): - matrix[row][col] = char - - for row in range(maxrow+1): - for col in range(maxcol+1): - sys.stdout.write(matrix[row][col]) - sys.stdout.write("\n") - -if __name__ == "__main__": - if len(sys.argv) != 3: - sys.exit("Usage: crosswords.py ") - main(open(sys.argv[1]).read(), open(sys.argv[2])) - diff --git a/csp/csp/python-constraint/examples/crosswords/large.mask b/csp/csp/python-constraint/examples/crosswords/large.mask deleted file mode 100644 index ba5364c8..00000000 --- a/csp/csp/python-constraint/examples/crosswords/large.mask +++ /dev/null @@ -1,27 +0,0 @@ - -# ######## # -# # # # # -######## # # -# # # # # -# # ######## -# # # # # # -######## # # -# # # # # # - # # # -######## # # - # # # # # - # ######## - # # # # # - # # ######## - # # # # # # - # # ######## - # # # # -######## # # - # # # # # # - # # # # # # - ######## # # - # # # # - # ######## - # # # # -######## # # - diff --git a/csp/csp/python-constraint/examples/crosswords/medium.mask b/csp/csp/python-constraint/examples/crosswords/medium.mask deleted file mode 100644 index 3332a097..00000000 --- a/csp/csp/python-constraint/examples/crosswords/medium.mask +++ /dev/null @@ -1,19 +0,0 @@ - - # -######### -# # # -# # ###### -# # # -# # # # -# # # # -######## # -# # # - # # # - ######### - # # # - ######### - # # # - # # -####### - # - diff --git a/csp/csp/python-constraint/examples/crosswords/python.mask b/csp/csp/python-constraint/examples/crosswords/python.mask deleted file mode 100644 index fe5a5767..00000000 --- a/csp/csp/python-constraint/examples/crosswords/python.mask +++ /dev/null @@ -1,8 +0,0 @@ - P - Y -####T#### - # H # - # O # -####N # - # # -######### diff --git a/csp/csp/python-constraint/examples/crosswords/small.mask b/csp/csp/python-constraint/examples/crosswords/small.mask deleted file mode 100644 index 0e43ff78..00000000 --- a/csp/csp/python-constraint/examples/crosswords/small.mask +++ /dev/null @@ -1,8 +0,0 @@ - # - # -######### - # # - # # # # -##### # # - # # # -######### diff --git a/csp/csp/python-constraint/examples/einstein/einstein.py b/csp/csp/python-constraint/examples/einstein/einstein.py deleted file mode 100755 index ede13f88..00000000 --- a/csp/csp/python-constraint/examples/einstein/einstein.py +++ /dev/null @@ -1,201 +0,0 @@ -#!/usr/bin/python -# -# ALBERT EINSTEIN'S RIDDLE -# -# ARE YOU IN THE TOP 2% OF INTELLIGENT PEOPLE IN THE WORLD? -# SOLVE THE RIDDLE AND FIND OUT. -# -# There are no tricks, just pure logic, so good luck and don't give up. -# -# 1. In a street there are five houses, painted five different colours. -# 2. In each house lives a person of different nationality -# 3. These five homeowners each drink a different kind of beverage, smoke -# different brand of cigar and keep a different pet. -# -# THE QUESTION: WHO OWNS THE FISH? -# -# HINTS -# -# 1. The Brit lives in a red house. -# 2. The Swede keeps dogs as pets. -# 3. The Dane drinks tea. -# 4. The Green house is on the left of the White house. -# 5. The owner of the Green house drinks coffee. -# 6. The person who smokes Pall Mall rears birds. -# 7. The owner of the Yellow house smokes Dunhill. -# 8. The man living in the centre house drinks milk. -# 9. The Norwegian lives in the first house. -# 10. The man who smokes Blends lives next to the one who keeps cats. -# 11. The man who keeps horses lives next to the man who smokes Dunhill. -# 12. The man who smokes Blue Master drinks beer. -# 13. The German smokes Prince. -# 14. The Norwegian lives next to the blue house. -# 15. The man who smokes Blends has a neighbour who drinks water. -# -# ALBERT EINSTEIN WROTE THIS RIDDLE EARLY DURING THE 19th CENTURY. HE -# SAID THAT 98% OF THE WORLD POPULATION WOULD NOT BE ABLE TO SOLVE IT. - -from constraint import * - -# Check http://www.csc.fi/oppaat/f95/python/talot.py - -def main(): - problem = Problem() - for i in range(1,6): - problem.addVariable("color%d" % i, - ["red", "white", "green", "yellow", "blue"]) - problem.addVariable("nationality%d" % i, - ["brit", "swede", "dane", "norwegian", "german"]) - problem.addVariable("drink%d" % i, - ["tea", "coffee", "milk", "beer", "water"]) - problem.addVariable("smoke%d" % i, - ["pallmall", "dunhill", "blends", - "bluemaster", "prince"]) - problem.addVariable("pet%d" % i, - ["dogs", "birds", "cats", "horses", "fish"]) - - problem.addConstraint(AllDifferentConstraint(), - ["color%d" % i for i in range(1,6)]) - problem.addConstraint(AllDifferentConstraint(), - ["nationality%d" % i for i in range(1,6)]) - problem.addConstraint(AllDifferentConstraint(), - ["drink%d" % i for i in range(1,6)]) - problem.addConstraint(AllDifferentConstraint(), - ["smoke%d" % i for i in range(1,6)]) - problem.addConstraint(AllDifferentConstraint(), - ["pet%d" % i for i in range(1,6)]) - - for i in range(1,6): - - # Hint 1 - problem.addConstraint(lambda nationality, color: - nationality != "brit" or color == "red", - ("nationality%d" % i, "color%d" % i)) - - # Hint 2 - problem.addConstraint(lambda nationality, pet: - nationality != "swede" or pet == "dogs", - ("nationality%d" % i, "pet%d" % i)) - - # Hint 3 - problem.addConstraint(lambda nationality, drink: - nationality != "dane" or drink == "tea", - ("nationality%d" % i, "drink%d" % i)) - - # Hint 4 - if i < 5: - problem.addConstraint(lambda colora, colorb: - colora != "green" or colorb == "white", - ("color%d" % i, "color%d" % (i+1))) - else: - problem.addConstraint(lambda color: color != "green", - ("color%d" % i,)) - - # Hint 5 - problem.addConstraint(lambda color, drink: - color != "green" or drink == "coffee", - ("color%d" % i, "drink%d" % i)) - - # Hint 6 - problem.addConstraint(lambda smoke, pet: - smoke != "pallmall" or pet == "birds", - ("smoke%d" % i, "pet%d" % i)) - - # Hint 7 - problem.addConstraint(lambda color, smoke: - color != "yellow" or smoke == "dunhill", - ("color%d" % i, "smoke%d" % i)) - - # Hint 8 - if i == 3: - problem.addConstraint(lambda drink: drink == "milk", - ("drink%d" % i,)) - - # Hint 9 - if i == 1: - problem.addConstraint(lambda nationality: - nationality == "norwegian", - ("nationality%d" % i,)) - - # Hint 10 - if 1 < i < 5: - problem.addConstraint(lambda smoke, peta, petb: - smoke != "blends" or peta == "cats" or - petb == "cats", - ("smoke%d" % i, "pet%d" % (i-1), - "pet%d" % (i+1))) - else: - problem.addConstraint(lambda smoke, pet: - smoke != "blends" or pet == "cats", - ("smoke%d" % i, - "pet%d" % (i == 1 and 2 or 4))) - - # Hint 11 - if 1 < i < 5: - problem.addConstraint(lambda pet, smokea, smokeb: - pet != "horses" or smokea == "dunhill" or - smokeb == "dunhill", - ("pet%d" % i, "smoke%d" % (i-1), - "smoke%d" % (i+1))) - else: - problem.addConstraint(lambda pet, smoke: - pet != "horses" or smoke == "dunhill", - ("pet%d" % i, - "smoke%d" % (i == 1 and 2 or 4))) - - # Hint 12 - problem.addConstraint(lambda smoke, drink: - smoke != "bluemaster" or drink == "beer", - ("smoke%d" % i, "drink%d" % i)) - - # Hint 13 - problem.addConstraint(lambda nationality, smoke: - nationality != "german" or smoke == "prince", - ("nationality%d" % i, "smoke%d" % i)) - - # Hint 14 - if 1 < i < 5: - problem.addConstraint(lambda nationality, colora, colorb: - nationality != "norwegian" or - colora == "blue" or colorb == "blue", - ("nationality%d" % i, "color%d" % (i-1), - "color%d" % (i+1))) - else: - problem.addConstraint(lambda nationality, color: - nationality != "norwegian" or - color == "blue", - ("nationality%d" % i, - "color%d" % (i == 1 and 2 or 4))) - - # Hint 15 - if 1 < i < 5: - problem.addConstraint(lambda smoke, drinka, drinkb: - smoke != "blends" or - drinka == "water" or drinkb == "water", - ("smoke%d" % i, "drink%d" % (i-1), - "drink%d" % (i+1))) - else: - problem.addConstraint(lambda smoke, drink: - smoke != "blends" or drink == "water", - ("smoke%d" % i, - "drink%d" % (i == 1 and 2 or 4))) - - solutions = problem.getSolutions() - print "Found %d solution(s)!" % len(solutions) - print - for solution in solutions: - showSolution(solution) - -def showSolution(solution): - for i in range(1,6): - print "House %d" % i - print "--------" - print "Nationality: %s" % solution["nationality%d" % i] - print "Color: %s" % solution["color%d" % i] - print "Drink: %s" % solution["drink%d" % i] - print "Smoke: %s" % solution["smoke%d" % i] - print "Pet: %s" % solution["pet%d" % i] - print - -if __name__ == "__main__": - main() diff --git a/csp/csp/python-constraint/examples/einstein/einstein2.py b/csp/csp/python-constraint/examples/einstein/einstein2.py deleted file mode 100755 index d1f7b86d..00000000 --- a/csp/csp/python-constraint/examples/einstein/einstein2.py +++ /dev/null @@ -1,190 +0,0 @@ -#!/usr/bin/python -# -# ALBERT EINSTEIN'S RIDDLE -# -# ARE YOU IN THE TOP 2% OF INTELLIGENT PEOPLE IN THE WORLD? -# SOLVE THE RIDDLE AND FIND OUT. -# -# There are no tricks, just pure logic, so good luck and don't give up. -# -# 1. In a street there are five houses, painted five different colours. -# 2. In each house lives a person of different nationality -# 3. These five homeowners each drink a different kind of beverage, smoke -# different brand of cigar and keep a different pet. -# -# THE QUESTION: WHO OWNS THE zebra? -# -# HINTS -# -# 1. The englishman lives in a red house. -# 2. The spaniard keeps dogs as pets. -# 5. The owner of the Green house drinks coffee. -# 3. The ukrainian drinks tea. -# 4. The Green house is on the left of the ivory house. -# 6. The person who smokes oldgold rears snails. -# 7. The owner of the Yellow house smokes kools. -# 8. The man living in the centre house drinks milk. -# 9. The Norwegian lives in the first house. -# 10. The man who smokes chesterfields lives next to the one who keeps foxes. -# 11. The man who keeps horses lives next to the man who smokes kools. -# 12. The man who smokes luckystrike drinks orangejuice. -# 13. The japanese smokes parliaments. -# 14. The Norwegian lives next to the blue house. -# 15. The man who smokes chesterfields has a neighbour who drinks water. -# -# ALBERT EINSTEIN WROTE THIS RIDDLE EARLY DURING THE 19th CENTURY. HE -# SAID THAT 98% OF THE WORLD POPULATION WOULD NOT BE ABLE TO SOLVE IT. - -from constraint import * - -# Check http://www.csc.fi/oppaat/f95/python/talot.py - -def main(): - problem = Problem() - for i in range(1,6): - problem.addVariable("color%d" % i, - ["red", "ivory", "green", "yellow", "blue"]) - problem.addVariable("nationality%d" % i, - ["englishman", "spaniard", "ukrainian", "norwegian", "japanese"]) - problem.addVariable("drink%d" % i, - ["tea", "coffee", "milk", "orangejuice", "water"]) - problem.addVariable("smoke%d" % i, - ["oldgold", "kools", "chesterfields", - "luckystrike", "parliaments"]) - problem.addVariable("pet%d" % i, - ["dogs", "snails", "foxes", "horses", "zebra"]) - - problem.addConstraint(AllDifferentConstraint(), - ["color%d" % i for i in range(1,6)]) - problem.addConstraint(AllDifferentConstraint(), - ["nationality%d" % i for i in range(1,6)]) - problem.addConstraint(AllDifferentConstraint(), - ["drink%d" % i for i in range(1,6)]) - problem.addConstraint(AllDifferentConstraint(), - ["smoke%d" % i for i in range(1,6)]) - problem.addConstraint(AllDifferentConstraint(), - ["pet%d" % i for i in range(1,6)]) - - for i in range(1,6): - - # Hint 1 - problem.addConstraint(lambda nationality, color: - nationality != "englishman" or color == "red", - ("nationality%d" % i, "color%d" % i)) - - # Hint 2 - problem.addConstraint(lambda nationality, pet: - nationality != "spaniard" or pet == "dogs", - ("nationality%d" % i, "pet%d" % i)) - - # Hint 3 - problem.addConstraint(lambda nationality, drink: - nationality != "ukrainian" or drink == "tea", - ("nationality%d" % i, "drink%d" % i)) - - # Hint 4 - if i < 5: - problem.addConstraint(lambda colora, colorb: - colora != "green" or colorb == "ivory", - ("color%d" % i, "color%d" % (i+1))) - else: - problem.addConstraint(lambda color: color != "green", - ("color%d" % i,)) - - # Hint 5 - problem.addConstraint(lambda color, drink: - color != "green" or drink == "coffee", - ("color%d" % i, "drink%d" % i)) - - # Hint 6 - problem.addConstraint(lambda smoke, pet: - smoke != "oldgold" or pet == "snails", - ("smoke%d" % i, "pet%d" % i)) - - # Hint 7 - problem.addConstraint(lambda color, smoke: - color != "yellow" or smoke == "kools", - ("color%d" % i, "smoke%d" % i)) - - # Hint 8 - if i == 3: - problem.addConstraint(lambda drink: drink == "milk", - ("drink%d" % i,)) - - # Hint 9 - if i == 1: - problem.addConstraint(lambda nationality: - nationality == "norwegian", - ("nationality%d" % i,)) - - # Hint 10 - if 1 < i < 5: - problem.addConstraint(lambda smoke, peta, petb: - smoke != "chesterfields" or peta == "foxes" or - petb == "foxes", - ("smoke%d" % i, "pet%d" % (i-1), - "pet%d" % (i+1))) - else: - problem.addConstraint(lambda smoke, pet: - smoke != "chesterfields" or pet == "foxes", - ("smoke%d" % i, - "pet%d" % (i == 1 and 2 or 4))) - - # Hint 11 - if 1 < i < 5: - problem.addConstraint(lambda pet, smokea, smokeb: - pet != "horses" or smokea == "kools" or - smokeb == "kools", - ("pet%d" % i, "smoke%d" % (i-1), - "smoke%d" % (i+1))) - else: - problem.addConstraint(lambda pet, smoke: - pet != "horses" or smoke == "kools", - ("pet%d" % i, - "smoke%d" % (i == 1 and 2 or 4))) - - # Hint 12 - problem.addConstraint(lambda smoke, drink: - smoke != "luckystrike" or drink == "orangejuice", - ("smoke%d" % i, "drink%d" % i)) - - # Hint 13 - problem.addConstraint(lambda nationality, smoke: - nationality != "japanese" or smoke == "parliaments", - ("nationality%d" % i, "smoke%d" % i)) - - # Hint 14 - if 1 < i < 5: - problem.addConstraint(lambda nationality, colora, colorb: - nationality != "norwegian" or - colora == "blue" or colorb == "blue", - ("nationality%d" % i, "color%d" % (i-1), - "color%d" % (i+1))) - else: - problem.addConstraint(lambda nationality, color: - nationality != "norwegian" or - color == "blue", - ("nationality%d" % i, - "color%d" % (i == 1 and 2 or 4))) - - - - solutions = problem.getSolutions() - print "Found %d solution(s)!" % len(solutions) - print - for solution in solutions: - showSolution(solution) - -def showSolution(solution): - for i in range(1,6): - print "House %d" % i - print "--------" - print "Nationality: %s" % solution["nationality%d" % i] - print "Color: %s" % solution["color%d" % i] - print "Drink: %s" % solution["drink%d" % i] - print "Smoke: %s" % solution["smoke%d" % i] - print "Pet: %s" % solution["pet%d" % i] - print - -if __name__ == "__main__": - main() diff --git a/csp/csp/python-constraint/examples/queens/queens.py b/csp/csp/python-constraint/examples/queens/queens.py deleted file mode 100755 index deac7131..00000000 --- a/csp/csp/python-constraint/examples/queens/queens.py +++ /dev/null @@ -1,47 +0,0 @@ -#!/usr/bin/python -# -# http://mathworld.wolfram.com/QueensProblem.html -# -from constraint import * -import sys - -def main(show=False): - problem = Problem() - size = 8 - cols = range(size) - rows = range(size) - problem.addVariables(cols, rows) - for col1 in cols: - for col2 in cols: - if col1 < col2: - problem.addConstraint(lambda row1, row2, col1=col1, col2=col2: - abs(row1-row2) != abs(col1-col2) and - row1 != row2, (col1, col2)) - solutions = problem.getSolutions() - print "Found %d solution(s)!" % len(solutions) - if show: - for solution in solutions: - showSolution(solution, size) - -def showSolution(solution, size): - sys.stdout.write(" %s \n" % ("-"*((size*4)-1))) - for i in range(size): - sys.stdout.write(" |") - for j in range(size): - if solution[j] == i: - sys.stdout.write(" %d |" % j) - else: - sys.stdout.write(" |") - sys.stdout.write("\n") - if i != size-1: - sys.stdout.write(" |%s|\n" % ("-"*((size*4)-1))) - sys.stdout.write(" %s \n" % ("-"*((size*4)-1))) - -if __name__ == "__main__": - show = False - if len(sys.argv) == 2 and sys.argv[1] == "-s": - show = True - elif len(sys.argv) != 1: - sys.exit("Usage: queens.py [-s]") - main(show) - diff --git a/csp/csp/python-constraint/examples/rooks/rooks.py b/csp/csp/python-constraint/examples/rooks/rooks.py deleted file mode 100755 index 14f88b1e..00000000 --- a/csp/csp/python-constraint/examples/rooks/rooks.py +++ /dev/null @@ -1,49 +0,0 @@ -#!/usr/bin/python -# -# http://mathworld.wolfram.com/RooksProblem.html -# -from constraint import * -import sys - -def factorial(x): return x == 1 or factorial(x-1)*x - -def main(show=False): - problem = Problem() - size = 8 - cols = range(size) - rows = range(size) - problem.addVariables(cols, rows) - for col1 in cols: - for col2 in cols: - if col1 < col2: - problem.addConstraint(lambda row1, row2: row1 != row2, - (col1, col2)) - solutions = problem.getSolutions() - print "Found %d solution(s)!" % len(solutions) - assert len(solutions) == factorial(size) - if show: - for solution in solutions: - showSolution(solution, size) - -def showSolution(solution, size): - sys.stdout.write(" %s \n" % ("-"*((size*4)-1))) - for i in range(size): - sys.stdout.write(" |") - for j in range(size): - if solution[j] == i: - sys.stdout.write(" %d |" % j) - else: - sys.stdout.write(" |") - sys.stdout.write("\n") - if i != size-1: - sys.stdout.write(" |%s|\n" % ("-"*((size*4)-1))) - sys.stdout.write(" %s \n" % ("-"*((size*4)-1))) - -if __name__ == "__main__": - show = False - if len(sys.argv) == 2 and sys.argv[1] == "-s": - show = True - elif len(sys.argv) != 1: - sys.exit("Usage: rooks.py [-s]") - main(show) - diff --git a/csp/csp/python-constraint/examples/studentdesks/studentdesks.py b/csp/csp/python-constraint/examples/studentdesks/studentdesks.py deleted file mode 100755 index e8d47792..00000000 --- a/csp/csp/python-constraint/examples/studentdesks/studentdesks.py +++ /dev/null @@ -1,39 +0,0 @@ -#!/usr/bin/python -# -# http://home.chello.no/~dudley/ -# -from constraint import * -import sys - -STUDENTDESKS = [[ 0, 1, 0, 0, 0, 0], - [ 0, 2, 3, 4, 5, 6], - [ 0, 7, 8, 9, 10, 0], - [ 0, 11, 12, 13, 14, 0], - [ 15, 16, 17, 18, 19, 0], - [ 0, 0, 0, 0, 20, 0]] - -def main(): - problem = Problem() - problem.addVariables(range(1,21), ["A", "B", "C", "D", "E"]) - problem.addConstraint(SomeInSetConstraint(["A"], 4, True)) - problem.addConstraint(SomeInSetConstraint(["B"], 4, True)) - problem.addConstraint(SomeInSetConstraint(["C"], 4, True)) - problem.addConstraint(SomeInSetConstraint(["D"], 4, True)) - problem.addConstraint(SomeInSetConstraint(["E"], 4, True)) - for row in range(len(STUDENTDESKS)-1): - for col in range(len(STUDENTDESKS[row])-1): - lst = [STUDENTDESKS[row][col], STUDENTDESKS[row][col+1], - STUDENTDESKS[row+1][col], STUDENTDESKS[row+1][col+1]] - lst = [x for x in lst if x] - problem.addConstraint(AllDifferentConstraint(), lst) - showSolution(problem.getSolution()) - -def showSolution(solution): - for row in range(len(STUDENTDESKS)): - for col in range(len(STUDENTDESKS[row])): - id = STUDENTDESKS[row][col] - sys.stdout.write(" %s" % (id and solution[id] or " ")) - sys.stdout.write("\n") - -if __name__ == "__main__": - main() diff --git a/csp/csp/python-constraint/examples/sudoku/sudoku.py b/csp/csp/python-constraint/examples/sudoku/sudoku.py deleted file mode 100644 index e79698ea..00000000 --- a/csp/csp/python-constraint/examples/sudoku/sudoku.py +++ /dev/null @@ -1,61 +0,0 @@ -# -# Sudoku puzzle solver by by Luigi Poderico (www.poderico.it). -# -from constraint import * - -problem = Problem() - -# Define the variables: 9 rows of 9 variables rangin in 1...9 -for i in range(1, 10) : - problem.addVariables(range(i*10+1, i*10+10), range(1, 10)) - -# Each row has different values -for i in range(1, 10) : - problem.addConstraint(AllDifferentConstraint(), range(i*10+1, i*10+10)) - -# Each colum has different values -for i in range(1, 10) : - problem.addConstraint(AllDifferentConstraint(), range(10+i, 100+i, 10)) - -# Each 3x3 box has different values -problem.addConstraint(AllDifferentConstraint(), [11,12,13,21,22,23,31,32,33]) -problem.addConstraint(AllDifferentConstraint(), [41,42,43,51,52,53,61,62,63]) -problem.addConstraint(AllDifferentConstraint(), [71,72,73,81,82,83,91,92,93]) - -problem.addConstraint(AllDifferentConstraint(), [14,15,16,24,25,26,34,35,36]) -problem.addConstraint(AllDifferentConstraint(), [44,45,46,54,55,56,64,65,66]) -problem.addConstraint(AllDifferentConstraint(), [74,75,76,84,85,86,94,95,96]) - -problem.addConstraint(AllDifferentConstraint(), [17,18,19,27,28,29,37,38,39]) -problem.addConstraint(AllDifferentConstraint(), [47,48,49,57,58,59,67,68,69]) -problem.addConstraint(AllDifferentConstraint(), [77,78,79,87,88,89,97,98,99]) - -# Some value is given. -initValue = [[0, 9, 0, 7, 0, 0, 8, 6, 0], - [0, 3, 1, 0, 0, 5, 0, 2, 0], - [8, 0, 6, 0, 0, 0, 0, 0, 0], - [0, 0, 7, 0, 5, 0, 0, 0, 6], - [0, 0, 0, 3, 0, 7, 0, 0, 0], - [5, 0, 0, 0, 1, 0, 7, 0, 0], - [0, 0, 0, 0, 0, 0, 1, 0, 9], - [0, 2, 0, 6, 0, 0, 0, 5, 0], - [0, 5, 4, 0, 0, 8, 0, 7, 0]] - -for i in range(1, 10) : - for j in range(1, 10): - if initValue[i-1][j-1] !=0 : - problem.addConstraint(lambda var, val=initValue[i-1][j-1]: - var==val, (i*10+j,)) - -# Get the solutions. -solutions = problem.getSolutions() - -# Print the solutions -for solution in solutions: - for i in range(1, 10): - for j in range(1, 10): - index = i*10+j - print solution[index], - print - print - diff --git a/csp/csp/python-constraint/examples/wordmath/seisseisdoze.py b/csp/csp/python-constraint/examples/wordmath/seisseisdoze.py deleted file mode 100755 index b17956db..00000000 --- a/csp/csp/python-constraint/examples/wordmath/seisseisdoze.py +++ /dev/null @@ -1,32 +0,0 @@ -#!/usr/bin/python -# -# Assign equal values to equal letters, and different values to -# different letters, in a way that satisfies the following sum: -# -# SEIS -# + SEIS -# ------ -# DOZE -# -from constraint import * - -def main(): - problem = Problem() - problem.addVariables("seidoz", range(10)) - problem.addConstraint(lambda s, e: (2*s)%10 == e, "se") - problem.addConstraint(lambda i, s, z, e: ((10*2*i)+(2*s))%100 == z*10+e, - "isze") - problem.addConstraint(lambda s, e, i, d, o, z: - 2*(s*1000+e*100+i*10+s) == d*1000+o*100+z*10+e, - "seidoz") - problem.addConstraint(lambda s: s != 0, "s") - problem.addConstraint(lambda d: d != 0, "d") - problem.addConstraint(AllDifferentConstraint()) - print "SEIS+SEIS=DOZE" - for s in problem.getSolutions(): - print ("%(s)d%(e)d%(i)d%(s)s+%(s)d%(e)d%(i)d%(s)d=" - "%(d)d%(o)d%(z)d%(e)d") % s - -if __name__ == "__main__": - main() - diff --git a/csp/csp/python-constraint/examples/wordmath/sendmoremoney.py b/csp/csp/python-constraint/examples/wordmath/sendmoremoney.py deleted file mode 100755 index 894b0cd5..00000000 --- a/csp/csp/python-constraint/examples/wordmath/sendmoremoney.py +++ /dev/null @@ -1,34 +0,0 @@ -#!/usr/bin/python -# -# Assign equal values to equal letters, and different values to -# different letters, in a way that satisfies the following sum: -# -# SEND -# + MORE -# ------ -# MONEY -# -from constraint import * - -def main(): - problem = Problem() - problem.addVariables("sendmory", range(10)) - problem.addConstraint(lambda d, e, y: (d+e)%10 == y, "dey") - problem.addConstraint(lambda n, d, r, e, y: (n*10+d+r*10+e)%100 == e*10+y, - "ndrey") - problem.addConstraint(lambda e, n, d, o, r, y: - (e*100+n*10+d+o*100+r*10+e)%1000 == n*100+e*10+y, - "endory") - problem.addConstraint(lambda s, e, n, d, m, o, r, y: - 1000*s+100*e+10*n+d + 1000*m+100*o+10*r+e == - 10000*m+1000*o+100*n+10*e+y, "sendmory") - problem.addConstraint(NotInSetConstraint([0]), "sm") - problem.addConstraint(AllDifferentConstraint()) - print "SEND+MORE=MONEY" - for s in problem.getSolutions(): - print "%(s)d%(e)d%(n)d%(d)d+" \ - "%(m)d%(o)d%(r)d%(e)d=" \ - "%(m)d%(o)d%(n)d%(e)d%(y)d" % s - -if __name__ == "__main__": - main() diff --git a/csp/csp/python-constraint/examples/wordmath/twotwofour.py b/csp/csp/python-constraint/examples/wordmath/twotwofour.py deleted file mode 100755 index b9e70d6a..00000000 --- a/csp/csp/python-constraint/examples/wordmath/twotwofour.py +++ /dev/null @@ -1,28 +0,0 @@ -#!/usr/bin/python -# -# Assign equal values to equal letters, and different values to -# different letters, in a way that satisfies the following sum: -# -# TWO -# + TWO -# ----- -# FOUR -# -from constraint import * - -def main(): - problem = Problem() - problem.addVariables("twofur", range(10)) - problem.addConstraint(lambda o, r: (2*o)%10 == r, "or") - problem.addConstraint(lambda w, o, u, r: ((10*2*w)+(2*o))%100 == u*10+r, - "wour") - problem.addConstraint(lambda t, w, o, f, u, r: - 2*(t*100+w*10+o) == f*1000+o*100+u*10+r, "twofur") - problem.addConstraint(NotInSetConstraint([0]), "ft") - problem.addConstraint(AllDifferentConstraint()) - print "TWO+TWO=FOUR" - for s in problem.getSolutions(): - print "%(t)d%(w)d%(o)d+%(t)d%(w)d%(o)d=%(f)d%(o)d%(u)d%(r)d" % s - -if __name__ == "__main__": - main() diff --git a/csp/csp/python-constraint/examples/xsum/xsum.py b/csp/csp/python-constraint/examples/xsum/xsum.py deleted file mode 100755 index 0f5f70b6..00000000 --- a/csp/csp/python-constraint/examples/xsum/xsum.py +++ /dev/null @@ -1,37 +0,0 @@ -#!/usr/bin/python -# -# Reorganize the following numbers in a way that each line of -# 5 numbers sum to 27. -# -# 1 6 -# 2 7 -# 3 -# 8 4 -# 9 5 -# -from constraint import * - -def main(): - problem = Problem() - problem.addVariables("abcdxefgh", range(1,10)) - problem.addConstraint(lambda a, b, c, d, x: - a < b < c < d and a+b+c+d+x == 27, "abcdx") - problem.addConstraint(lambda e, f, g, h, x: - e < f < g < h and e+f+g+h+x == 27, "efghx") - problem.addConstraint(AllDifferentConstraint()) - solutions = problem.getSolutions() - print "Found %d solutions!" % len(solutions) - showSolutions(solutions) - -def showSolutions(solutions): - for solution in solutions: - print " %d %d" % (solution["a"], solution["e"]) - print " %d %d " % (solution["b"], solution["f"]) - print " %d " % (solution["x"],) - print " %d %d " % (solution["g"], solution["c"]) - print " %d %d" % (solution["h"], solution["d"]) - print - -if __name__ == "__main__": - main() - diff --git a/csp/csp/python-constraint/setup.cfg b/csp/csp/python-constraint/setup.cfg deleted file mode 100644 index 33d88e05..00000000 --- a/csp/csp/python-constraint/setup.cfg +++ /dev/null @@ -1,6 +0,0 @@ -[bdist_rpm] -doc_files = README -use_bzip2 = 1 - -[sdist] -formats = bztar diff --git a/csp/csp/python-constraint/setup.py b/csp/csp/python-constraint/setup.py deleted file mode 100755 index cda67133..00000000 --- a/csp/csp/python-constraint/setup.py +++ /dev/null @@ -1,21 +0,0 @@ -#!/usr/bin/python -from distutils.core import setup -import os - -if os.path.isfile("MANIFEST"): - os.unlink("MANIFEST") - -setup(name="python-constraint", - version = "1.2", - description = "Python module for handling Constraint Solving Problems", - author = "Gustavo Niemeyer", - author_email = "gustavo@niemeyer.net", - url = "http://labix.org/python-constraint", - license = "Simplified BSD", - long_description = -""" -python-constraint is a module implementing support for handling CSPs -(Constraint Solving Problems) over finite domains. -""", - py_modules = ["constraint"], - ) diff --git a/csp/csp/python-constraint/testconstraint.py b/csp/csp/python-constraint/testconstraint.py deleted file mode 100644 index 9b9f5c5c..00000000 --- a/csp/csp/python-constraint/testconstraint.py +++ /dev/null @@ -1,13 +0,0 @@ -#!/usr/bin/python - -from constraint import * - -#p = Problem() -#p.addVariable("ab", [1, 2]) -#p.addVariable("c", [3]) -#print p.getSolutions() - -problem = Problem() -problem.addVariables(["a", "b"], [1, 2]) -problem.addConstraint(AllDifferentConstraint()) -print problem.getSolutions() \ No newline at end of file diff --git a/csp/csp/python-constraint/trials/abcd.py b/csp/csp/python-constraint/trials/abcd.py deleted file mode 100755 index 55bedaca..00000000 --- a/csp/csp/python-constraint/trials/abcd.py +++ /dev/null @@ -1,29 +0,0 @@ -#!/usr/bin/python -# -# What's the minimum value for: -# -# ABC -# ------- -# A+B+C -# -# From http://www.umassd.edu/mathcontest/abc.cfm -# -from constraint import * - -def main(): - problem = Problem() - problem.addVariables("abc", range(1,10)) - results = [] - for solution in problem.getSolutions(): - a = solution["a"] - b = solution["b"] - c = solution["c"] - results.append((((a*100) + (b*10) + c) / (a + b + c + 0.0), (a*100) + (b*10) + c)) - - results.sort() - - print results[0] - - -if __name__ == "__main__": - main() diff --git a/csp/csp/python-constraint/trials/coins.py b/csp/csp/python-constraint/trials/coins.py deleted file mode 100755 index cb47537d..00000000 --- a/csp/csp/python-constraint/trials/coins.py +++ /dev/null @@ -1,30 +0,0 @@ -#!/usr/bin/python -# -# 100 coins must sum to $5.00 -# -# That's kind of a country-specific problem, since depending on the -# country there are different values for coins. Here is presented -# the solution for a given set. -# -from constraint import * -import sys - -def main(): - problem = Problem() - total = 5.00 - variables = ("0.01", "0.05", "0.10", "0.25") - values = [float(x) for x in variables] - for variable, value in zip(variables, values): - problem.addVariable(variable, range(int(total/value))) - problem.addConstraint(ExactSumConstraint(total, values), variables) - problem.addConstraint(ExactSumConstraint(100)) - solutions = problem.getSolutionIter() - for i, solution in enumerate(solutions): - sys.stdout.write("%03d -> " % (i+1)) - for variable in variables: - sys.stdout.write("%s:%d " % (variable, solution[variable])) - sys.stdout.write("\n") - -if __name__ == "__main__": - main() - diff --git a/csp/csp/python-constraint/trials/constraint.py b/csp/csp/python-constraint/trials/constraint.py deleted file mode 100644 index b1cd836b..00000000 --- a/csp/csp/python-constraint/trials/constraint.py +++ /dev/null @@ -1,1434 +0,0 @@ -#!/usr/bin/python -# -# Copyright (c) 2005-2014 - Gustavo Niemeyer -# -# All rights reserved. -# -# Redistribution and use in source and binary forms, with or without -# modification, are permitted provided that the following conditions are met: -# -# 1. Redistributions of source code must retain the above copyright notice, this -# list of conditions and the following disclaimer. -# 2. Redistributions in binary form must reproduce the above copyright notice, -# this list of conditions and the following disclaimer in the documentation -# and/or other materials provided with the distribution. -# -# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" -# AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE -# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE -# DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE -# FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL -# DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR -# SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER -# CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, -# OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE -# OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -""" -@var Unassigned: Helper object instance representing unassigned values - -@sort: Problem, Variable, Domain -@group Solvers: Solver, - BacktrackingSolver, - RecursiveBacktrackingSolver, - MinConflictsSolver -@group Constraints: Constraint, - FunctionConstraint, - AllDifferentConstraint, - AllEqualConstraint, - MaxSumConstraint, - ExactSumConstraint, - MinSumConstraint, - InSetConstraint, - NotInSetConstraint, - SomeInSetConstraint, - SomeNotInSetConstraint -""" -import random -import copy - -__all__ = ["Problem", "Variable", "Domain", "Unassigned", - "Solver", "BacktrackingSolver", "RecursiveBacktrackingSolver", - "MinConflictsSolver", "Constraint", "FunctionConstraint", - "AllDifferentConstraint", "AllEqualConstraint", "MaxSumConstraint", - "ExactSumConstraint", "MinSumConstraint", "InSetConstraint", - "NotInSetConstraint", "SomeInSetConstraint", - "SomeNotInSetConstraint"] - -class Problem(object): - """ - Class used to define a problem and retrieve solutions - """ - - def __init__(self, solver=None): - """ - @param solver: Problem solver used to find solutions - (default is L{BacktrackingSolver}) - @type solver: instance of a L{Solver} subclass - """ - self._solver = solver or BacktrackingSolver() - self._constraints = [] - self._variables = {} - - def reset(self): - """ - Reset the current problem definition - - Example: - - >>> problem = Problem() - >>> problem.addVariable("a", [1, 2]) - >>> problem.reset() - >>> problem.getSolution() - >>> - """ - del self._constraints[:] - self._variables.clear() - - def setSolver(self, solver): - """ - Change the problem solver currently in use - - Example: - - >>> solver = BacktrackingSolver() - >>> problem = Problem(solver) - >>> problem.getSolver() is solver - True - - @param solver: New problem solver - @type solver: instance of a C{Solver} subclass - """ - self._solver = solver - - def getSolver(self): - """ - Obtain the problem solver currently in use - - Example: - - >>> solver = BacktrackingSolver() - >>> problem = Problem(solver) - >>> problem.getSolver() is solver - True - - @return: Solver currently in use - @rtype: instance of a L{Solver} subclass - """ - return self._solver - - def addVariable(self, variable, domain): - """ - Add a variable to the problem - - Example: - - >>> problem = Problem() - >>> problem.addVariable("a", [1, 2]) - >>> problem.getSolution() in ({'a': 1}, {'a': 2}) - True - - @param variable: Object representing a problem variable - @type variable: hashable object - @param domain: Set of items defining the possible values that - the given variable may assume - @type domain: list, tuple, or instance of C{Domain} - """ - if variable in self._variables: - raise ValueError, "Tried to insert duplicated variable %s" % \ - repr(variable) - if type(domain) in (list, tuple): - domain = Domain(domain) - elif isinstance(domain, Domain): - domain = copy.copy(domain) - else: - raise TypeError, "Domains must be instances of subclasses of "\ - "the Domain class" - if not domain: - raise ValueError, "Domain is empty" - self._variables[variable] = domain - - def addVariables(self, variables, domain): - """ - Add one or more variables to the problem - - Example: - - >>> problem = Problem() - >>> problem.addVariables(["a", "b"], [1, 2, 3]) - >>> solutions = problem.getSolutions() - >>> len(solutions) - 9 - >>> {'a': 3, 'b': 1} in solutions - True - - @param variables: Any object containing a sequence of objects - represeting problem variables - @type variables: sequence of hashable objects - @param domain: Set of items defining the possible values that - the given variables may assume - @type domain: list, tuple, or instance of C{Domain} - """ - for variable in variables: - self.addVariable(variable, domain) - - def addConstraint(self, constraint, variables=None): - """ - Add a constraint to the problem - - Example: - - >>> problem = Problem() - >>> problem.addVariables(["a", "b"], [1, 2, 3]) - >>> problem.addConstraint(lambda a, b: b == a+1, ["a", "b"]) - >>> solutions = problem.getSolutions() - >>> - - @param constraint: Constraint to be included in the problem - @type constraint: instance a L{Constraint} subclass or a - function to be wrapped by L{FunctionConstraint} - @param variables: Variables affected by the constraint (default to - all variables). Depending on the constraint type - the order may be important. - @type variables: set or sequence of variables - """ - if not isinstance(constraint, Constraint): - if callable(constraint): - constraint = FunctionConstraint(constraint) - else: - raise ValueError, "Constraints must be instances of "\ - "subclasses of the Constraint class" - self._constraints.append((constraint, variables)) - - def getSolution(self): - """ - Find and return a solution to the problem - - Example: - - >>> problem = Problem() - >>> problem.getSolution() is None - True - >>> problem.addVariables(["a"], [42]) - >>> problem.getSolution() - {'a': 42} - - @return: Solution for the problem - @rtype: dictionary mapping variables to values - """ - domains, constraints, vconstraints = self._getArgs() - if not domains: - return None - return self._solver.getSolution(domains, constraints, vconstraints) - - def getSolutions(self): - """ - Find and return all solutions to the problem - - Example: - - >>> problem = Problem() - >>> problem.getSolutions() == [] - True - >>> problem.addVariables(["a"], [42]) - >>> problem.getSolutions() - [{'a': 42}] - - @return: All solutions for the problem - @rtype: list of dictionaries mapping variables to values - """ - domains, constraints, vconstraints = self._getArgs() - if not domains: - return [] - return self._solver.getSolutions(domains, constraints, vconstraints) - - def getSolutionIter(self): - """ - Return an iterator to the solutions of the problem - - Example: - - >>> problem = Problem() - >>> list(problem.getSolutionIter()) == [] - True - >>> problem.addVariables(["a"], [42]) - >>> iter = problem.getSolutionIter() - >>> iter.next() - {'a': 42} - >>> iter.next() - Traceback (most recent call last): - File "", line 1, in ? - StopIteration - """ - domains, constraints, vconstraints = self._getArgs() - if not domains: - return iter(()) - return self._solver.getSolutionIter(domains, constraints, - vconstraints) - - def _getArgs(self): - domains = self._variables.copy() - allvariables = domains.keys() - constraints = [] - for constraint, variables in self._constraints: - if not variables: - variables = allvariables - constraints.append((constraint, variables)) - vconstraints = {} - for variable in domains: - vconstraints[variable] = [] - for constraint, variables in constraints: - for variable in variables: - vconstraints[variable].append((constraint, variables)) - for constraint, variables in constraints[:]: - constraint.preProcess(variables, domains, - constraints, vconstraints) - for domain in domains.values(): - domain.resetState() - if not domain: - return None, None, None - #doArc8(getArcs(domains, constraints), domains, {}) - return domains, constraints, vconstraints - -# ---------------------------------------------------------------------- -# Solvers -# ---------------------------------------------------------------------- - -def getArcs(domains, constraints): - """ - Return a dictionary mapping pairs (arcs) of constrained variables - - @attention: Currently unused. - """ - arcs = {} - for x in constraints: - constraint, variables = x - if len(variables) == 2: - variable1, variable2 = variables - arcs.setdefault(variable1, {})\ - .setdefault(variable2, [])\ - .append(x) - arcs.setdefault(variable2, {})\ - .setdefault(variable1, [])\ - .append(x) - return arcs - -def doArc8(arcs, domains, assignments): - """ - Perform the ARC-8 arc checking algorithm and prune domains - - @attention: Currently unused. - """ - check = dict.fromkeys(domains, True) - while check: - variable, _ = check.popitem() - if variable not in arcs or variable in assignments: - continue - domain = domains[variable] - arcsvariable = arcs[variable] - for othervariable in arcsvariable: - arcconstraints = arcsvariable[othervariable] - if othervariable in assignments: - otherdomain = [assignments[othervariable]] - else: - otherdomain = domains[othervariable] - if domain: - changed = False - for value in domain[:]: - assignments[variable] = value - if otherdomain: - for othervalue in otherdomain: - assignments[othervariable] = othervalue - for constraint, variables in arcconstraints: - if not constraint(variables, domains, - assignments, True): - break - else: - # All constraints passed. Value is safe. - break - else: - # All othervalues failed. Kill value. - domain.hideValue(value) - changed = True - del assignments[othervariable] - del assignments[variable] - #if changed: - # check.update(dict.fromkeys(arcsvariable)) - if not domain: - return False - return True - -class Solver(object): - """ - Abstract base class for solvers - - @sort: getSolution, getSolutions, getSolutionIter - """ - - def getSolution(self, domains, constraints, vconstraints): - """ - Return one solution for the given problem - - @param domains: Dictionary mapping variables to their domains - @type domains: dict - @param constraints: List of pairs of (constraint, variables) - @type constraints: list - @param vconstraints: Dictionary mapping variables to a list of - constraints affecting the given variables. - @type vconstraints: dict - """ - raise NotImplementedError, \ - "%s is an abstract class" % self.__class__.__name__ - - def getSolutions(self, domains, constraints, vconstraints): - """ - Return all solutions for the given problem - - @param domains: Dictionary mapping variables to domains - @type domains: dict - @param constraints: List of pairs of (constraint, variables) - @type constraints: list - @param vconstraints: Dictionary mapping variables to a list of - constraints affecting the given variables. - @type vconstraints: dict - """ - raise NotImplementedError, \ - "%s provides only a single solution" % self.__class__.__name__ - - def getSolutionIter(self, domains, constraints, vconstraints): - """ - Return an iterator for the solutions of the given problem - - @param domains: Dictionary mapping variables to domains - @type domains: dict - @param constraints: List of pairs of (constraint, variables) - @type constraints: list - @param vconstraints: Dictionary mapping variables to a list of - constraints affecting the given variables. - @type vconstraints: dict - """ - raise NotImplementedError, \ - "%s doesn't provide iteration" % self.__class__.__name__ - -class BacktrackingSolver(Solver): - """ - Problem solver with backtracking capabilities - - Examples: - - >>> result = [[('a', 1), ('b', 2)], - ... [('a', 1), ('b', 3)], - ... [('a', 2), ('b', 3)]] - - >>> problem = Problem(BacktrackingSolver()) - >>> problem.addVariables(["a", "b"], [1, 2, 3]) - >>> problem.addConstraint(lambda a, b: b > a, ["a", "b"]) - - >>> solution = problem.getSolution() - >>> sorted(solution.items()) in result - True - - >>> for solution in problem.getSolutionIter(): - ... sorted(solution.items()) in result - True - True - True - - >>> for solution in problem.getSolutions(): - ... sorted(solution.items()) in result - True - True - True - """#""" - - def __init__(self, forwardcheck=True): - """ - @param forwardcheck: If false forward checking will not be requested - to constraints while looking for solutions - (default is true) - @type forwardcheck: bool - """ - self._forwardcheck = forwardcheck - - def getSolutionIter(self, domains, constraints, vconstraints): - forwardcheck = self._forwardcheck - assignments = {} - - queue = [] - - while True: - - # Mix the Degree and Minimum Remaing Values (MRV) heuristics - lst = [(-len(vconstraints[variable]), - len(domains[variable]), variable) for variable in domains] - lst.sort() - for item in lst: - if item[-1] not in assignments: - # Found unassigned variable - variable = item[-1] - values = domains[variable][:] - if forwardcheck: - pushdomains = [domains[x] for x in domains - if x not in assignments and - x != variable] - else: - pushdomains = None - break - else: - # No unassigned variables. We've got a solution. Go back - # to last variable, if there's one. - yield assignments.copy() - if not queue: - return - variable, values, pushdomains = queue.pop() - if pushdomains: - for domain in pushdomains: - domain.popState() - - while True: - # We have a variable. Do we have any values left? - if not values: - # No. Go back to last variable, if there's one. - del assignments[variable] - while queue: - variable, values, pushdomains = queue.pop() - if pushdomains: - for domain in pushdomains: - domain.popState() - if values: - break - del assignments[variable] - else: - return - - # Got a value. Check it. - assignments[variable] = values.pop() - - if pushdomains: - for domain in pushdomains: - domain.pushState() - - for constraint, variables in vconstraints[variable]: - if not constraint(variables, domains, assignments, - pushdomains): - # Value is not good. - break - else: - break - - if pushdomains: - for domain in pushdomains: - domain.popState() - - # Push state before looking for next variable. - queue.append((variable, values, pushdomains)) - - raise RuntimeError, "Can't happen" - - def getSolution(self, domains, constraints, vconstraints): - iter = self.getSolutionIter(domains, constraints, vconstraints) - try: - return iter.next() - except StopIteration: - return None - - def getSolutions(self, domains, constraints, vconstraints): - return list(self.getSolutionIter(domains, constraints, vconstraints)) - - -class RecursiveBacktrackingSolver(Solver): - """ - Recursive problem solver with backtracking capabilities - - Examples: - - >>> result = [[('a', 1), ('b', 2)], - ... [('a', 1), ('b', 3)], - ... [('a', 2), ('b', 3)]] - - >>> problem = Problem(RecursiveBacktrackingSolver()) - >>> problem.addVariables(["a", "b"], [1, 2, 3]) - >>> problem.addConstraint(lambda a, b: b > a, ["a", "b"]) - - >>> solution = problem.getSolution() - >>> sorted(solution.items()) in result - True - - >>> for solution in problem.getSolutions(): - ... sorted(solution.items()) in result - True - True - True - - >>> problem.getSolutionIter() - Traceback (most recent call last): - ... - NotImplementedError: RecursiveBacktrackingSolver doesn't provide iteration - """#""" - - def __init__(self, forwardcheck=True): - """ - @param forwardcheck: If false forward checking will not be requested - to constraints while looking for solutions - (default is true) - @type forwardcheck: bool - """ - self._forwardcheck = forwardcheck - - def recursiveBacktracking(self, solutions, domains, vconstraints, - assignments, single): - - # Mix the Degree and Minimum Remaing Values (MRV) heuristics - lst = [(-len(vconstraints[variable]), - len(domains[variable]), variable) for variable in domains] - lst.sort() - for item in lst: - if item[-1] not in assignments: - # Found an unassigned variable. Let's go. - break - else: - # No unassigned variables. We've got a solution. - solutions.append(assignments.copy()) - return solutions - - variable = item[-1] - assignments[variable] = None - - forwardcheck = self._forwardcheck - if forwardcheck: - pushdomains = [domains[x] for x in domains if x not in assignments] - else: - pushdomains = None - - for value in domains[variable]: - assignments[variable] = value - if pushdomains: - for domain in pushdomains: - domain.pushState() - for constraint, variables in vconstraints[variable]: - if not constraint(variables, domains, assignments, - pushdomains): - # Value is not good. - break - else: - # Value is good. Recurse and get next variable. - self.recursiveBacktracking(solutions, domains, vconstraints, - assignments, single) - if solutions and single: - return solutions - if pushdomains: - for domain in pushdomains: - domain.popState() - del assignments[variable] - return solutions - - def getSolution(self, domains, constraints, vconstraints): - solutions = self.recursiveBacktracking([], domains, vconstraints, - {}, True) - return solutions and solutions[0] or None - - def getSolutions(self, domains, constraints, vconstraints): - return self.recursiveBacktracking([], domains, vconstraints, - {}, False) - - -class MinConflictsSolver(Solver): - """ - Problem solver based on the minimum conflicts theory - - Examples: - - >>> result = [[('a', 1), ('b', 2)], - ... [('a', 1), ('b', 3)], - ... [('a', 2), ('b', 3)]] - - >>> problem = Problem(MinConflictsSolver()) - >>> problem.addVariables(["a", "b"], [1, 2, 3]) - >>> problem.addConstraint(lambda a, b: b > a, ["a", "b"]) - - >>> solution = problem.getSolution() - >>> sorted(solution.items()) in result - True - - >>> problem.getSolutions() - Traceback (most recent call last): - ... - NotImplementedError: MinConflictsSolver provides only a single solution - - >>> problem.getSolutionIter() - Traceback (most recent call last): - ... - NotImplementedError: MinConflictsSolver doesn't provide iteration - """#""" - - def __init__(self, steps=1000): - """ - @param steps: Maximum number of steps to perform before giving up - when looking for a solution (default is 1000) - @type steps: int - """ - self._steps = steps - - def getSolution(self, domains, constraints, vconstraints): - assignments = {} - # Initial assignment - for variable in domains: - assignments[variable] = random.choice(domains[variable]) - for _ in xrange(self._steps): - conflicted = False - lst = domains.keys() - random.shuffle(lst) - for variable in lst: - # Check if variable is not in conflict - for constraint, variables in vconstraints[variable]: - if not constraint(variables, domains, assignments): - break - else: - continue - # Variable has conflicts. Find values with less conflicts. - mincount = len(vconstraints[variable]) - minvalues = [] - for value in domains[variable]: - assignments[variable] = value - count = 0 - for constraint, variables in vconstraints[variable]: - if not constraint(variables, domains, assignments): - count += 1 - if count == mincount: - minvalues.append(value) - elif count < mincount: - mincount = count - del minvalues[:] - minvalues.append(value) - # Pick a random one from these values. - assignments[variable] = random.choice(minvalues) - conflicted = True - if not conflicted: - return assignments - return None - -# ---------------------------------------------------------------------- -# Variables -# ---------------------------------------------------------------------- - -class Variable(object): - """ - Helper class for variable definition - - Using this class is optional, since any hashable object, - including plain strings and integers, may be used as variables. - """ - - def __init__(self, name): - """ - @param name: Generic variable name for problem-specific purposes - @type name: string - """ - self.name = name - - def __repr__(self): - return self.name - -Unassigned = Variable("Unassigned") - -# ---------------------------------------------------------------------- -# Domains -# ---------------------------------------------------------------------- - -class Domain(list): - """ - Class used to control possible values for variables - - When list or tuples are used as domains, they are automatically - converted to an instance of that class. - """ - - def __init__(self, set): - """ - @param set: Set of values that the given variables may assume - @type set: set of objects comparable by equality - """ - list.__init__(self, set) - self._hidden = [] - self._states = [] - - def resetState(self): - """ - Reset to the original domain state, including all possible values - """ - self.extend(self._hidden) - del self._hidden[:] - del self._states[:] - - def pushState(self): - """ - Save current domain state - - Variables hidden after that call are restored when that state - is popped from the stack. - """ - self._states.append(len(self)) - - def popState(self): - """ - Restore domain state from the top of the stack - - Variables hidden since the last popped state are then available - again. - """ - diff = self._states.pop()-len(self) - if diff: - self.extend(self._hidden[-diff:]) - del self._hidden[-diff:] - - def hideValue(self, value): - """ - Hide the given value from the domain - - After that call the given value won't be seen as a possible value - on that domain anymore. The hidden value will be restored when the - previous saved state is popped. - - @param value: Object currently available in the domain - """ - list.remove(self, value) - self._hidden.append(value) - -# ---------------------------------------------------------------------- -# Constraints -# ---------------------------------------------------------------------- - -class Constraint(object): - """ - Abstract base class for constraints - """ - - def __call__(self, variables, domains, assignments, forwardcheck=False): - """ - Perform the constraint checking - - If the forwardcheck parameter is not false, besides telling if - the constraint is currently broken or not, the constraint - implementation may choose to hide values from the domains of - unassigned variables to prevent them from being used, and thus - prune the search space. - - @param variables: Variables affected by that constraint, in the - same order provided by the user - @type variables: sequence - @param domains: Dictionary mapping variables to their domains - @type domains: dict - @param assignments: Dictionary mapping assigned variables to their - current assumed value - @type assignments: dict - @param forwardcheck: Boolean value stating whether forward checking - should be performed or not - @return: Boolean value stating if this constraint is currently - broken or not - @rtype: bool - """#""" - return True - - def preProcess(self, variables, domains, constraints, vconstraints): - """ - Preprocess variable domains - - This method is called before starting to look for solutions, - and is used to prune domains with specific constraint logic - when possible. For instance, any constraints with a single - variable may be applied on all possible values and removed, - since they may act on individual values even without further - knowledge about other assignments. - - @param variables: Variables affected by that constraint, in the - same order provided by the user - @type variables: sequence - @param domains: Dictionary mapping variables to their domains - @type domains: dict - @param constraints: List of pairs of (constraint, variables) - @type constraints: list - @param vconstraints: Dictionary mapping variables to a list of - constraints affecting the given variables. - @type vconstraints: dict - """#""" - if len(variables) == 1: - variable = variables[0] - domain = domains[variable] - for value in domain[:]: - if not self(variables, domains, {variable: value}): - domain.remove(value) - constraints.remove((self, variables)) - vconstraints[variable].remove((self, variables)) - - def forwardCheck(self, variables, domains, assignments, - _unassigned=Unassigned): - """ - Helper method for generic forward checking - - Currently, this method acts only when there's a single - unassigned variable. - - @param variables: Variables affected by that constraint, in the - same order provided by the user - @type variables: sequence - @param domains: Dictionary mapping variables to their domains - @type domains: dict - @param assignments: Dictionary mapping assigned variables to their - current assumed value - @type assignments: dict - @return: Boolean value stating if this constraint is currently - broken or not - @rtype: bool - """#""" - unassignedvariable = _unassigned - for variable in variables: - if variable not in assignments: - if unassignedvariable is _unassigned: - unassignedvariable = variable - else: - break - else: - if unassignedvariable is not _unassigned: - # Remove from the unassigned variable domain's all - # values which break our variable's constraints. - domain = domains[unassignedvariable] - if domain: - for value in domain[:]: - assignments[unassignedvariable] = value - if not self(variables, domains, assignments): - domain.hideValue(value) - del assignments[unassignedvariable] - if not domain: - return False - return True - -class FunctionConstraint(Constraint): - """ - Constraint which wraps a function defining the constraint logic - - Examples: - - >>> problem = Problem() - >>> problem.addVariables(["a", "b"], [1, 2]) - >>> def func(a, b): - ... return b > a - >>> problem.addConstraint(func, ["a", "b"]) - >>> problem.getSolution() - {'a': 1, 'b': 2} - - >>> problem = Problem() - >>> problem.addVariables(["a", "b"], [1, 2]) - >>> def func(a, b): - ... return b > a - >>> problem.addConstraint(FunctionConstraint(func), ["a", "b"]) - >>> problem.getSolution() - {'a': 1, 'b': 2} - """#""" - - def __init__(self, func, assigned=True): - """ - @param func: Function wrapped and queried for constraint logic - @type func: callable object - @param assigned: Whether the function may receive unassigned - variables or not - @type assigned: bool - """ - self._func = func - self._assigned = assigned - - def __call__(self, variables, domains, assignments, forwardcheck=False, - _unassigned=Unassigned): - parms = [assignments.get(x, _unassigned) for x in variables] - missing = parms.count(_unassigned) - if missing: - return ((self._assigned or self._func(*parms)) and - (not forwardcheck or missing != 1 or - self.forwardCheck(variables, domains, assignments))) - return self._func(*parms) - -class AllDifferentConstraint(Constraint): - """ - Constraint enforcing that values of all given variables are different - - Example: - - >>> problem = Problem() - >>> problem.addVariables(["a", "b"], [1, 2]) - >>> problem.addConstraint(AllDifferentConstraint()) - >>> sorted(sorted(x.items()) for x in problem.getSolutions()) - [[('a', 1), ('b', 2)], [('a', 2), ('b', 1)]] - """#""" - - def __call__(self, variables, domains, assignments, forwardcheck=False, - _unassigned=Unassigned): - seen = {} - for variable in variables: - value = assignments.get(variable, _unassigned) - if value is not _unassigned: - if value in seen: - return False - seen[value] = True - if forwardcheck: - for variable in variables: - if variable not in assignments: - domain = domains[variable] - for value in seen: - if value in domain: - domain.hideValue(value) - if not domain: - return False - return True - -class AllEqualConstraint(Constraint): - """ - Constraint enforcing that values of all given variables are equal - - Example: - - >>> problem = Problem() - >>> problem.addVariables(["a", "b"], [1, 2]) - >>> problem.addConstraint(AllEqualConstraint()) - >>> sorted(sorted(x.items()) for x in problem.getSolutions()) - [[('a', 1), ('b', 1)], [('a', 2), ('b', 2)]] - """#""" - - def __call__(self, variables, domains, assignments, forwardcheck=False, - _unassigned=Unassigned): - singlevalue = _unassigned - for variable in variables: - value = assignments.get(variable, _unassigned) - if singlevalue is _unassigned: - singlevalue = value - elif value is not _unassigned and value != singlevalue: - return False - if forwardcheck and singlevalue is not _unassigned: - for variable in variables: - if variable not in assignments: - domain = domains[variable] - if singlevalue not in domain: - return False - for value in domain[:]: - if value != singlevalue: - domain.hideValue(value) - return True - -class MaxSumConstraint(Constraint): - """ - Constraint enforcing that values of given variables sum up to - a given amount - - Example: - - >>> problem = Problem() - >>> problem.addVariables(["a", "b"], [1, 2]) - >>> problem.addConstraint(MaxSumConstraint(3)) - >>> sorted(sorted(x.items()) for x in problem.getSolutions()) - [[('a', 1), ('b', 1)], [('a', 1), ('b', 2)], [('a', 2), ('b', 1)]] - """#""" - - def __init__(self, maxsum, multipliers=None): - """ - @param maxsum: Value to be considered as the maximum sum - @type maxsum: number - @param multipliers: If given, variable values will be multiplied by - the given factors before being summed to be checked - @type multipliers: sequence of numbers - """ - self._maxsum = maxsum - self._multipliers = multipliers - - def preProcess(self, variables, domains, constraints, vconstraints): - Constraint.preProcess(self, variables, domains, - constraints, vconstraints) - multipliers = self._multipliers - maxsum = self._maxsum - if multipliers: - for variable, multiplier in zip(variables, multipliers): - domain = domains[variable] - for value in domain[:]: - if value*multiplier > maxsum: - domain.remove(value) - else: - for variable in variables: - domain = domains[variable] - for value in domain[:]: - if value > maxsum: - domain.remove(value) - - def __call__(self, variables, domains, assignments, forwardcheck=False): - multipliers = self._multipliers - maxsum = self._maxsum - sum = 0 - if multipliers: - for variable, multiplier in zip(variables, multipliers): - if variable in assignments: - sum += assignments[variable]*multiplier - if type(sum) is float: - sum = round(sum, 10) - if sum > maxsum: - return False - if forwardcheck: - for variable, multiplier in zip(variables, multipliers): - if variable not in assignments: - domain = domains[variable] - for value in domain[:]: - if sum+value*multiplier > maxsum: - domain.hideValue(value) - if not domain: - return False - else: - for variable in variables: - if variable in assignments: - sum += assignments[variable] - if type(sum) is float: - sum = round(sum, 10) - if sum > maxsum: - return False - if forwardcheck: - for variable in variables: - if variable not in assignments: - domain = domains[variable] - for value in domain[:]: - if sum+value > maxsum: - domain.hideValue(value) - if not domain: - return False - return True - -class ExactSumConstraint(Constraint): - """ - Constraint enforcing that values of given variables sum exactly - to a given amount - - Example: - - >>> problem = Problem() - >>> problem.addVariables(["a", "b"], [1, 2]) - >>> problem.addConstraint(ExactSumConstraint(3)) - >>> sorted(sorted(x.items()) for x in problem.getSolutions()) - [[('a', 1), ('b', 2)], [('a', 2), ('b', 1)]] - """#""" - - def __init__(self, exactsum, multipliers=None): - """ - @param exactsum: Value to be considered as the exact sum - @type exactsum: number - @param multipliers: If given, variable values will be multiplied by - the given factors before being summed to be checked - @type multipliers: sequence of numbers - """ - self._exactsum = exactsum - self._multipliers = multipliers - - def preProcess(self, variables, domains, constraints, vconstraints): - Constraint.preProcess(self, variables, domains, - constraints, vconstraints) - multipliers = self._multipliers - exactsum = self._exactsum - if multipliers: - for variable, multiplier in zip(variables, multipliers): - domain = domains[variable] - for value in domain[:]: - if value*multiplier > exactsum: - domain.remove(value) - else: - for variable in variables: - domain = domains[variable] - for value in domain[:]: - if value > exactsum: - domain.remove(value) - - def __call__(self, variables, domains, assignments, forwardcheck=False): - multipliers = self._multipliers - exactsum = self._exactsum - sum = 0 - missing = False - if multipliers: - for variable, multiplier in zip(variables, multipliers): - if variable in assignments: - sum += assignments[variable]*multiplier - else: - missing = True - if type(sum) is float: - sum = round(sum, 10) - if sum > exactsum: - return False - if forwardcheck and missing: - for variable, multiplier in zip(variables, multipliers): - if variable not in assignments: - domain = domains[variable] - for value in domain[:]: - if sum+value*multiplier > exactsum: - domain.hideValue(value) - if not domain: - return False - else: - for variable in variables: - if variable in assignments: - sum += assignments[variable] - else: - missing = True - if type(sum) is float: - sum = round(sum, 10) - if sum > exactsum: - return False - if forwardcheck and missing: - for variable in variables: - if variable not in assignments: - domain = domains[variable] - for value in domain[:]: - if sum+value > exactsum: - domain.hideValue(value) - if not domain: - return False - if missing: - return sum <= exactsum - else: - return sum == exactsum - -class MinSumConstraint(Constraint): - """ - Constraint enforcing that values of given variables sum at least - to a given amount - - Example: - - >>> problem = Problem() - >>> problem.addVariables(["a", "b"], [1, 2]) - >>> problem.addConstraint(MinSumConstraint(3)) - >>> sorted(sorted(x.items()) for x in problem.getSolutions()) - [[('a', 1), ('b', 2)], [('a', 2), ('b', 1)], [('a', 2), ('b', 2)]] - """#""" - - def __init__(self, minsum, multipliers=None): - """ - @param minsum: Value to be considered as the minimum sum - @type minsum: number - @param multipliers: If given, variable values will be multiplied by - the given factors before being summed to be checked - @type multipliers: sequence of numbers - """ - self._minsum = minsum - self._multipliers = multipliers - - def __call__(self, variables, domains, assignments, forwardcheck=False): - for variable in variables: - if variable not in assignments: - return True - else: - multipliers = self._multipliers - minsum = self._minsum - sum = 0 - if multipliers: - for variable, multiplier in zip(variables, multipliers): - sum += assignments[variable]*multiplier - else: - for variable in variables: - sum += assignments[variable] - if type(sum) is float: - sum = round(sum, 10) - return sum >= minsum - -class InSetConstraint(Constraint): - """ - Constraint enforcing that values of given variables are present in - the given set - - Example: - - >>> problem = Problem() - >>> problem.addVariables(["a", "b"], [1, 2]) - >>> problem.addConstraint(InSetConstraint([1])) - >>> sorted(sorted(x.items()) for x in problem.getSolutions()) - [[('a', 1), ('b', 1)]] - """#""" - - def __init__(self, set): - """ - @param set: Set of allowed values - @type set: set - """ - self._set = set - - def __call__(self, variables, domains, assignments, forwardcheck=False): - # preProcess() will remove it. - raise RuntimeError, "Can't happen" - - def preProcess(self, variables, domains, constraints, vconstraints): - set = self._set - for variable in variables: - domain = domains[variable] - for value in domain[:]: - if value not in set: - domain.remove(value) - vconstraints[variable].remove((self, variables)) - constraints.remove((self, variables)) - -class NotInSetConstraint(Constraint): - """ - Constraint enforcing that values of given variables are not present in - the given set - - Example: - - >>> problem = Problem() - >>> problem.addVariables(["a", "b"], [1, 2]) - >>> problem.addConstraint(NotInSetConstraint([1])) - >>> sorted(sorted(x.items()) for x in problem.getSolutions()) - [[('a', 2), ('b', 2)]] - """#""" - - def __init__(self, set): - """ - @param set: Set of disallowed values - @type set: set - """ - self._set = set - - def __call__(self, variables, domains, assignments, forwardcheck=False): - # preProcess() will remove it. - raise RuntimeError, "Can't happen" - - def preProcess(self, variables, domains, constraints, vconstraints): - set = self._set - for variable in variables: - domain = domains[variable] - for value in domain[:]: - if value in set: - domain.remove(value) - vconstraints[variable].remove((self, variables)) - constraints.remove((self, variables)) - -class SomeInSetConstraint(Constraint): - """ - Constraint enforcing that at least some of the values of given - variables must be present in a given set - - Example: - - >>> problem = Problem() - >>> problem.addVariables(["a", "b"], [1, 2]) - >>> problem.addConstraint(SomeInSetConstraint([1])) - >>> sorted(sorted(x.items()) for x in problem.getSolutions()) - [[('a', 1), ('b', 1)], [('a', 1), ('b', 2)], [('a', 2), ('b', 1)]] - """#""" - - def __init__(self, set, n=1, exact=False): - """ - @param set: Set of values to be checked - @type set: set - @param n: Minimum number of assigned values that should be present - in set (default is 1) - @type n: int - @param exact: Whether the number of assigned values which are - present in set must be exactly C{n} - @type exact: bool - """ - self._set = set - self._n = n - self._exact = exact - - def __call__(self, variables, domains, assignments, forwardcheck=False): - set = self._set - missing = 0 - found = 0 - for variable in variables: - if variable in assignments: - found += assignments[variable] in set - else: - missing += 1 - if missing: - if self._exact: - if not (found <= self._n <= missing+found): - return False - else: - if self._n > missing+found: - return False - if forwardcheck and self._n-found == missing: - # All unassigned variables must be assigned to - # values in the set. - for variable in variables: - if variable not in assignments: - domain = domains[variable] - for value in domain[:]: - if value not in set: - domain.hideValue(value) - if not domain: - return False - else: - if self._exact: - if found != self._n: - return False - else: - if found < self._n: - return False - return True - -class SomeNotInSetConstraint(Constraint): - """ - Constraint enforcing that at least some of the values of given - variables must not be present in a given set - - Example: - - >>> problem = Problem() - >>> problem.addVariables(["a", "b"], [1, 2]) - >>> problem.addConstraint(SomeNotInSetConstraint([1])) - >>> sorted(sorted(x.items()) for x in problem.getSolutions()) - [[('a', 1), ('b', 2)], [('a', 2), ('b', 1)], [('a', 2), ('b', 2)]] - """#""" - - def __init__(self, set, n=1, exact=False): - """ - @param set: Set of values to be checked - @type set: set - @param n: Minimum number of assigned values that should not be present - in set (default is 1) - @type n: int - @param exact: Whether the number of assigned values which are - not present in set must be exactly C{n} - @type exact: bool - """ - self._set = set - self._n = n - self._exact = exact - - def __call__(self, variables, domains, assignments, forwardcheck=False): - set = self._set - missing = 0 - found = 0 - for variable in variables: - if variable in assignments: - found += assignments[variable] not in set - else: - missing += 1 - if missing: - if self._exact: - if not (found <= self._n <= missing+found): - return False - else: - if self._n > missing+found: - return False - if forwardcheck and self._n-found == missing: - # All unassigned variables must be assigned to - # values not in the set. - for variable in variables: - if variable not in assignments: - domain = domains[variable] - for value in domain[:]: - if value in set: - domain.hideValue(value) - if not domain: - return False - else: - if self._exact: - if found != self._n: - return False - else: - if found < self._n: - return False - return True - -if __name__ == "__main__": - import doctest - doctest.testmod() - diff --git a/csp/csp/python-constraint/trials/crosswords.py b/csp/csp/python-constraint/trials/crosswords.py deleted file mode 100755 index 5cb502f0..00000000 --- a/csp/csp/python-constraint/trials/crosswords.py +++ /dev/null @@ -1,153 +0,0 @@ -#!/usr/bin/python -from constraint import * -import random -import sys - -MINLEN = 3 - -def main(puzzle, lines): - puzzle = puzzle.rstrip().splitlines() - while puzzle and not puzzle[0]: - del puzzle[0] - - # Extract horizontal words - horizontal = [] - word = [] - predefined = {} - for row in range(len(puzzle)): - for col in range(len(puzzle[row])): - char = puzzle[row][col] - if not char.isspace(): - word.append((row, col)) - if char != "#": - predefined[row, col] = char - elif word: - if len(word) > MINLEN: - horizontal.append(word[:]) - del word[:] - if word: - if len(word) > MINLEN: - horizontal.append(word[:]) - del word[:] - - # Extract vertical words - vertical = [] - validcol = True - col = 0 - while validcol: - validcol = False - for row in range(len(puzzle)): - if col >= len(puzzle[row]): - if word: - if len(word) > MINLEN: - vertical.append(word[:]) - del word[:] - else: - validcol = True - char = puzzle[row][col] - if not char.isspace(): - word.append((row, col)) - if char != "#": - predefined[row, col] = char - elif word: - if len(word) > MINLEN: - vertical.append(word[:]) - del word[:] - if word: - if len(word) > MINLEN: - vertical.append(word[:]) - del word[:] - col += 1 - - hnames = ["h%d" % i for i in range(len(horizontal))] - vnames = ["v%d" % i for i in range(len(vertical))] - - #problem = Problem(MinConflictsSolver()) - problem = Problem() - - for hi, hword in enumerate(horizontal): - for vi, vword in enumerate(vertical): - for hchar in hword: - if hchar in vword: - hci = hword.index(hchar) - vci = vword.index(hchar) - problem.addConstraint(lambda hw, vw, hci=hci, vci=vci: - hw[hci] == vw[vci], - ("h%d" % hi, "v%d" % vi)) - - for char, letter in predefined.items(): - for hi, hword in enumerate(horizontal): - if char in hword: - hci = hword.index(char) - problem.addConstraint(lambda hw, hci=hci, letter=letter: - hw[hci] == letter, ("h%d" % hi,)) - for vi, vword in enumerate(vertical): - if char in vword: - vci = vword.index(char) - problem.addConstraint(lambda vw, vci=vci, letter=letter: - vw[vci] == letter, ("v%d" % vi,)) - - wordsbylen = {} - for hword in horizontal: - wordsbylen[len(hword)] = [] - for vword in vertical: - wordsbylen[len(vword)] = [] - - for line in lines: - line = line.strip() - l = len(line) - if l in wordsbylen: - wordsbylen[l].append(line.upper()) - - for hi, hword in enumerate(horizontal): - words = wordsbylen[len(hword)] - random.shuffle(words) - problem.addVariable("h%d" % hi, words) - for vi, vword in enumerate(vertical): - words = wordsbylen[len(vword)] - random.shuffle(words) - problem.addVariable("v%d" % vi, words) - - problem.addConstraint(AllDifferentConstraint()) - - solution = problem.getSolution() - if not solution: - print "No solution found!" - - maxcol = 0 - maxrow = 0 - for hword in horizontal: - for row, col in hword: - if row > maxrow: - maxrow = row - if col > maxcol: - maxcol = col - for vword in vertical: - for row, col in vword: - if row > maxrow: - maxrow = row - if col > maxcol: - maxcol = col - - matrix = [] - for row in range(maxrow+1): - matrix.append([" "]*(maxcol+1)) - - for variable in solution: - if variable[0] == "v": - word = vertical[int(variable[1:])] - else: - word = horizontal[int(variable[1:])] - for (row, col), char in zip(word, solution[variable]): - matrix[row][col] = char - - for row in range(maxrow+1): - for col in range(maxcol+1): - sys.stdout.write(matrix[row][col]) - sys.stdout.write("\n") - -if __name__ == "__main__": - if len(sys.argv) != 3: - sys.exit("Usage: crosswords.py ") - main(open(sys.argv[1]).read(), open(sys.argv[2])) - diff --git a/csp/csp/python-constraint/trials/einstein.py b/csp/csp/python-constraint/trials/einstein.py deleted file mode 100755 index ede13f88..00000000 --- a/csp/csp/python-constraint/trials/einstein.py +++ /dev/null @@ -1,201 +0,0 @@ -#!/usr/bin/python -# -# ALBERT EINSTEIN'S RIDDLE -# -# ARE YOU IN THE TOP 2% OF INTELLIGENT PEOPLE IN THE WORLD? -# SOLVE THE RIDDLE AND FIND OUT. -# -# There are no tricks, just pure logic, so good luck and don't give up. -# -# 1. In a street there are five houses, painted five different colours. -# 2. In each house lives a person of different nationality -# 3. These five homeowners each drink a different kind of beverage, smoke -# different brand of cigar and keep a different pet. -# -# THE QUESTION: WHO OWNS THE FISH? -# -# HINTS -# -# 1. The Brit lives in a red house. -# 2. The Swede keeps dogs as pets. -# 3. The Dane drinks tea. -# 4. The Green house is on the left of the White house. -# 5. The owner of the Green house drinks coffee. -# 6. The person who smokes Pall Mall rears birds. -# 7. The owner of the Yellow house smokes Dunhill. -# 8. The man living in the centre house drinks milk. -# 9. The Norwegian lives in the first house. -# 10. The man who smokes Blends lives next to the one who keeps cats. -# 11. The man who keeps horses lives next to the man who smokes Dunhill. -# 12. The man who smokes Blue Master drinks beer. -# 13. The German smokes Prince. -# 14. The Norwegian lives next to the blue house. -# 15. The man who smokes Blends has a neighbour who drinks water. -# -# ALBERT EINSTEIN WROTE THIS RIDDLE EARLY DURING THE 19th CENTURY. HE -# SAID THAT 98% OF THE WORLD POPULATION WOULD NOT BE ABLE TO SOLVE IT. - -from constraint import * - -# Check http://www.csc.fi/oppaat/f95/python/talot.py - -def main(): - problem = Problem() - for i in range(1,6): - problem.addVariable("color%d" % i, - ["red", "white", "green", "yellow", "blue"]) - problem.addVariable("nationality%d" % i, - ["brit", "swede", "dane", "norwegian", "german"]) - problem.addVariable("drink%d" % i, - ["tea", "coffee", "milk", "beer", "water"]) - problem.addVariable("smoke%d" % i, - ["pallmall", "dunhill", "blends", - "bluemaster", "prince"]) - problem.addVariable("pet%d" % i, - ["dogs", "birds", "cats", "horses", "fish"]) - - problem.addConstraint(AllDifferentConstraint(), - ["color%d" % i for i in range(1,6)]) - problem.addConstraint(AllDifferentConstraint(), - ["nationality%d" % i for i in range(1,6)]) - problem.addConstraint(AllDifferentConstraint(), - ["drink%d" % i for i in range(1,6)]) - problem.addConstraint(AllDifferentConstraint(), - ["smoke%d" % i for i in range(1,6)]) - problem.addConstraint(AllDifferentConstraint(), - ["pet%d" % i for i in range(1,6)]) - - for i in range(1,6): - - # Hint 1 - problem.addConstraint(lambda nationality, color: - nationality != "brit" or color == "red", - ("nationality%d" % i, "color%d" % i)) - - # Hint 2 - problem.addConstraint(lambda nationality, pet: - nationality != "swede" or pet == "dogs", - ("nationality%d" % i, "pet%d" % i)) - - # Hint 3 - problem.addConstraint(lambda nationality, drink: - nationality != "dane" or drink == "tea", - ("nationality%d" % i, "drink%d" % i)) - - # Hint 4 - if i < 5: - problem.addConstraint(lambda colora, colorb: - colora != "green" or colorb == "white", - ("color%d" % i, "color%d" % (i+1))) - else: - problem.addConstraint(lambda color: color != "green", - ("color%d" % i,)) - - # Hint 5 - problem.addConstraint(lambda color, drink: - color != "green" or drink == "coffee", - ("color%d" % i, "drink%d" % i)) - - # Hint 6 - problem.addConstraint(lambda smoke, pet: - smoke != "pallmall" or pet == "birds", - ("smoke%d" % i, "pet%d" % i)) - - # Hint 7 - problem.addConstraint(lambda color, smoke: - color != "yellow" or smoke == "dunhill", - ("color%d" % i, "smoke%d" % i)) - - # Hint 8 - if i == 3: - problem.addConstraint(lambda drink: drink == "milk", - ("drink%d" % i,)) - - # Hint 9 - if i == 1: - problem.addConstraint(lambda nationality: - nationality == "norwegian", - ("nationality%d" % i,)) - - # Hint 10 - if 1 < i < 5: - problem.addConstraint(lambda smoke, peta, petb: - smoke != "blends" or peta == "cats" or - petb == "cats", - ("smoke%d" % i, "pet%d" % (i-1), - "pet%d" % (i+1))) - else: - problem.addConstraint(lambda smoke, pet: - smoke != "blends" or pet == "cats", - ("smoke%d" % i, - "pet%d" % (i == 1 and 2 or 4))) - - # Hint 11 - if 1 < i < 5: - problem.addConstraint(lambda pet, smokea, smokeb: - pet != "horses" or smokea == "dunhill" or - smokeb == "dunhill", - ("pet%d" % i, "smoke%d" % (i-1), - "smoke%d" % (i+1))) - else: - problem.addConstraint(lambda pet, smoke: - pet != "horses" or smoke == "dunhill", - ("pet%d" % i, - "smoke%d" % (i == 1 and 2 or 4))) - - # Hint 12 - problem.addConstraint(lambda smoke, drink: - smoke != "bluemaster" or drink == "beer", - ("smoke%d" % i, "drink%d" % i)) - - # Hint 13 - problem.addConstraint(lambda nationality, smoke: - nationality != "german" or smoke == "prince", - ("nationality%d" % i, "smoke%d" % i)) - - # Hint 14 - if 1 < i < 5: - problem.addConstraint(lambda nationality, colora, colorb: - nationality != "norwegian" or - colora == "blue" or colorb == "blue", - ("nationality%d" % i, "color%d" % (i-1), - "color%d" % (i+1))) - else: - problem.addConstraint(lambda nationality, color: - nationality != "norwegian" or - color == "blue", - ("nationality%d" % i, - "color%d" % (i == 1 and 2 or 4))) - - # Hint 15 - if 1 < i < 5: - problem.addConstraint(lambda smoke, drinka, drinkb: - smoke != "blends" or - drinka == "water" or drinkb == "water", - ("smoke%d" % i, "drink%d" % (i-1), - "drink%d" % (i+1))) - else: - problem.addConstraint(lambda smoke, drink: - smoke != "blends" or drink == "water", - ("smoke%d" % i, - "drink%d" % (i == 1 and 2 or 4))) - - solutions = problem.getSolutions() - print "Found %d solution(s)!" % len(solutions) - print - for solution in solutions: - showSolution(solution) - -def showSolution(solution): - for i in range(1,6): - print "House %d" % i - print "--------" - print "Nationality: %s" % solution["nationality%d" % i] - print "Color: %s" % solution["color%d" % i] - print "Drink: %s" % solution["drink%d" % i] - print "Smoke: %s" % solution["smoke%d" % i] - print "Pet: %s" % solution["pet%d" % i] - print - -if __name__ == "__main__": - main() diff --git a/csp/csp/python-constraint/trials/einstein2.py b/csp/csp/python-constraint/trials/einstein2.py deleted file mode 100755 index d1f7b86d..00000000 --- a/csp/csp/python-constraint/trials/einstein2.py +++ /dev/null @@ -1,190 +0,0 @@ -#!/usr/bin/python -# -# ALBERT EINSTEIN'S RIDDLE -# -# ARE YOU IN THE TOP 2% OF INTELLIGENT PEOPLE IN THE WORLD? -# SOLVE THE RIDDLE AND FIND OUT. -# -# There are no tricks, just pure logic, so good luck and don't give up. -# -# 1. In a street there are five houses, painted five different colours. -# 2. In each house lives a person of different nationality -# 3. These five homeowners each drink a different kind of beverage, smoke -# different brand of cigar and keep a different pet. -# -# THE QUESTION: WHO OWNS THE zebra? -# -# HINTS -# -# 1. The englishman lives in a red house. -# 2. The spaniard keeps dogs as pets. -# 5. The owner of the Green house drinks coffee. -# 3. The ukrainian drinks tea. -# 4. The Green house is on the left of the ivory house. -# 6. The person who smokes oldgold rears snails. -# 7. The owner of the Yellow house smokes kools. -# 8. The man living in the centre house drinks milk. -# 9. The Norwegian lives in the first house. -# 10. The man who smokes chesterfields lives next to the one who keeps foxes. -# 11. The man who keeps horses lives next to the man who smokes kools. -# 12. The man who smokes luckystrike drinks orangejuice. -# 13. The japanese smokes parliaments. -# 14. The Norwegian lives next to the blue house. -# 15. The man who smokes chesterfields has a neighbour who drinks water. -# -# ALBERT EINSTEIN WROTE THIS RIDDLE EARLY DURING THE 19th CENTURY. HE -# SAID THAT 98% OF THE WORLD POPULATION WOULD NOT BE ABLE TO SOLVE IT. - -from constraint import * - -# Check http://www.csc.fi/oppaat/f95/python/talot.py - -def main(): - problem = Problem() - for i in range(1,6): - problem.addVariable("color%d" % i, - ["red", "ivory", "green", "yellow", "blue"]) - problem.addVariable("nationality%d" % i, - ["englishman", "spaniard", "ukrainian", "norwegian", "japanese"]) - problem.addVariable("drink%d" % i, - ["tea", "coffee", "milk", "orangejuice", "water"]) - problem.addVariable("smoke%d" % i, - ["oldgold", "kools", "chesterfields", - "luckystrike", "parliaments"]) - problem.addVariable("pet%d" % i, - ["dogs", "snails", "foxes", "horses", "zebra"]) - - problem.addConstraint(AllDifferentConstraint(), - ["color%d" % i for i in range(1,6)]) - problem.addConstraint(AllDifferentConstraint(), - ["nationality%d" % i for i in range(1,6)]) - problem.addConstraint(AllDifferentConstraint(), - ["drink%d" % i for i in range(1,6)]) - problem.addConstraint(AllDifferentConstraint(), - ["smoke%d" % i for i in range(1,6)]) - problem.addConstraint(AllDifferentConstraint(), - ["pet%d" % i for i in range(1,6)]) - - for i in range(1,6): - - # Hint 1 - problem.addConstraint(lambda nationality, color: - nationality != "englishman" or color == "red", - ("nationality%d" % i, "color%d" % i)) - - # Hint 2 - problem.addConstraint(lambda nationality, pet: - nationality != "spaniard" or pet == "dogs", - ("nationality%d" % i, "pet%d" % i)) - - # Hint 3 - problem.addConstraint(lambda nationality, drink: - nationality != "ukrainian" or drink == "tea", - ("nationality%d" % i, "drink%d" % i)) - - # Hint 4 - if i < 5: - problem.addConstraint(lambda colora, colorb: - colora != "green" or colorb == "ivory", - ("color%d" % i, "color%d" % (i+1))) - else: - problem.addConstraint(lambda color: color != "green", - ("color%d" % i,)) - - # Hint 5 - problem.addConstraint(lambda color, drink: - color != "green" or drink == "coffee", - ("color%d" % i, "drink%d" % i)) - - # Hint 6 - problem.addConstraint(lambda smoke, pet: - smoke != "oldgold" or pet == "snails", - ("smoke%d" % i, "pet%d" % i)) - - # Hint 7 - problem.addConstraint(lambda color, smoke: - color != "yellow" or smoke == "kools", - ("color%d" % i, "smoke%d" % i)) - - # Hint 8 - if i == 3: - problem.addConstraint(lambda drink: drink == "milk", - ("drink%d" % i,)) - - # Hint 9 - if i == 1: - problem.addConstraint(lambda nationality: - nationality == "norwegian", - ("nationality%d" % i,)) - - # Hint 10 - if 1 < i < 5: - problem.addConstraint(lambda smoke, peta, petb: - smoke != "chesterfields" or peta == "foxes" or - petb == "foxes", - ("smoke%d" % i, "pet%d" % (i-1), - "pet%d" % (i+1))) - else: - problem.addConstraint(lambda smoke, pet: - smoke != "chesterfields" or pet == "foxes", - ("smoke%d" % i, - "pet%d" % (i == 1 and 2 or 4))) - - # Hint 11 - if 1 < i < 5: - problem.addConstraint(lambda pet, smokea, smokeb: - pet != "horses" or smokea == "kools" or - smokeb == "kools", - ("pet%d" % i, "smoke%d" % (i-1), - "smoke%d" % (i+1))) - else: - problem.addConstraint(lambda pet, smoke: - pet != "horses" or smoke == "kools", - ("pet%d" % i, - "smoke%d" % (i == 1 and 2 or 4))) - - # Hint 12 - problem.addConstraint(lambda smoke, drink: - smoke != "luckystrike" or drink == "orangejuice", - ("smoke%d" % i, "drink%d" % i)) - - # Hint 13 - problem.addConstraint(lambda nationality, smoke: - nationality != "japanese" or smoke == "parliaments", - ("nationality%d" % i, "smoke%d" % i)) - - # Hint 14 - if 1 < i < 5: - problem.addConstraint(lambda nationality, colora, colorb: - nationality != "norwegian" or - colora == "blue" or colorb == "blue", - ("nationality%d" % i, "color%d" % (i-1), - "color%d" % (i+1))) - else: - problem.addConstraint(lambda nationality, color: - nationality != "norwegian" or - color == "blue", - ("nationality%d" % i, - "color%d" % (i == 1 and 2 or 4))) - - - - solutions = problem.getSolutions() - print "Found %d solution(s)!" % len(solutions) - print - for solution in solutions: - showSolution(solution) - -def showSolution(solution): - for i in range(1,6): - print "House %d" % i - print "--------" - print "Nationality: %s" % solution["nationality%d" % i] - print "Color: %s" % solution["color%d" % i] - print "Drink: %s" % solution["drink%d" % i] - print "Smoke: %s" % solution["smoke%d" % i] - print "Pet: %s" % solution["pet%d" % i] - print - -if __name__ == "__main__": - main() diff --git a/csp/csp/python-constraint/trials/large.mask b/csp/csp/python-constraint/trials/large.mask deleted file mode 100644 index ba5364c8..00000000 --- a/csp/csp/python-constraint/trials/large.mask +++ /dev/null @@ -1,27 +0,0 @@ - -# ######## # -# # # # # -######## # # -# # # # # -# # ######## -# # # # # # -######## # # -# # # # # # - # # # -######## # # - # # # # # - # ######## - # # # # # - # # ######## - # # # # # # - # # ######## - # # # # -######## # # - # # # # # # - # # # # # # - ######## # # - # # # # - # ######## - # # # # -######## # # - diff --git a/csp/csp/python-constraint/trials/medium.mask b/csp/csp/python-constraint/trials/medium.mask deleted file mode 100644 index 3332a097..00000000 --- a/csp/csp/python-constraint/trials/medium.mask +++ /dev/null @@ -1,19 +0,0 @@ - - # -######### -# # # -# # ###### -# # # -# # # # -# # # # -######## # -# # # - # # # - ######### - # # # - ######### - # # # - # # -####### - # - diff --git a/csp/csp/python-constraint/trials/python.mask b/csp/csp/python-constraint/trials/python.mask deleted file mode 100644 index fe5a5767..00000000 --- a/csp/csp/python-constraint/trials/python.mask +++ /dev/null @@ -1,8 +0,0 @@ - P - Y -####T#### - # H # - # O # -####N # - # # -######### diff --git a/csp/csp/python-constraint/trials/queens.py b/csp/csp/python-constraint/trials/queens.py deleted file mode 100755 index deac7131..00000000 --- a/csp/csp/python-constraint/trials/queens.py +++ /dev/null @@ -1,47 +0,0 @@ -#!/usr/bin/python -# -# http://mathworld.wolfram.com/QueensProblem.html -# -from constraint import * -import sys - -def main(show=False): - problem = Problem() - size = 8 - cols = range(size) - rows = range(size) - problem.addVariables(cols, rows) - for col1 in cols: - for col2 in cols: - if col1 < col2: - problem.addConstraint(lambda row1, row2, col1=col1, col2=col2: - abs(row1-row2) != abs(col1-col2) and - row1 != row2, (col1, col2)) - solutions = problem.getSolutions() - print "Found %d solution(s)!" % len(solutions) - if show: - for solution in solutions: - showSolution(solution, size) - -def showSolution(solution, size): - sys.stdout.write(" %s \n" % ("-"*((size*4)-1))) - for i in range(size): - sys.stdout.write(" |") - for j in range(size): - if solution[j] == i: - sys.stdout.write(" %d |" % j) - else: - sys.stdout.write(" |") - sys.stdout.write("\n") - if i != size-1: - sys.stdout.write(" |%s|\n" % ("-"*((size*4)-1))) - sys.stdout.write(" %s \n" % ("-"*((size*4)-1))) - -if __name__ == "__main__": - show = False - if len(sys.argv) == 2 and sys.argv[1] == "-s": - show = True - elif len(sys.argv) != 1: - sys.exit("Usage: queens.py [-s]") - main(show) - diff --git a/csp/csp/python-constraint/trials/rooks.py b/csp/csp/python-constraint/trials/rooks.py deleted file mode 100755 index 14f88b1e..00000000 --- a/csp/csp/python-constraint/trials/rooks.py +++ /dev/null @@ -1,49 +0,0 @@ -#!/usr/bin/python -# -# http://mathworld.wolfram.com/RooksProblem.html -# -from constraint import * -import sys - -def factorial(x): return x == 1 or factorial(x-1)*x - -def main(show=False): - problem = Problem() - size = 8 - cols = range(size) - rows = range(size) - problem.addVariables(cols, rows) - for col1 in cols: - for col2 in cols: - if col1 < col2: - problem.addConstraint(lambda row1, row2: row1 != row2, - (col1, col2)) - solutions = problem.getSolutions() - print "Found %d solution(s)!" % len(solutions) - assert len(solutions) == factorial(size) - if show: - for solution in solutions: - showSolution(solution, size) - -def showSolution(solution, size): - sys.stdout.write(" %s \n" % ("-"*((size*4)-1))) - for i in range(size): - sys.stdout.write(" |") - for j in range(size): - if solution[j] == i: - sys.stdout.write(" %d |" % j) - else: - sys.stdout.write(" |") - sys.stdout.write("\n") - if i != size-1: - sys.stdout.write(" |%s|\n" % ("-"*((size*4)-1))) - sys.stdout.write(" %s \n" % ("-"*((size*4)-1))) - -if __name__ == "__main__": - show = False - if len(sys.argv) == 2 and sys.argv[1] == "-s": - show = True - elif len(sys.argv) != 1: - sys.exit("Usage: rooks.py [-s]") - main(show) - diff --git a/csp/csp/python-constraint/trials/seisseisdoze.py b/csp/csp/python-constraint/trials/seisseisdoze.py deleted file mode 100755 index b17956db..00000000 --- a/csp/csp/python-constraint/trials/seisseisdoze.py +++ /dev/null @@ -1,32 +0,0 @@ -#!/usr/bin/python -# -# Assign equal values to equal letters, and different values to -# different letters, in a way that satisfies the following sum: -# -# SEIS -# + SEIS -# ------ -# DOZE -# -from constraint import * - -def main(): - problem = Problem() - problem.addVariables("seidoz", range(10)) - problem.addConstraint(lambda s, e: (2*s)%10 == e, "se") - problem.addConstraint(lambda i, s, z, e: ((10*2*i)+(2*s))%100 == z*10+e, - "isze") - problem.addConstraint(lambda s, e, i, d, o, z: - 2*(s*1000+e*100+i*10+s) == d*1000+o*100+z*10+e, - "seidoz") - problem.addConstraint(lambda s: s != 0, "s") - problem.addConstraint(lambda d: d != 0, "d") - problem.addConstraint(AllDifferentConstraint()) - print "SEIS+SEIS=DOZE" - for s in problem.getSolutions(): - print ("%(s)d%(e)d%(i)d%(s)s+%(s)d%(e)d%(i)d%(s)d=" - "%(d)d%(o)d%(z)d%(e)d") % s - -if __name__ == "__main__": - main() - diff --git a/csp/csp/python-constraint/trials/sendmoremoney.py b/csp/csp/python-constraint/trials/sendmoremoney.py deleted file mode 100755 index 894b0cd5..00000000 --- a/csp/csp/python-constraint/trials/sendmoremoney.py +++ /dev/null @@ -1,34 +0,0 @@ -#!/usr/bin/python -# -# Assign equal values to equal letters, and different values to -# different letters, in a way that satisfies the following sum: -# -# SEND -# + MORE -# ------ -# MONEY -# -from constraint import * - -def main(): - problem = Problem() - problem.addVariables("sendmory", range(10)) - problem.addConstraint(lambda d, e, y: (d+e)%10 == y, "dey") - problem.addConstraint(lambda n, d, r, e, y: (n*10+d+r*10+e)%100 == e*10+y, - "ndrey") - problem.addConstraint(lambda e, n, d, o, r, y: - (e*100+n*10+d+o*100+r*10+e)%1000 == n*100+e*10+y, - "endory") - problem.addConstraint(lambda s, e, n, d, m, o, r, y: - 1000*s+100*e+10*n+d + 1000*m+100*o+10*r+e == - 10000*m+1000*o+100*n+10*e+y, "sendmory") - problem.addConstraint(NotInSetConstraint([0]), "sm") - problem.addConstraint(AllDifferentConstraint()) - print "SEND+MORE=MONEY" - for s in problem.getSolutions(): - print "%(s)d%(e)d%(n)d%(d)d+" \ - "%(m)d%(o)d%(r)d%(e)d=" \ - "%(m)d%(o)d%(n)d%(e)d%(y)d" % s - -if __name__ == "__main__": - main() diff --git a/csp/csp/python-constraint/trials/small.mask b/csp/csp/python-constraint/trials/small.mask deleted file mode 100644 index 0e43ff78..00000000 --- a/csp/csp/python-constraint/trials/small.mask +++ /dev/null @@ -1,8 +0,0 @@ - # - # -######### - # # - # # # # -##### # # - # # # -######### diff --git a/csp/csp/python-constraint/trials/studentdesks.py b/csp/csp/python-constraint/trials/studentdesks.py deleted file mode 100755 index e8d47792..00000000 --- a/csp/csp/python-constraint/trials/studentdesks.py +++ /dev/null @@ -1,39 +0,0 @@ -#!/usr/bin/python -# -# http://home.chello.no/~dudley/ -# -from constraint import * -import sys - -STUDENTDESKS = [[ 0, 1, 0, 0, 0, 0], - [ 0, 2, 3, 4, 5, 6], - [ 0, 7, 8, 9, 10, 0], - [ 0, 11, 12, 13, 14, 0], - [ 15, 16, 17, 18, 19, 0], - [ 0, 0, 0, 0, 20, 0]] - -def main(): - problem = Problem() - problem.addVariables(range(1,21), ["A", "B", "C", "D", "E"]) - problem.addConstraint(SomeInSetConstraint(["A"], 4, True)) - problem.addConstraint(SomeInSetConstraint(["B"], 4, True)) - problem.addConstraint(SomeInSetConstraint(["C"], 4, True)) - problem.addConstraint(SomeInSetConstraint(["D"], 4, True)) - problem.addConstraint(SomeInSetConstraint(["E"], 4, True)) - for row in range(len(STUDENTDESKS)-1): - for col in range(len(STUDENTDESKS[row])-1): - lst = [STUDENTDESKS[row][col], STUDENTDESKS[row][col+1], - STUDENTDESKS[row+1][col], STUDENTDESKS[row+1][col+1]] - lst = [x for x in lst if x] - problem.addConstraint(AllDifferentConstraint(), lst) - showSolution(problem.getSolution()) - -def showSolution(solution): - for row in range(len(STUDENTDESKS)): - for col in range(len(STUDENTDESKS[row])): - id = STUDENTDESKS[row][col] - sys.stdout.write(" %s" % (id and solution[id] or " ")) - sys.stdout.write("\n") - -if __name__ == "__main__": - main() diff --git a/csp/csp/python-constraint/trials/sudoku.py b/csp/csp/python-constraint/trials/sudoku.py deleted file mode 100644 index e79698ea..00000000 --- a/csp/csp/python-constraint/trials/sudoku.py +++ /dev/null @@ -1,61 +0,0 @@ -# -# Sudoku puzzle solver by by Luigi Poderico (www.poderico.it). -# -from constraint import * - -problem = Problem() - -# Define the variables: 9 rows of 9 variables rangin in 1...9 -for i in range(1, 10) : - problem.addVariables(range(i*10+1, i*10+10), range(1, 10)) - -# Each row has different values -for i in range(1, 10) : - problem.addConstraint(AllDifferentConstraint(), range(i*10+1, i*10+10)) - -# Each colum has different values -for i in range(1, 10) : - problem.addConstraint(AllDifferentConstraint(), range(10+i, 100+i, 10)) - -# Each 3x3 box has different values -problem.addConstraint(AllDifferentConstraint(), [11,12,13,21,22,23,31,32,33]) -problem.addConstraint(AllDifferentConstraint(), [41,42,43,51,52,53,61,62,63]) -problem.addConstraint(AllDifferentConstraint(), [71,72,73,81,82,83,91,92,93]) - -problem.addConstraint(AllDifferentConstraint(), [14,15,16,24,25,26,34,35,36]) -problem.addConstraint(AllDifferentConstraint(), [44,45,46,54,55,56,64,65,66]) -problem.addConstraint(AllDifferentConstraint(), [74,75,76,84,85,86,94,95,96]) - -problem.addConstraint(AllDifferentConstraint(), [17,18,19,27,28,29,37,38,39]) -problem.addConstraint(AllDifferentConstraint(), [47,48,49,57,58,59,67,68,69]) -problem.addConstraint(AllDifferentConstraint(), [77,78,79,87,88,89,97,98,99]) - -# Some value is given. -initValue = [[0, 9, 0, 7, 0, 0, 8, 6, 0], - [0, 3, 1, 0, 0, 5, 0, 2, 0], - [8, 0, 6, 0, 0, 0, 0, 0, 0], - [0, 0, 7, 0, 5, 0, 0, 0, 6], - [0, 0, 0, 3, 0, 7, 0, 0, 0], - [5, 0, 0, 0, 1, 0, 7, 0, 0], - [0, 0, 0, 0, 0, 0, 1, 0, 9], - [0, 2, 0, 6, 0, 0, 0, 5, 0], - [0, 5, 4, 0, 0, 8, 0, 7, 0]] - -for i in range(1, 10) : - for j in range(1, 10): - if initValue[i-1][j-1] !=0 : - problem.addConstraint(lambda var, val=initValue[i-1][j-1]: - var==val, (i*10+j,)) - -# Get the solutions. -solutions = problem.getSolutions() - -# Print the solutions -for solution in solutions: - for i in range(1, 10): - for j in range(1, 10): - index = i*10+j - print solution[index], - print - print - diff --git a/csp/csp/python-constraint/trials/twotwofour.py b/csp/csp/python-constraint/trials/twotwofour.py deleted file mode 100755 index b9e70d6a..00000000 --- a/csp/csp/python-constraint/trials/twotwofour.py +++ /dev/null @@ -1,28 +0,0 @@ -#!/usr/bin/python -# -# Assign equal values to equal letters, and different values to -# different letters, in a way that satisfies the following sum: -# -# TWO -# + TWO -# ----- -# FOUR -# -from constraint import * - -def main(): - problem = Problem() - problem.addVariables("twofur", range(10)) - problem.addConstraint(lambda o, r: (2*o)%10 == r, "or") - problem.addConstraint(lambda w, o, u, r: ((10*2*w)+(2*o))%100 == u*10+r, - "wour") - problem.addConstraint(lambda t, w, o, f, u, r: - 2*(t*100+w*10+o) == f*1000+o*100+u*10+r, "twofur") - problem.addConstraint(NotInSetConstraint([0]), "ft") - problem.addConstraint(AllDifferentConstraint()) - print "TWO+TWO=FOUR" - for s in problem.getSolutions(): - print "%(t)d%(w)d%(o)d+%(t)d%(w)d%(o)d=%(f)d%(o)d%(u)d%(r)d" % s - -if __name__ == "__main__": - main() diff --git a/csp/csp/python-constraint/trials/xsum.py b/csp/csp/python-constraint/trials/xsum.py deleted file mode 100755 index 0f5f70b6..00000000 --- a/csp/csp/python-constraint/trials/xsum.py +++ /dev/null @@ -1,37 +0,0 @@ -#!/usr/bin/python -# -# Reorganize the following numbers in a way that each line of -# 5 numbers sum to 27. -# -# 1 6 -# 2 7 -# 3 -# 8 4 -# 9 5 -# -from constraint import * - -def main(): - problem = Problem() - problem.addVariables("abcdxefgh", range(1,10)) - problem.addConstraint(lambda a, b, c, d, x: - a < b < c < d and a+b+c+d+x == 27, "abcdx") - problem.addConstraint(lambda e, f, g, h, x: - e < f < g < h and e+f+g+h+x == 27, "efghx") - problem.addConstraint(AllDifferentConstraint()) - solutions = problem.getSolutions() - print "Found %d solutions!" % len(solutions) - showSolutions(solutions) - -def showSolutions(solutions): - for solution in solutions: - print " %d %d" % (solution["a"], solution["e"]) - print " %d %d " % (solution["b"], solution["f"]) - print " %d " % (solution["x"],) - print " %d %d " % (solution["g"], solution["c"]) - print " %d %d" % (solution["h"], solution["d"]) - print - -if __name__ == "__main__": - main() - From 5b047e72ce4aa4a48f4d2a6fc62caff79d6686c2 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Thu, 25 Oct 2018 13:03:48 -0700 Subject: [PATCH 186/246] gbye --- csp/.gitignore | 3 +++ 1 file changed, 3 insertions(+) diff --git a/csp/.gitignore b/csp/.gitignore index 1a57f7de..79e2a857 100644 --- a/csp/.gitignore +++ b/csp/.gitignore @@ -15,3 +15,6 @@ Icon # Files that might appear on external disk .Spotlight-V100 .Trashes +csp/scribblings/*.html +csp/scribblings/*.css +csp/scribblings/*.js \ No newline at end of file From a427cb0ee48d1a8d7637e7c6a8888d95d97895fc Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Thu, 25 Oct 2018 15:36:00 -0700 Subject: [PATCH 187/246] changes --- csp/csp/hacs-test-sudoku.rkt | 104 ++++++++++++++++++++++++++++++++++ csp/csp/hacs.rkt | 93 ++++++++++++++++-------------- csp/csp/scribblings/csp.scrbl | 2 + 3 files changed, 157 insertions(+), 42 deletions(-) create mode 100644 csp/csp/hacs-test-sudoku.rkt diff --git a/csp/csp/hacs-test-sudoku.rkt b/csp/csp/hacs-test-sudoku.rkt new file mode 100644 index 00000000..8031e57f --- /dev/null +++ b/csp/csp/hacs-test-sudoku.rkt @@ -0,0 +1,104 @@ +#lang debug br +(require sugar/debug "hacs.rkt") + +(define names (for/list ([i (in-range 81)]) + (string->symbol (format "c~a" i)))) + +(define (make-sudoku) + (define sudoku (make-csp)) + (add-vars! sudoku names (range 1 10)) + + (define (not= . xs) (= (length xs) (length (remove-duplicates xs =)))) + + (for ([i (in-range 9)]) + (define row-cells (for/list ([(name idx) (in-indexed names)] + #:when (= (quotient idx 9) i)) + name)) + (add-pairwise-constraint! sudoku not= row-cells) + (define col-cells (for/list ([(name idx) (in-indexed names)] + #:when (= (remainder idx 9) i)) + name)) + (add-pairwise-constraint! sudoku not= col-cells)) + + (for ([i '(0 3 6 27 30 33 54 57 60)]) + (define box-cells (for/list ([j '(0 1 2 9 10 11 18 19 20)]) + (string->symbol (format "c~a" (+ i j))))) + (add-pairwise-constraint! sudoku not= box-cells)) + + sudoku) + +(require racket/sequence) +(define (print-grid sol) + (displayln (string-join (map ~a (for/list ([row (in-slice 9 (csp->assocs sol))]) + (map cdr row))) "\n"))) + +(define (board . strs) + (define sudoku (make-sudoku)) + (define vals + (for*/list ([str strs] + [c (in-port read-char (open-input-string str))] + #:unless (memv c '(#\- #\|))) + (match (string c) + [(? string->number num) (string->number num)] + [else #f]))) + (for ([name names] + [val vals] + #:when val) + (add-constraint! sudoku (curry = val) (list name) (string->symbol (format "is-~a" val)))) + sudoku) + +;; http://jeapostrophe.github.io/2013-10-23-sudoku-post.html + +(define b1 + (board + "53 | 7 | " + "6 |195| " + " 98| | 6 " + "-----------" + "8 | 6 | 3" + "4 |8 3| 1" + "7 | 2 | 6" + "-----------" + " 6 | |28 " + " |419| 5" + " | 8 | 79")) + +;; "Hard" example +(define b2 + (board + " 7 | 2 | 5" + " 9| 87| 3" + " 6 | | 4 " + "-----------" + " | 6 | 17" + "9 4| |8 6" + "71 | 5 | " + "-----------" + " 9 | | 8 " + "5 |21 |4 " + "4 | 9 | 6 ")) + +;; "Evil" example +(define b3 + (board + " 8| | 45" + " | 8 |9 " + " 2|4 | " + "-----------" + "5 | 1|76 " + " 1 | 7 | 8 " + " 79|5 | 1" + "-----------" + " | 7|4 " + " 7| 6 | " + "65 | |3 ")) + +(current-inference forward-check) +(current-select-variable mrv-degree-hybrid) +(current-order-values shuffle) +(current-random #true) +(current-node-consistency #t) +(current-arity-reduction #t) +(time-avg 10 (solve b1 #:finish-proc print-grid)) +(time-avg 10 (solve b2 #:finish-proc print-grid)) +(time-avg 10 (solve b3 #:finish-proc print-grid)) \ No newline at end of file diff --git a/csp/csp/hacs.rkt b/csp/csp/hacs.rkt index 9ccaef66..268301c3 100644 --- a/csp/csp/hacs.rkt +++ b/csp/csp/hacs.rkt @@ -57,7 +57,7 @@ (apply add-edge! gr edge) gr)) -(struct var (name domain) #:transparent) +(struct var (name domain) #:transparent #:mutable) (define domain var-domain) (struct checked-variable var (history) #:transparent) @@ -246,13 +246,14 @@ (define/contract (state-count csp) (csp? . -> . natural?) - (for/product ([var (in-vars csp)]) - (domain-length var))) + (for/product ([vr (in-vars csp)]) + (domain-length vr))) (define/contract (mrv-degree-hybrid prob) (csp? . -> . (or/c #f var?)) (match (unassigned-vars prob) [(? empty?) #false] + [(cons (? singleton-var? uvar) _) uvar] [uvars ;; minimum remaining values (MRV) rule (define mrv-arg (argmin domain-length uvars)) @@ -476,6 +477,12 @@ (define (history->constraint hst) (constraint (map car hst) (make-hist-proc hst))) +(define/contract (assign-singletons prob) + (csp? . -> . csp?) + (for/fold ([prob prob]) + ([vr (in-vars prob)] + #:when (singleton-var? vr)) + (assign-val prob (var-name vr) (first (var-domain vr))))) (define/contract (backtracking-solver prob @@ -488,45 +495,47 @@ (define reduce-arity-proc (if (current-arity-reduction) reduce-constraint-arity values)) (define learned-constraints null) (define learning? (current-learning)) - (let loop ([prob ((if (current-node-consistency) make-nodes-consistent values) prob)]) - (match (select-unassigned-variable prob) - [#false (yield prob)] - [(var name domain) - (define (wants-backtrack? exn) - (and (backtrack? exn) (or (let ([bths (backtrack-histories exn)]) - (or (empty? bths) (for*/or ([bth bths] - [rec bth]) - (eq? name (car rec)))))))) - (for/fold ([conflicts null] - #:result (void)) - ([val (in-list (order-domain-values domain))]) - (with-handlers ([wants-backtrack? - (λ (bt) - (define bths (backtrack-histories bt)) - (when learning? - (set! learned-constraints (append - (map history->constraint (filter (λ (bth) (<= 2 (length bth) 4)) bths)) - learned-constraints))) - (append conflicts (remq name (remove-duplicates - (for*/list ([bth bths] - [rec bth]) - (car rec)) eq?))))]) - (let* ([prob (assign-val prob name val)] - [prob (if learning? - (and (for ([lc learned-constraints] - #:when (for/and ([cname (constraint-names lc)]) - (memq cname (map var-name (filter assigned-var? (vars prob)))))) - (unless (lc prob) - (println 'boing) - (backtrack!))) prob) - prob)] - ;; reduce constraints before inference, - ;; to create more forward-checkable (binary) constraints - [prob (reduce-arity-proc prob)] - [prob (inference prob name)] - [prob (check-constraints prob)]) - (loop prob))) - conflicts)])))) + (let* ([prob ((if (current-node-consistency) make-nodes-consistent values) prob)] + [prob (assign-singletons prob)]) + (let loop ([prob prob]) + (match (select-unassigned-variable prob) + [#false (yield prob)] + [(var name domain) + (define (wants-backtrack? exn) + (and (backtrack? exn) (or (let ([bths (backtrack-histories exn)]) + (or (empty? bths) (for*/or ([bth bths] + [rec bth]) + (eq? name (car rec)))))))) + (for/fold ([conflicts null] + #:result (void)) + ([val (in-list (order-domain-values domain))]) + (with-handlers ([wants-backtrack? + (λ (bt) + (define bths (backtrack-histories bt)) + (when learning? + (set! learned-constraints (append + (map history->constraint (filter (λ (bth) (<= 2 (length bth) 4)) bths)) + learned-constraints))) + (append conflicts (remq name (remove-duplicates + (for*/list ([bth bths] + [rec bth]) + (car rec)) eq?))))]) + (let* ([prob (assign-val prob name val)] + [prob (if learning? + (and (for ([lc learned-constraints] + #:when (for/and ([cname (constraint-names lc)]) + (memq cname (map var-name (filter assigned-var? (vars prob)))))) + (unless (lc prob) + (println 'boing) + (backtrack!))) prob) + prob)] + ;; reduce constraints before inference, + ;; to create more forward-checkable (binary) constraints + [prob (reduce-arity-proc prob)] + [prob (inference prob name)] + [prob (check-constraints prob)]) + (loop prob))) + conflicts)]))))) (define (random-pick xs) (list-ref xs (random (length xs)))) diff --git a/csp/csp/scribblings/csp.scrbl b/csp/csp/scribblings/csp.scrbl index f258b80f..2f14be48 100644 --- a/csp/csp/scribblings/csp.scrbl +++ b/csp/csp/scribblings/csp.scrbl @@ -136,6 +136,8 @@ Of course, when we use ordinary @racket[solve], we don't know how many assignmen Disappointing but accurate. + + @section{Making & solving CSPs} From 3cae574bac5be6ceba2e5be1c0e0e1548d175c84 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Thu, 25 Oct 2018 15:37:25 -0700 Subject: [PATCH 188/246] single page --- csp/csp/info.rkt | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/csp/csp/info.rkt b/csp/csp/info.rkt index 9debf269..cfe014dd 100644 --- a/csp/csp/info.rkt +++ b/csp/csp/info.rkt @@ -1,3 +1,3 @@ #lang info -(define scribblings '(("scribblings/csp.scrbl" (multi-page)))) +(define scribblings '(("scribblings/csp.scrbl"))) From e25a4b5fed435375f46f8941d027e88eb0efc26a Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Thu, 25 Oct 2018 15:38:11 -0700 Subject: [PATCH 189/246] yeh --- csp/csp/info.rkt | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/csp/csp/info.rkt b/csp/csp/info.rkt index cfe014dd..b9324dc8 100644 --- a/csp/csp/info.rkt +++ b/csp/csp/info.rkt @@ -1,3 +1,3 @@ #lang info -(define scribblings '(("scribblings/csp.scrbl"))) +(define scribblings '(("scribblings/csp.scrbl" ()))) From d09b084b524e1e777691a7e704c10fe52a6e7a75 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Thu, 25 Oct 2018 17:51:51 -0700 Subject: [PATCH 190/246] fc --- csp/csp/hacs-demo-triples.rkt | 29 +++++++++++++++++++++++++++++ csp/csp/hacs.rkt | 2 +- 2 files changed, 30 insertions(+), 1 deletion(-) create mode 100644 csp/csp/hacs-demo-triples.rkt diff --git a/csp/csp/hacs-demo-triples.rkt b/csp/csp/hacs-demo-triples.rkt new file mode 100644 index 00000000..8b357e61 --- /dev/null +++ b/csp/csp/hacs-demo-triples.rkt @@ -0,0 +1,29 @@ +#lang br +(require csp sugar) + +(define triples (make-csp)) + +(add-var! triples 'a (range 10 50)) +(add-var! triples 'b (range 10 50)) +(add-var! triples 'c (range 10 50)) + +(define (valid-triple? x y z) + (= (expt z 2) (+ (expt x 2) (expt y 2)))) +(add-constraint! triples valid-triple? '(a b c)) + +(require math/number-theory) +(add-constraint! triples coprime? '(a b c)) + +(add-constraint! triples <= '(a b)) + +(time-avg 10 (solve* triples)) + +(define (f) + (for*/list ([a (in-range 10 50)] + [b (in-range 10 50)] + #:when (<= a b) + [c (in-range 10 50)] + #:when (and (coprime? a b c) (valid-triple? a b c))) + `((a . ,a) (b . ,b) (c . ,c)))) + +(time-avg 10 (f)) \ No newline at end of file diff --git a/csp/csp/hacs.rkt b/csp/csp/hacs.rkt index 268301c3..c09405a5 100644 --- a/csp/csp/hacs.rkt +++ b/csp/csp/hacs.rkt @@ -489,7 +489,7 @@ #:select-variable [select-unassigned-variable (or (current-select-variable) first-unassigned-variable)] #:order-values [order-domain-values (or (current-order-values) first-domain-value)] - #:inference [inference (or (current-inference) no-inference)]) + #:inference [inference (or (current-inference) forward-check)]) ((csp?) (#:select-variable procedure? #:order-values procedure? #:inference procedure?) . ->* . generator?) (generator () (define reduce-arity-proc (if (current-arity-reduction) reduce-constraint-arity values)) From 32aa697173398b3e64f943c012e555f09f40db90 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Thu, 25 Oct 2018 18:27:02 -0700 Subject: [PATCH 191/246] huh --- csp/csp/euler-sudoku-grids.txt | 500 +++++++++++++++++++++++++++++++++ csp/csp/hacs-test-sudoku.rkt | 27 +- csp/csp/hacs.rkt | 2 +- 3 files changed, 522 insertions(+), 7 deletions(-) create mode 100644 csp/csp/euler-sudoku-grids.txt diff --git a/csp/csp/euler-sudoku-grids.txt b/csp/csp/euler-sudoku-grids.txt new file mode 100644 index 00000000..be23f6ac --- /dev/null +++ b/csp/csp/euler-sudoku-grids.txt @@ -0,0 +1,500 @@ +Grid 01 +003020600 +900305001 +001806400 +008102900 +700000008 +006708200 +002609500 +800203009 +005010300 +Grid 02 +200080300 +060070084 +030500209 +000105408 +000000000 +402706000 +301007040 +720040060 +004010003 +Grid 03 +000000907 +000420180 +000705026 +100904000 +050000040 +000507009 +920108000 +034059000 +507000000 +Grid 04 +030050040 +008010500 +460000012 +070502080 +000603000 +040109030 +250000098 +001020600 +080060020 +Grid 05 +020810740 +700003100 +090002805 +009040087 +400208003 +160030200 +302700060 +005600008 +076051090 +Grid 06 +100920000 +524010000 +000000070 +050008102 +000000000 +402700090 +060000000 +000030945 +000071006 +Grid 07 +043080250 +600000000 +000001094 +900004070 +000608000 +010200003 +820500000 +000000005 +034090710 +Grid 08 +480006902 +002008001 +900370060 +840010200 +003704100 +001060049 +020085007 +700900600 +609200018 +Grid 09 +000900002 +050123400 +030000160 +908000000 +070000090 +000000205 +091000050 +007439020 +400007000 +Grid 10 +001900003 +900700160 +030005007 +050000009 +004302600 +200000070 +600100030 +042007006 +500006800 +Grid 11 +000125400 +008400000 +420800000 +030000095 +060902010 +510000060 +000003049 +000007200 +001298000 +Grid 12 +062340750 +100005600 +570000040 +000094800 +400000006 +005830000 +030000091 +006400007 +059083260 +Grid 13 +300000000 +005009000 +200504000 +020000700 +160000058 +704310600 +000890100 +000067080 +000005437 +Grid 14 +630000000 +000500008 +005674000 +000020000 +003401020 +000000345 +000007004 +080300902 +947100080 +Grid 15 +000020040 +008035000 +000070602 +031046970 +200000000 +000501203 +049000730 +000000010 +800004000 +Grid 16 +361025900 +080960010 +400000057 +008000471 +000603000 +259000800 +740000005 +020018060 +005470329 +Grid 17 +050807020 +600010090 +702540006 +070020301 +504000908 +103080070 +900076205 +060090003 +080103040 +Grid 18 +080005000 +000003457 +000070809 +060400903 +007010500 +408007020 +901020000 +842300000 +000100080 +Grid 19 +003502900 +000040000 +106000305 +900251008 +070408030 +800763001 +308000104 +000020000 +005104800 +Grid 20 +000000000 +009805100 +051907420 +290401065 +000000000 +140508093 +026709580 +005103600 +000000000 +Grid 21 +020030090 +000907000 +900208005 +004806500 +607000208 +003102900 +800605007 +000309000 +030020050 +Grid 22 +005000006 +070009020 +000500107 +804150000 +000803000 +000092805 +907006000 +030400010 +200000600 +Grid 23 +040000050 +001943600 +009000300 +600050002 +103000506 +800020007 +005000200 +002436700 +030000040 +Grid 24 +004000000 +000030002 +390700080 +400009001 +209801307 +600200008 +010008053 +900040000 +000000800 +Grid 25 +360020089 +000361000 +000000000 +803000602 +400603007 +607000108 +000000000 +000418000 +970030014 +Grid 26 +500400060 +009000800 +640020000 +000001008 +208000501 +700500000 +000090084 +003000600 +060003002 +Grid 27 +007256400 +400000005 +010030060 +000508000 +008060200 +000107000 +030070090 +200000004 +006312700 +Grid 28 +000000000 +079050180 +800000007 +007306800 +450708096 +003502700 +700000005 +016030420 +000000000 +Grid 29 +030000080 +009000500 +007509200 +700105008 +020090030 +900402001 +004207100 +002000800 +070000090 +Grid 30 +200170603 +050000100 +000006079 +000040700 +000801000 +009050000 +310400000 +005000060 +906037002 +Grid 31 +000000080 +800701040 +040020030 +374000900 +000030000 +005000321 +010060050 +050802006 +080000000 +Grid 32 +000000085 +000210009 +960080100 +500800016 +000000000 +890006007 +009070052 +300054000 +480000000 +Grid 33 +608070502 +050608070 +002000300 +500090006 +040302050 +800050003 +005000200 +010704090 +409060701 +Grid 34 +050010040 +107000602 +000905000 +208030501 +040070020 +901080406 +000401000 +304000709 +020060010 +Grid 35 +053000790 +009753400 +100000002 +090080010 +000907000 +080030070 +500000003 +007641200 +061000940 +Grid 36 +006080300 +049070250 +000405000 +600317004 +007000800 +100826009 +000702000 +075040190 +003090600 +Grid 37 +005080700 +700204005 +320000084 +060105040 +008000500 +070803010 +450000091 +600508007 +003010600 +Grid 38 +000900800 +128006400 +070800060 +800430007 +500000009 +600079008 +090004010 +003600284 +001007000 +Grid 39 +000080000 +270000054 +095000810 +009806400 +020403060 +006905100 +017000620 +460000038 +000090000 +Grid 40 +000602000 +400050001 +085010620 +038206710 +000000000 +019407350 +026040530 +900020007 +000809000 +Grid 41 +000900002 +050123400 +030000160 +908000000 +070000090 +000000205 +091000050 +007439020 +400007000 +Grid 42 +380000000 +000400785 +009020300 +060090000 +800302009 +000040070 +001070500 +495006000 +000000092 +Grid 43 +000158000 +002060800 +030000040 +027030510 +000000000 +046080790 +050000080 +004070100 +000325000 +Grid 44 +010500200 +900001000 +002008030 +500030007 +008000500 +600080004 +040100700 +000700006 +003004050 +Grid 45 +080000040 +000469000 +400000007 +005904600 +070608030 +008502100 +900000005 +000781000 +060000010 +Grid 46 +904200007 +010000000 +000706500 +000800090 +020904060 +040002000 +001607000 +000000030 +300005702 +Grid 47 +000700800 +006000031 +040002000 +024070000 +010030080 +000060290 +000800070 +860000500 +002006000 +Grid 48 +001007090 +590080001 +030000080 +000005800 +050060020 +004100000 +080000030 +100020079 +020700400 +Grid 49 +000003017 +015009008 +060000000 +100007000 +009000200 +000500004 +000000020 +500600340 +340200000 +Grid 50 +300200000 +000107000 +706030500 +070009080 +900020004 +010800050 +009040301 +000702000 +000008006 \ No newline at end of file diff --git a/csp/csp/hacs-test-sudoku.rkt b/csp/csp/hacs-test-sudoku.rkt index 8031e57f..7531e21b 100644 --- a/csp/csp/hacs-test-sudoku.rkt +++ b/csp/csp/hacs-test-sudoku.rkt @@ -38,9 +38,7 @@ (for*/list ([str strs] [c (in-port read-char (open-input-string str))] #:unless (memv c '(#\- #\|))) - (match (string c) - [(? string->number num) (string->number num)] - [else #f]))) + (string->number (string c)))) (for ([name names] [val vals] #:when val) @@ -99,6 +97,23 @@ (current-random #true) (current-node-consistency #t) (current-arity-reduction #t) -(time-avg 10 (solve b1 #:finish-proc print-grid)) -(time-avg 10 (solve b2 #:finish-proc print-grid)) -(time-avg 10 (solve b3 #:finish-proc print-grid)) \ No newline at end of file +#;(time-avg 10 (solve b1 #:finish-proc print-grid)) +#;(time-avg 10 (solve b2 #:finish-proc print-grid)) +#;(time-avg 10 (solve b3 #:finish-proc print-grid)) + +;; https://projecteuler.net/problem=96 +;; todo: parsing of these is wrong +(define bstrs + (for/list ([puz (in-slice 10 (string-split (port->string (open-input-file "euler-sudoku-grids.txt")) "\n"))]) + (map (λ (str) (string-replace str "0" " ")) (cdr puz)))) + +(car bstrs) +(define bboard (apply board (car bstrs))) +(solve bboard #:finish-proc print-grid) + +#;(for/fold ([sum 0]) + ([(bstr idx) (in-indexed bstrs)]) + (define sol (solve (apply board bstr))) + (+ sum #R (+ (* 100 (cdr (assq 'c0 sol))) + (* 10 (cdr (assq 'c1 sol))) + (* 1 (cdr (assq 'c2 sol)))))) diff --git a/csp/csp/hacs.rkt b/csp/csp/hacs.rkt index c09405a5..268301c3 100644 --- a/csp/csp/hacs.rkt +++ b/csp/csp/hacs.rkt @@ -489,7 +489,7 @@ #:select-variable [select-unassigned-variable (or (current-select-variable) first-unassigned-variable)] #:order-values [order-domain-values (or (current-order-values) first-domain-value)] - #:inference [inference (or (current-inference) forward-check)]) + #:inference [inference (or (current-inference) no-inference)]) ((csp?) (#:select-variable procedure? #:order-values procedure? #:inference procedure?) . ->* . generator?) (generator () (define reduce-arity-proc (if (current-arity-reduction) reduce-constraint-arity values)) From 65a512c0774915eec934f3d51d6b0a16815bb394 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Thu, 25 Oct 2018 21:25:33 -0700 Subject: [PATCH 192/246] other sud --- csp/csp/sudoku-jm.rkt | 324 ++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 324 insertions(+) create mode 100644 csp/csp/sudoku-jm.rkt diff --git a/csp/csp/sudoku-jm.rkt b/csp/csp/sudoku-jm.rkt new file mode 100644 index 00000000..7e6d01cb --- /dev/null +++ b/csp/csp/sudoku-jm.rkt @@ -0,0 +1,324 @@ +#lang racket/base +(require racket/match + racket/list + racket/set) + +(define anything (seteq 1 2 3 4 5 6 7 8 9)) +(struct cell (x y can-be) #:transparent) + +(define (cell-solved? c) + (= 1 (set-count (cell-can-be c)))) + +(define (floor3 x) + (floor (/ x 3))) + +(define (neighbor-of? l r) + (or (same-row? l r) + (same-col? l r) + (same-box? l r))) +(define (same-box? l r) + (and (= (floor3 (cell-x l)) (floor3 (cell-x r))) + (= (floor3 (cell-y l)) (floor3 (cell-y r))))) +(define (same-row? l r) + (= (cell-x l) (cell-x r))) +(define (same-col? l r) + (= (cell-y l) (cell-y r))) + +;; a grid is a list of cells + +(define hrule "-----------") + +;; board : string ... -> grid +(define (board . ss) + (match-define + (list r1 r2 r3 (== hrule) + r4 r5 r6 (== hrule) + r7 r8 r9) + ss) + (define rs + (list r1 r2 r3 r4 r5 r6 r7 r8 r9)) + (flatten + (for/list ([r (in-list rs)] + [y (in-naturals)]) + (parse-row y r)))) + +(define (parse-row y r) + (for/list ([c (in-string r)] + [i (in-naturals)]) + (cond + [(or (= i 3) (= i 7)) + (if (char=? c #\|) + empty + (error 'parse-row))] + [else + (define x + (cond [(< i 3) (- i 0)] + [(< i 7) (- i 1)] + [ else (- i 2)])) + (parse-cell y x c)]))) + +(define (parse-cell y x c) + (cell x y + (if (char=? #\space c) + anything + (seteq (string->number (string c)))))) + +(define (propagate-one top cs) + (let/ec return + ;; If this is solved, then push its constraints to neighbors + (when (cell-solved? top) + (define-values (changed? ncs) + (for/fold ([changed? #f] [ncs empty]) + ([c (in-list cs)]) + (cond + [(neighbor-of? top c) + (define before + (cell-can-be c)) + (define after + (set-subtract before (cell-can-be top))) + (if (= (set-count before) + (set-count after)) + (values changed? + (cons c ncs)) + (values #t + (cons (struct-copy cell c + [can-be after]) + ncs)))] + [else + (values changed? (cons c ncs))]))) + (return changed? top ncs)) + + ;; If this is not solved, then look for cliques that force it to + ;; be one thing + (define (try-clique same-x?) + (define before (cell-can-be top)) + (define after + (for/fold ([before before]) + ([c (in-list cs)]) + (if (same-x? top c) + (set-subtract before (cell-can-be c)) + before))) + (when (= (set-count after) 1) + (return #t + (struct-copy cell top + [can-be after]) + cs))) + + (try-clique same-row?) + (try-clique same-col?) + (try-clique same-box?) + + ;; Look for two cells in our clique that have the same can-be sets + ;; and remove them from everything else + (define (only2-clique same-x?) + (define before (cell-can-be top)) + (when (= (set-count before) 2) + (define other + (for/or ([c (in-list cs)]) + (and (same-x? top c) (equal? before (cell-can-be c)) c))) + (when other + (define changed? #f) + (define ncs + (for/list ([c (in-list cs)]) + (cond + [(and (not (eq? other c)) (same-x? top c)) + (define cbefore + (cell-can-be c)) + (define cafter + (set-subtract cbefore before)) + (unless (equal? cbefore cafter) + (set! changed? #t)) + (struct-copy cell c + [can-be cafter])] + [else + c]))) + (return changed? top + ncs)))) + + (only2-clique same-row?) + (only2-clique same-col?) + (only2-clique same-box?) + + (values #f + top + cs))) + +(define (find-pivot f l) + (let loop ([tried empty] + [to-try l]) + (match to-try + [(list) + (values #f l)] + [(list-rest top more) + (define-values (changed? ntop nmore) + (f top (append tried more))) + (if changed? + (values #t (cons ntop nmore)) + (loop (cons top tried) more))]))) + +(define (propagate g) + (find-pivot propagate-one g)) + +(define (until-fixed-point f o bad? end-f) + (define-values (changed? no) (f o)) + (if changed? + (cons + no + (if (bad? no) + (end-f no) + (until-fixed-point f no bad? end-f))) + (end-f o))) + +(define (solved? g) + (andmap (λ (c) (= (set-count (cell-can-be c)) 1)) g)) + +(define (failed-solution? g) + (ormap (λ (c) (= (set-count (cell-can-be c)) 0)) g)) + +;; solve-it : grid -> (listof grid) +(define (solve-it g) + (let solve-loop + ([g g] + [backtrack! + (λ (i) + (error 'solve-it "Failed!"))]) + (define (done? g) + (cond + [(solved? g) + empty] + [(failed-solution? g) + (backtrack! #f)] + [else + (search g)])) + (define (search g) + (define sg (sort g < #:key (λ (c) (set-count (cell-can-be c))))) + (let iter-loop ([before empty] + [after sg]) + (cond + [(empty? after) + (backtrack! #f)] + [else + (define c (first after)) + (define cb (cell-can-be c)) + (or (and (not (= (set-count cb) 1)) + (for/or ([o (in-set cb)]) + (let/ec new-backtrack! + (define nc + (struct-copy cell c + [can-be (seteq o)])) + (solve-loop + (cons + nc + (append before (rest after))) + new-backtrack!)))) + (iter-loop (cons c before) + (rest after)))]))) + (until-fixed-point propagate g failed-solution? done?))) + +(require 2htdp/image + 2htdp/universe) +(define (fig s) (text/font s 12 "black" #f 'modern 'normal 'normal #f)) +(define MIN-FIG (fig "1")) +(define CELL-W (* 3 (image-width MIN-FIG))) +(define CELL-H (* 3 (image-height MIN-FIG))) + +(struct draw-state (i before after)) +(define (draw-it! gs) + (define (move-right ds) + (match-define (draw-state i before after) ds) + (cond + [(empty? (rest after)) + ds] + [else + (draw-state (add1 i) + (cons (first after) before) + (rest after))])) + (define (draw-can-be can-be) + (define (figi i) + (if (set-member? can-be i) + (fig (number->string i)) + (fig " "))) + (place-image/align + (if (= 1 (set-count can-be)) + (scale 3 (fig (number->string (set-first can-be)))) + (above (beside (figi 1) (figi 2) (figi 3)) + (beside (figi 4) (figi 5) (figi 6)) + (beside (figi 7) (figi 8) (figi 9)))) + 0 0 + "left" "top" + (rectangle CELL-W CELL-H + "outline" "black"))) + (define (draw-draw-state ds) + (match-define (draw-state i before after) ds) + (define g (first after)) + (for/fold ([i + (empty-scene (* CELL-W 11) + (* CELL-H 11))]) + ([c (in-list g)]) + (match-define (cell x y can-be) c) + (place-image/align + (draw-can-be can-be) + (* CELL-W + (cond [(<= x 2) (+ x 0)] + [(<= x 5) (+ x 1)] + [ else (+ x 2)])) + (* CELL-H + (cond [(<= y 2) (+ y 0)] + [(<= y 5) (+ y 1)] + [ else (+ y 2)])) + "left" "top" + i))) + (big-bang (draw-state 0 empty gs) + (on-tick move-right 1/8) + (on-draw draw-draw-state))) + +(module+ main + ;; Wikipedia Example + (define b1 + (board + "53 | 7 | " + "6 |195| " + " 98| | 6 " + "-----------" + "8 | 6 | 3" + "4 |8 3| 1" + "7 | 2 | 6" + "-----------" + " 6 | |28 " + " |419| 5" + " | 8 | 79")) + + ;; "Hard" example + (define b2 + (board + " 7 | 2 | 5" + " 9| 87| 3" + " 6 | | 4 " + "-----------" + " | 6 | 17" + "9 4| |8 6" + "71 | 5 | " + "-----------" + " 9 | | 8 " + "5 |21 |4 " + "4 | 9 | 6 ")) + + ;; "Evil" example + (define b3 + (board + " 8| | 45" + " | 8 |9 " + " 2|4 | " + "-----------" + "5 | 1|76 " + " 1 | 7 | 8 " + " 79|5 | 1" + "-----------" + " | 7|4 " + " 7| 6 | " + "65 | |3 ")) + + (draw-state-i + (draw-it! + (solve-it + b2)))) \ No newline at end of file From b7f829760c0ad2550e9916579a4bf4a16d5748ef Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Thu, 25 Oct 2018 22:05:12 -0700 Subject: [PATCH 193/246] fixup --- csp/csp/hacs-test-sudoku.rkt | 70 +++++++------ csp/csp/hacs.rkt | 188 +++++++++++++++-------------------- csp/csp/sudoku-jm.rkt | 13 ++- 3 files changed, 128 insertions(+), 143 deletions(-) diff --git a/csp/csp/hacs-test-sudoku.rkt b/csp/csp/hacs-test-sudoku.rkt index 7531e21b..ded44233 100644 --- a/csp/csp/hacs-test-sudoku.rkt +++ b/csp/csp/hacs-test-sudoku.rkt @@ -2,7 +2,7 @@ (require sugar/debug "hacs.rkt") (define names (for/list ([i (in-range 81)]) - (string->symbol (format "c~a" i)))) + (string->symbol (format "c~a" i)))) (define (make-sudoku) (define sudoku (make-csp)) @@ -11,26 +11,26 @@ (define (not= . xs) (= (length xs) (length (remove-duplicates xs =)))) (for ([i (in-range 9)]) - (define row-cells (for/list ([(name idx) (in-indexed names)] - #:when (= (quotient idx 9) i)) - name)) - (add-pairwise-constraint! sudoku not= row-cells) - (define col-cells (for/list ([(name idx) (in-indexed names)] - #:when (= (remainder idx 9) i)) - name)) - (add-pairwise-constraint! sudoku not= col-cells)) + (define row-cells (for/list ([(name idx) (in-indexed names)] + #:when (= (quotient idx 9) i)) + name)) + (add-pairwise-constraint! sudoku not= row-cells) + (define col-cells (for/list ([(name idx) (in-indexed names)] + #:when (= (remainder idx 9) i)) + name)) + (add-pairwise-constraint! sudoku not= col-cells)) (for ([i '(0 3 6 27 30 33 54 57 60)]) - (define box-cells (for/list ([j '(0 1 2 9 10 11 18 19 20)]) - (string->symbol (format "c~a" (+ i j))))) - (add-pairwise-constraint! sudoku not= box-cells)) + (define box-cells (for/list ([j '(0 1 2 9 10 11 18 19 20)]) + (string->symbol (format "c~a" (+ i j))))) + (add-pairwise-constraint! sudoku not= box-cells)) sudoku) (require racket/sequence) (define (print-grid sol) (displayln (string-join (map ~a (for/list ([row (in-slice 9 (csp->assocs sol))]) - (map cdr row))) "\n"))) + (map cdr row))) "\n"))) (define (board . strs) (define sudoku (make-sudoku)) @@ -38,11 +38,11 @@ (for*/list ([str strs] [c (in-port read-char (open-input-string str))] #:unless (memv c '(#\- #\|))) - (string->number (string c)))) + (string->number (string c)))) (for ([name names] [val vals] #:when val) - (add-constraint! sudoku (curry = val) (list name) (string->symbol (format "is-~a" val)))) + (add-constraint! sudoku (curry = val) (list name) (string->symbol (format "is-~a" val)))) sudoku) ;; http://jeapostrophe.github.io/2013-10-23-sudoku-post.html @@ -97,23 +97,27 @@ (current-random #true) (current-node-consistency #t) (current-arity-reduction #t) -#;(time-avg 10 (solve b1 #:finish-proc print-grid)) -#;(time-avg 10 (solve b2 #:finish-proc print-grid)) -#;(time-avg 10 (solve b3 #:finish-proc print-grid)) +(time-avg 10 (void (solve b1))) +(time-avg 10 (void (solve b2))) +(time-avg 10 (void (solve b3))) + + +(define (euler-value sol) + (match sol + [(list (cons (== 'c0) h) (cons (== 'c1) t) (cons (== 'c2) d) _ ...) + (+ (* 100 h) (* 10 t) d)])) + + +(require rackunit) +(check-equal? (euler-value (solve b1)) 534) +(check-equal? (euler-value (solve b2)) 378) +(check-equal? (euler-value (solve b3)) 938) ;; https://projecteuler.net/problem=96 -;; todo: parsing of these is wrong -(define bstrs - (for/list ([puz (in-slice 10 (string-split (port->string (open-input-file "euler-sudoku-grids.txt")) "\n"))]) - (map (λ (str) (string-replace str "0" " ")) (cdr puz)))) - -(car bstrs) -(define bboard (apply board (car bstrs))) -(solve bboard #:finish-proc print-grid) - -#;(for/fold ([sum 0]) - ([(bstr idx) (in-indexed bstrs)]) - (define sol (solve (apply board bstr))) - (+ sum #R (+ (* 100 (cdr (assq 'c0 sol))) - (* 10 (cdr (assq 'c1 sol))) - (* 1 (cdr (assq 'c2 sol)))))) +;; answer 24702 +(define (do-euler) + (define bstrs + (for/list ([puz (in-slice 10 (string-split (port->string (open-input-file "euler-sudoku-grids.txt")) "\n"))]) + (map (λ (str) (string-replace str "0" " ")) (cdr puz)))) + (for/sum ([bstr bstrs]) + (euler-value (solve (apply board bstr))))) diff --git a/csp/csp/hacs.rkt b/csp/csp/hacs.rkt index 268301c3..4bdd8542 100644 --- a/csp/csp/hacs.rkt +++ b/csp/csp/hacs.rkt @@ -20,7 +20,7 @@ (if (null? argss) (yield (reverse acc)) (for ([arg (car argss)]) - (loop (cdr argss) (cons arg acc)))))))) + (loop (cdr argss) (cons arg acc)))))))) (struct csp (vars constraints) #:mutable #:transparent) (define constraints csp-constraints) @@ -36,7 +36,7 @@ (raise-argument-error 'constraint "csp" prob)) ;; apply proc in many-to-many style (for/and ([args (in-cartesian (map (λ (name) (find-domain prob name)) (constraint-names const)))]) - (apply (constraint-proc const) args)))) + (apply (constraint-proc const) args)))) (define name? symbol?) @@ -95,11 +95,11 @@ ((csp? procedure? (listof (listof name?))) ((or/c #false name?)) . ->* . void?) (set-csp-constraints! prob (append (constraints prob) (for/list ([names (in-list namess)]) - (for ([name (in-list names)]) - (check-name-in-csp! 'add-constraints! prob name)) - (make-constraint names (if proc-name - (procedure-rename proc proc-name) - proc)))))) + (for ([name (in-list names)]) + (check-name-in-csp! 'add-constraints! prob name)) + (make-constraint names (if proc-name + (procedure-rename proc proc-name) + proc)))))) (define/contract (add-pairwise-constraint! prob proc names [proc-name #false]) ((csp? procedure? (listof name?)) (name?) . ->* . void?) @@ -138,7 +138,7 @@ (check-name-in-csp! 'find-var prob name) (for/first ([vr (in-vars prob)] #:when (eq? name (var-name vr))) - vr)) + vr)) (define/contract (find-domain prob name) (csp? name? . -> . (listof any/c)) @@ -151,7 +151,7 @@ (csp? name? . -> . any/c) (for/or ([vr (in-vars prob)] #:when (assigned-var? vr)) - (eq? name (var-name vr)))) + (eq? name (var-name vr)))) (define/contract (reduce-function-arity proc pattern) (procedure? (listof any/c) . -> . procedure?) @@ -183,20 +183,20 @@ (ormap assigned? (constraint-names constraint))) (make-csp (vars prob) (for/list ([const (in-constraints prob)]) - (cond - ;; no point reducing 2-arity functions because they will be consumed by forward checking - [(and (or (not minimum-arity) (<= minimum-arity (constraint-arity const))) - (partially-assigned? const)) - (match-define (constraint cnames proc) const) - ;; pattern is mix of values and boxed symbols (indicating variables to persist) - ;; use boxes here as cheap way to distinguish id symbols from value symbols - (define arity-reduction-pattern (for/list ([cname (in-list cnames)]) - (if (assigned? cname) - (first (find-domain prob cname)) - (box cname)))) - (constraint (filter-not assigned? cnames) - (reduce-function-arity proc arity-reduction-pattern))] - [else const])))) + (cond + ;; no point reducing 2-arity functions because they will be consumed by forward checking + [(and (or (not minimum-arity) (<= minimum-arity (constraint-arity const))) + (partially-assigned? const)) + (match-define (constraint cnames proc) const) + ;; pattern is mix of values and boxed symbols (indicating variables to persist) + ;; use boxes here as cheap way to distinguish id symbols from value symbols + (define arity-reduction-pattern (for/list ([cname (in-list cnames)]) + (if (assigned? cname) + (first (find-domain prob cname)) + (box cname)))) + (constraint (filter-not assigned? cnames) + (reduce-function-arity proc arity-reduction-pattern))] + [else const])))) (define nassns 0) (define nfchecks 0) @@ -211,9 +211,9 @@ (when-debug (set! nassns (add1 nassns))) (make-csp (for/list ([vr (in-vars prob)]) - (if (eq? name (var-name vr)) - (assigned-var name (list val)) - vr)) + (if (eq? name (var-name vr)) + (assigned-var name (list val)) + vr)) (constraints prob))) (define/contract (unassigned-vars prob) @@ -238,7 +238,7 @@ (csp? var? . -> . natural?) (for/sum ([const (in-constraints prob)] #:when (memq (var-name var) (constraint-names const))) - 1)) + 1)) (define/contract (domain-length var) (var? . -> . natural?) @@ -247,7 +247,7 @@ (define/contract (state-count csp) (csp? . -> . natural?) (for/product ([vr (in-vars csp)]) - (domain-length vr))) + (domain-length vr))) (define/contract (mrv-degree-hybrid prob) (csp? . -> . (or/c #f var?)) @@ -267,7 +267,7 @@ (random-pick (for/list ([uv (in-list mrv-uvars)] [degree (in-list degrees)] #:when (= max-degree degree)) - uv))])])) + uv))])])) (define first-domain-value values) @@ -279,8 +279,8 @@ [cnames (in-value (constraint-names const))] #:when (and (= (length names) (length cnames)) (for/and ([name (in-list names)]) - (memq name cnames)))) - const)) + (memq name cnames)))) + const)) (define (one-arity? const) (= 1 (constraint-arity const))) (define (two-arity? const) (= 2 (constraint-arity const))) @@ -294,7 +294,7 @@ ((listof (and/c constraint? two-arity?)) . -> . (listof arc?)) (for*/list ([const (in-list constraints)] [name (in-list (constraint-names const))]) - (arc name const))) + (arc name const))) (require sugar/debug) (define/contract (reduce-domain prob ark) @@ -306,16 +306,16 @@ (λ (val other-val) (constraint-proc other-val val)))) ; otherwise reverse arg order (define (satisfies-arc? val) (for/or ([other-val (in-list (find-domain prob other-name))]) - (proc val other-val))) + (proc val other-val))) (make-csp (for/list ([vr (in-vars prob)]) - (cond - [(assigned-var? vr) vr] - [(eq? name (var-name vr)) - (var name (match (filter satisfies-arc? (domain vr)) - [(? empty?) (backtrack!)] - [vals vals]))] - [else vr])) + (cond + [(assigned-var? vr) vr] + [(eq? name (var-name vr)) + (var name (match (filter satisfies-arc? (domain vr)) + [(? empty?) (backtrack!)] + [vals vals]))] + [else vr])) (constraints prob))) (define/contract (terminating-at? arcs name) @@ -324,7 +324,7 @@ #:when (and (memq name (constraint-names (arc-const arc))) (not (eq? name (arc-name arc))))) - arc)) + arc)) (define/contract (ac-3 prob ref-name) (csp? name? . -> . csp?) @@ -334,8 +334,8 @@ (define starting-arcs (two-arity-constraints->arcs (for/list ([const (in-constraints prob)] #:when (and (two-arity? const) (for/and ([cname (in-list (constraint-names const))]) - (memq cname checkable-names)))) - const))) + (memq cname checkable-names)))) + const))) (for/fold ([prob prob] [arcs (sort starting-arcs < #:key (λ (a) (length (find-domain prob (arc-name a)))) #:cache-keys? #true)] #:result (prune-singleton-constraints prob)) @@ -366,11 +366,11 @@ (define new-vals (for/list ([val (in-list vals)] #:when (for/and ([const (in-list constraints)]) - (let ([proc (constraint-proc const)]) - (if (eq? name (first (constraint-names const))) - (proc val ref-val) - (proc ref-val val))))) - val)) + (let ([proc (constraint-proc const)]) + (if (eq? name (first (constraint-names const))) + (proc val ref-val) + (proc ref-val val))))) + val)) (checked-variable name new-vals (cons (cons ref-name ref-val) (match vr [(checked-variable _ _ history) history] [else null])))])])) @@ -379,15 +379,15 @@ ((csp?) ((or/c #false name?)) . ->* . csp?) (define singleton-var-names (for/list ([vr (in-vars prob)] #:when (singleton-var? vr)) - (var-name vr))) + (var-name vr))) (make-csp (vars prob) (for/list ([const (in-constraints prob)] #:unless (and (two-arity? const) (or (not ref-name) (constraint-relates? const ref-name)) (for/and ([cname (in-list (constraint-names const))]) - (memq cname singleton-var-names)))) - const))) + (memq cname singleton-var-names)))) + const))) (define/contract (forward-check prob ref-name) (csp? name? . -> . csp?) @@ -396,7 +396,7 @@ ;; conflict-set will be empty if there are no empty domains (as we would hope) (define conflict-set (for/list ([cvr (in-list checked-vars)] #:when (empty? (domain cvr))) - (history cvr))) + (history cvr))) ;; for conflict-directed backjumping it's essential to forward-check ALL vars ;; (even after an empty domain is generated) and combine their conflicts ;; so we can discover the *most recent past var* that could be the culprit. @@ -413,7 +413,7 @@ ;; constraint is checkable if all constraint names ;; are in target list of names. (for/and ([cname (in-list (constraint-names const))]) - (memq cname names))) + (memq cname names))) (define/contract (constraint-arity const) (constraint? . -> . natural?) @@ -430,26 +430,26 @@ ;; we also want to use "singleton" vars (that is, vars that have been reduced to a single domain value by forward checking) (define singleton-varnames (for/list ([vr (in-vars prob)] #:when (singleton-var? vr)) - (var-name vr))) + (var-name vr))) (define-values (checkable-consts other-consts) (partition (λ (const) (and (constraint-checkable? const singleton-varnames) (or (not mandatory-names) (for/and ([name (in-list mandatory-names)]) - (constraint-relates? const name))))) + (constraint-relates? const name))))) (constraints prob))) (cond [conflict-count? (define conflict-count (for/sum ([constraint (in-list checkable-consts)] #:unless (constraint prob)) - 1)) + 1)) (when-debug (set! nchecks (+ conflict-count nchecks))) conflict-count] [else (for ([(constraint idx) (in-indexed checkable-consts)] #:unless (constraint prob)) - (when-debug (set! nchecks (+ (add1 idx) nchecks))) - (backtrack!)) + (when-debug (set! nchecks (+ (add1 idx) nchecks))) + (backtrack!)) ;; discard checked constraints, since they have no further reason to live (make-csp (vars prob) other-consts)])) @@ -461,28 +461,18 @@ prob (make-csp (for/list ([vr (in-vars prob)]) - (match-define (var name vals) vr) - (var name (for/fold ([vals vals]) - ([const (in-list unary-constraints)] - #:when (constraint-relates? const name)) - (filter (constraint-proc const) vals)))) + (match-define (var name vals) vr) + (var name (for/fold ([vals vals]) + ([const (in-list unary-constraints)] + #:when (constraint-relates? const name)) + (filter (constraint-proc const) vals)))) other-constraints))) (define ((make-hist-proc assocs) . xs) (not (for/and ([x (in-list xs)] [val (in-list (map cdr assocs))]) - (equal? x val)))) - -(define (history->constraint hst) - (constraint (map car hst) (make-hist-proc hst))) - -(define/contract (assign-singletons prob) - (csp? . -> . csp?) - (for/fold ([prob prob]) - ([vr (in-vars prob)] - #:when (singleton-var? vr)) - (assign-val prob (var-name vr) (first (var-domain vr))))) + (equal? x val)))) (define/contract (backtracking-solver prob @@ -493,10 +483,8 @@ ((csp?) (#:select-variable procedure? #:order-values procedure? #:inference procedure?) . ->* . generator?) (generator () (define reduce-arity-proc (if (current-arity-reduction) reduce-constraint-arity values)) - (define learned-constraints null) (define learning? (current-learning)) - (let* ([prob ((if (current-node-consistency) make-nodes-consistent values) prob)] - [prob (assign-singletons prob)]) + (let* ([prob ((if (current-node-consistency) make-nodes-consistent values) prob)]) (let loop ([prob prob]) (match (select-unassigned-variable prob) [#false (yield prob)] @@ -505,30 +493,18 @@ (and (backtrack? exn) (or (let ([bths (backtrack-histories exn)]) (or (empty? bths) (for*/or ([bth bths] [rec bth]) - (eq? name (car rec)))))))) + (eq? name (car rec)))))))) (for/fold ([conflicts null] #:result (void)) ([val (in-list (order-domain-values domain))]) (with-handlers ([wants-backtrack? (λ (bt) (define bths (backtrack-histories bt)) - (when learning? - (set! learned-constraints (append - (map history->constraint (filter (λ (bth) (<= 2 (length bth) 4)) bths)) - learned-constraints))) (append conflicts (remq name (remove-duplicates (for*/list ([bth bths] [rec bth]) - (car rec)) eq?))))]) + (car rec)) eq?))))]) (let* ([prob (assign-val prob name val)] - [prob (if learning? - (and (for ([lc learned-constraints] - #:when (for/and ([cname (constraint-names lc)]) - (memq cname (map var-name (filter assigned-var? (vars prob)))))) - (unless (lc prob) - (println 'boing) - (backtrack!))) prob) - prob)] ;; reduce constraints before inference, ;; to create more forward-checkable (binary) constraints [prob (reduce-arity-proc prob)] @@ -565,9 +541,9 @@ (generator () (for ([thread-count (or (current-thread-count) 1)]) ; todo: what is ideal thread count? - (make-min-conflcts-thread prob thread-count max-steps)) + (make-min-conflcts-thread prob thread-count max-steps)) (for ([i (in-naturals)]) - (yield (thread-receive))))) + (yield (thread-receive))))) (define/contract (optimal-stop-min proc xs) (procedure? (listof any/c) . -> . any/c) @@ -575,7 +551,7 @@ (define threshold (argmin proc sample)) (or (for/first ([candidate (in-list candidates)] #:when (<= (proc candidate) threshold)) - candidate) + candidate) (last candidates))) (define/contract (conflicted-variable-names prob) @@ -583,7 +559,7 @@ ;; Return a list of variables in current assignment that are conflicted (for/list ([name (in-var-names prob)] #:when (positive? (nconflicts prob name))) - name)) + name)) (define/contract (min-conflicts-value prob name vals) (csp? name? (listof any/c) . -> . any/c) @@ -592,7 +568,7 @@ #:cache-keys? #true)) (for/first ([val (in-list vals-by-conflict)] #:unless (equal? val (first (find-domain prob name)))) ;; but change the value - val)) + val)) (define no-value-sig (gensym)) @@ -607,11 +583,11 @@ ((csp?) ((listof name?)) . ->* . (listof (cons/c name? any/c))) (define assocs (for/list ([vr (in-vars prob)]) - (match vr - [(var name (list val)) (cons name val)]))) + (match vr + [(var name (list val)) (cons name val)]))) (if keys (for/list ([key (in-list keys)]) - (assq key assocs)) + (assq key assocs)) assocs)) (define/contract (combine-csps probs) @@ -626,11 +602,11 @@ (make-csp (for/list ([vr (in-vars prob)] #:when (memq (var-name vr) names)) - vr) + vr) (for/list ([const (in-constraints prob)] #:when (for/and ([cname (in-list (constraint-names const))]) - (memq cname names))) - const))) + (memq cname names))) + const))) (define/contract (solve* prob #:finish-proc [finish-proc (λ (p) (csp->assocs p (map var-name (vars prob))))] @@ -643,17 +619,17 @@ (define subcsps ; decompose into independent csps. `cc` determines "connected components" (if (current-decompose) (for/list ([nodeset (in-list (cc (csp->graph prob)))]) - (extract-subcsp prob nodeset)) + (extract-subcsp prob nodeset)) (list prob))) (define solgens (map solver subcsps)) (define solstreams (for/list ([solgen (in-list solgens)]) - (for/stream ([sol (in-producer solgen (void))]) - sol))) + (for/stream ([sol (in-producer solgen (void))]) + sol))) (for/list ([solution-pieces (in-cartesian solstreams)] [idx (in-range max-solutions)]) - (finish-proc (combine-csps solution-pieces)))) + (finish-proc (combine-csps solution-pieces)))) (define/contract (solve prob #:finish-proc [finish-proc (λ (p) (csp->assocs p (map var-name (vars prob))))] diff --git a/csp/csp/sudoku-jm.rkt b/csp/csp/sudoku-jm.rkt index 7e6d01cb..4f13cdb2 100644 --- a/csp/csp/sudoku-jm.rkt +++ b/csp/csp/sudoku-jm.rkt @@ -272,8 +272,7 @@ (on-tick move-right 1/8) (on-draw draw-draw-state))) -(module+ main - ;; Wikipedia Example +;; Wikipedia Example (define b1 (board "53 | 7 | " @@ -318,7 +317,13 @@ " 7| 6 | " "65 | |3 ")) - (draw-state-i + #;(draw-state-i (draw-it! (solve-it - b2)))) \ No newline at end of file + b2))) + + +(require sugar/debug) +(time-avg 10 (void (solve-it b1))) +(time-avg 10 (void (solve-it b2))) +(time-avg 10 (void (solve-it b3))) \ No newline at end of file From 9a3298e2aae45a287cca90c951f23464d621d653 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Fri, 26 Oct 2018 12:31:08 -0700 Subject: [PATCH 194/246] more --- csp/csp/hacs-test-sudoku.rkt | 10 +++++--- csp/csp/hacs.rkt | 47 +++++++++++++++++++++++------------- 2 files changed, 37 insertions(+), 20 deletions(-) diff --git a/csp/csp/hacs-test-sudoku.rkt b/csp/csp/hacs-test-sudoku.rkt index ded44233..f49ec75e 100644 --- a/csp/csp/hacs-test-sudoku.rkt +++ b/csp/csp/hacs-test-sudoku.rkt @@ -97,9 +97,13 @@ (current-random #true) (current-node-consistency #t) (current-arity-reduction #t) -(time-avg 10 (void (solve b1))) -(time-avg 10 (void (solve b2))) -(time-avg 10 (void (solve b3))) +(define trials 5) +(time-avg trials (void (solve b1))) +(print-debug-info) +(time-avg trials (void (solve b2))) +(print-debug-info) +(time-avg trials (void (solve b3))) +(print-debug-info) (define (euler-value sol) diff --git a/csp/csp/hacs.rkt b/csp/csp/hacs.rkt index 4bdd8542..8a5ead9f 100644 --- a/csp/csp/hacs.rkt +++ b/csp/csp/hacs.rkt @@ -226,11 +226,36 @@ [(? empty?) #false] [xs (first xs)])) +(define/contract (argmin* proc xs [max-style? #f]) + ((procedure? (listof any/c)) (any/c) . ->* . (listof any/c)) + ;; return all elements that have min value. + (match xs + [(? empty?) xs] + [(list x) xs] + [xs + (define vals (map proc xs)) + (define target-val (apply (if max-style? max min) vals)) + (for/list ([x (in-list xs)] + [val (in-list vals)] + #:when (= val target-val)) + x)])) + +(define/contract (argmax* proc xs) + (procedure? (listof any/c) . -> . (listof any/c)) + ;; return all elements that have max value. + (argmin* proc xs 'max-mode!)) + (define/contract (minimum-remaining-values prob) (csp? . -> . (or/c #false (and/c var? (not/c assigned-var?)))) (match (unassigned-vars prob) [(? empty?) #false] - [xs (argmin (λ (var) (length (domain var))) xs)])) + [uvars (random-pick (argmin* domain-length uvars))])) + +(define/contract (max-degree prob) + (csp? . -> . (or/c #false (and/c var? (not/c assigned-var?)))) + (match (unassigned-vars prob) + [(? empty?) #false] + [uvars (random-pick (argmax* (λ (var) (var-degree prob var)) uvars))])) (define mrv minimum-remaining-values) @@ -253,21 +278,8 @@ (csp? . -> . (or/c #f var?)) (match (unassigned-vars prob) [(? empty?) #false] - [(cons (? singleton-var? uvar) _) uvar] [uvars - ;; minimum remaining values (MRV) rule - (define mrv-arg (argmin domain-length uvars)) - (match (filter (λ (var) (= (domain-length mrv-arg) (domain-length var))) uvars) - [(list winning-uvar) winning-uvar] - [(list mrv-uvars ...) - ;; use degree as tiebreaker for mrv - (define degrees (map (λ (var) (var-degree prob var)) mrv-uvars)) - (define max-degree (apply max degrees)) - ;; use random tiebreaker for degree - (random-pick (for/list ([uv (in-list mrv-uvars)] - [degree (in-list degrees)] - #:when (= max-degree degree)) - uv))])])) + (max-degree (make-csp (argmin* domain-length uvars) (constraints prob)))])) (define first-domain-value values) @@ -514,7 +526,9 @@ conflicts)]))))) (define (random-pick xs) - (list-ref xs (random (length xs)))) + (match xs + [(list x) x] + [xs (list-ref xs (random (length xs)))])) (define (assign-random-vals prob) (for/fold ([new-csp prob]) @@ -539,7 +553,6 @@ (define/contract (min-conflicts-solver prob [max-steps 100]) ((csp?) (integer?) . ->* . generator?) (generator () - (for ([thread-count (or (current-thread-count) 1)]) ; todo: what is ideal thread count? (make-min-conflcts-thread prob thread-count max-steps)) (for ([i (in-naturals)]) From fd7c6972580ac4f8efcfc060f6e51a7b7826e2a8 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Fri, 26 Oct 2018 12:59:23 -0700 Subject: [PATCH 195/246] refac --- csp/csp/hacs.rkt | 22 ++++++++++------------ 1 file changed, 10 insertions(+), 12 deletions(-) diff --git a/csp/csp/hacs.rkt b/csp/csp/hacs.rkt index 8a5ead9f..92ce0146 100644 --- a/csp/csp/hacs.rkt +++ b/csp/csp/hacs.rkt @@ -149,9 +149,7 @@ (define/contract (assigned-name? prob name) (csp? name? . -> . any/c) - (for/or ([vr (in-vars prob)] - #:when (assigned-var? vr)) - (eq? name (var-name vr)))) + (assigned-var? (find-var prob name))) (define/contract (reduce-function-arity proc pattern) (procedure? (listof any/c) . -> . procedure?) @@ -474,10 +472,11 @@ (make-csp (for/list ([vr (in-vars prob)]) (match-define (var name vals) vr) - (var name (for/fold ([vals vals]) - ([const (in-list unary-constraints)] - #:when (constraint-relates? const name)) - (filter (constraint-proc const) vals)))) + (define name-constraints (filter (λ (const) (constraint-relates? const name)) unary-constraints)) + (var name (for/list ([val (in-list vals)] + #:when (for/and ([const (in-list name-constraints)]) + ((constraint-proc const) val))) + val))) other-constraints))) (define ((make-hist-proc assocs) . xs) @@ -495,9 +494,7 @@ ((csp?) (#:select-variable procedure? #:order-values procedure? #:inference procedure?) . ->* . generator?) (generator () (define reduce-arity-proc (if (current-arity-reduction) reduce-constraint-arity values)) - (define learning? (current-learning)) - (let* ([prob ((if (current-node-consistency) make-nodes-consistent values) prob)]) - (let loop ([prob prob]) + (let loop ([prob ((if (current-node-consistency) make-nodes-consistent values) prob)]) (match (select-unassigned-variable prob) [#false (yield prob)] [(var name domain) @@ -523,9 +520,10 @@ [prob (inference prob name)] [prob (check-constraints prob)]) (loop prob))) - conflicts)]))))) + conflicts)])))) -(define (random-pick xs) +(define/contract (random-pick xs) + ((non-empty-listof any/c) . -> . any/c) (match xs [(list x) x] [xs (list-ref xs (random (length xs)))])) From ffa083c1b5b82da9b34d3a640a31bddd396a25d7 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Fri, 26 Oct 2018 13:15:46 -0700 Subject: [PATCH 196/246] checklessness --- csp/csp/hacs.rkt | 15 +++++++-------- 1 file changed, 7 insertions(+), 8 deletions(-) diff --git a/csp/csp/hacs.rkt b/csp/csp/hacs.rkt index 92ce0146..806c842c 100644 --- a/csp/csp/hacs.rkt +++ b/csp/csp/hacs.rkt @@ -214,8 +214,12 @@ vr)) (constraints prob))) +(define/contract (assigned-vars prob) + (csp? . -> . (listof var?)) + (filter assigned-var? (vars prob))) + (define/contract (unassigned-vars prob) - (csp? . -> . (listof (and/c var? (not/c assigned-var?)))) + (csp? . -> . (listof var?)) (filter-not assigned-var? (vars prob))) (define/contract (first-unassigned-variable csp) @@ -435,14 +439,9 @@ (define/contract (check-constraints prob [mandatory-names #f] #:conflicts [conflict-count? #f]) ((csp?) ((listof name?) #:conflicts boolean?) . ->* . (or/c csp? natural?)) - ;; this time, we're not limited to assigned variables - ;; (that is, vars that have been deliberately assigned in the backtrack process thus far) - ;; we also want to use "singleton" vars (that is, vars that have been reduced to a single domain value by forward checking) - (define singleton-varnames (for/list ([vr (in-vars prob)] - #:when (singleton-var? vr)) - (var-name vr))) + (define assigned-varnames (map var-name (assigned-vars prob))) (define-values (checkable-consts other-consts) - (partition (λ (const) (and (constraint-checkable? const singleton-varnames) + (partition (λ (const) (and (constraint-checkable? const assigned-varnames) (or (not mandatory-names) (for/and ([name (in-list mandatory-names)]) (constraint-relates? const name))))) From f06623c0702f31497854f7316f3045b0e9746890 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Fri, 26 Oct 2018 14:10:57 -0700 Subject: [PATCH 197/246] nits --- csp/csp/hacs.rkt | 115 +++++++++++++------------ csp/csp/sudoku-jm.rkt | 193 ++++++++++++++++++------------------------ 2 files changed, 143 insertions(+), 165 deletions(-) diff --git a/csp/csp/hacs.rkt b/csp/csp/hacs.rkt index 806c842c..74114634 100644 --- a/csp/csp/hacs.rkt +++ b/csp/csp/hacs.rkt @@ -73,19 +73,23 @@ (() ((listof var?) (listof constraint?)) . ->* . csp?) (csp vars consts)) +(define/contract (make-var name [vals null]) + ((name?) ((listof any/c)) . ->* . var?) + (var name vals)) + (define/contract (add-vars! prob names-or-procedure [vals-or-procedure empty]) ((csp? (or/c (listof name?) procedure?)) ((or/c (listof any/c) procedure?)) . ->* . void?) (for/fold ([vrs (vars prob)] - #:result (set-csp-vars! prob vrs)) + #:result (set-csp-vars! prob (reverse vrs))) ([name (in-list (match names-or-procedure [(? procedure? proc) (proc)] [names names]))]) (when (memq name (map var-name vrs)) (raise-argument-error 'add-vars! "var that doesn't already exist" name)) - (append vrs (list (var name - (if (procedure? vals-or-procedure) - (vals-or-procedure) - vals-or-procedure)))))) + (cons (make-var name + (match vals-or-procedure + [(? procedure? proc) (proc)] + [vals vals])) vrs))) (define/contract (add-var! prob name [vals-or-procedure empty]) ((csp? name?) ((or/c (listof any/c) procedure?)) . ->* . void?) @@ -206,33 +210,34 @@ (define/contract (assign-val prob name val) (csp? name? any/c . -> . csp?) - (when-debug (set! nassns (add1 nassns))) - (make-csp - (for/list ([vr (in-vars prob)]) - (if (eq? name (var-name vr)) - (assigned-var name (list val)) - vr)) - (constraints prob))) - -(define/contract (assigned-vars prob) - (csp? . -> . (listof var?)) - (filter assigned-var? (vars prob))) + (begin0 + (make-csp + (for/list ([vr (in-vars prob)]) + (if (eq? name (var-name vr)) + (assigned-var name (list val)) + vr)) + (constraints prob)) + (when-debug (set! nassns (add1 nassns))))) + +(define/contract (assigned-vars prob [invert? #f]) + ((csp?) (any/c) . ->* . (listof var?)) + ((if invert? filter-not filter) assigned-var? (vars prob))) (define/contract (unassigned-vars prob) (csp? . -> . (listof var?)) - (filter-not assigned-var? (vars prob))) + (assigned-vars prob 'invert)) (define/contract (first-unassigned-variable csp) (csp? . -> . (or/c #false (and/c var? (not/c assigned-var?)))) (match (unassigned-vars csp) - [(? empty?) #false] + [(== empty) #false] [xs (first xs)])) (define/contract (argmin* proc xs [max-style? #f]) ((procedure? (listof any/c)) (any/c) . ->* . (listof any/c)) ;; return all elements that have min value. (match xs - [(? empty?) xs] + [(== empty) xs] [(list x) xs] [xs (define vals (map proc xs)) @@ -250,13 +255,13 @@ (define/contract (minimum-remaining-values prob) (csp? . -> . (or/c #false (and/c var? (not/c assigned-var?)))) (match (unassigned-vars prob) - [(? empty?) #false] + [(== empty) #false] [uvars (random-pick (argmin* domain-length uvars))])) (define/contract (max-degree prob) (csp? . -> . (or/c #false (and/c var? (not/c assigned-var?)))) (match (unassigned-vars prob) - [(? empty?) #false] + [(== empty) #false] [uvars (random-pick (argmax* (λ (var) (var-degree prob var)) uvars))])) (define mrv minimum-remaining-values) @@ -279,7 +284,7 @@ (define/contract (mrv-degree-hybrid prob) (csp? . -> . (or/c #f var?)) (match (unassigned-vars prob) - [(? empty?) #false] + [(== empty) #false] [uvars (max-degree (make-csp (argmin* domain-length uvars) (constraints prob)))])) @@ -326,9 +331,9 @@ (cond [(assigned-var? vr) vr] [(eq? name (var-name vr)) - (var name (match (filter satisfies-arc? (domain vr)) - [(? empty?) (backtrack!)] - [vals vals]))] + (make-var name (match (filter satisfies-arc? (domain vr)) + [(? empty?) (backtrack!)] + [vals vals]))] [else vr])) (constraints prob))) @@ -472,10 +477,10 @@ (for/list ([vr (in-vars prob)]) (match-define (var name vals) vr) (define name-constraints (filter (λ (const) (constraint-relates? const name)) unary-constraints)) - (var name (for/list ([val (in-list vals)] - #:when (for/and ([const (in-list name-constraints)]) - ((constraint-proc const) val))) - val))) + (make-var name (for/list ([val (in-list vals)] + #:when (for/and ([const (in-list name-constraints)]) + ((constraint-proc const) val))) + val))) other-constraints))) (define ((make-hist-proc assocs) . xs) @@ -494,32 +499,32 @@ (generator () (define reduce-arity-proc (if (current-arity-reduction) reduce-constraint-arity values)) (let loop ([prob ((if (current-node-consistency) make-nodes-consistent values) prob)]) - (match (select-unassigned-variable prob) - [#false (yield prob)] - [(var name domain) - (define (wants-backtrack? exn) - (and (backtrack? exn) (or (let ([bths (backtrack-histories exn)]) - (or (empty? bths) (for*/or ([bth bths] - [rec bth]) - (eq? name (car rec)))))))) - (for/fold ([conflicts null] - #:result (void)) - ([val (in-list (order-domain-values domain))]) - (with-handlers ([wants-backtrack? - (λ (bt) - (define bths (backtrack-histories bt)) - (append conflicts (remq name (remove-duplicates - (for*/list ([bth bths] - [rec bth]) - (car rec)) eq?))))]) - (let* ([prob (assign-val prob name val)] - ;; reduce constraints before inference, - ;; to create more forward-checkable (binary) constraints - [prob (reduce-arity-proc prob)] - [prob (inference prob name)] - [prob (check-constraints prob)]) - (loop prob))) - conflicts)])))) + (match (select-unassigned-variable prob) + [#false (yield prob)] + [(var name domain) + (define (wants-backtrack? exn) + (and (backtrack? exn) (or (let ([bths (backtrack-histories exn)]) + (or (empty? bths) (for*/or ([bth bths] + [rec bth]) + (eq? name (car rec)))))))) + (for/fold ([conflicts null] + #:result (void)) + ([val (in-list (order-domain-values domain))]) + (with-handlers ([wants-backtrack? + (λ (bt) + (define bths (backtrack-histories bt)) + (append conflicts (remq name (remove-duplicates + (for*/list ([bth bths] + [rec bth]) + (car rec)) eq?))))]) + (let* ([prob (assign-val prob name val)] + ;; reduce constraints before inference, + ;; to create more forward-checkable (binary) constraints + [prob (reduce-arity-proc prob)] + [prob (inference prob name)] + [prob (check-constraints prob)]) + (loop prob))) + conflicts)])))) (define/contract (random-pick xs) ((non-empty-listof any/c) . -> . any/c) diff --git a/csp/csp/sudoku-jm.rkt b/csp/csp/sudoku-jm.rkt index 4f13cdb2..62ab9c32 100644 --- a/csp/csp/sudoku-jm.rkt +++ b/csp/csp/sudoku-jm.rkt @@ -1,4 +1,4 @@ -#lang racket/base +#lang debug racket/base (require racket/match racket/list racket/set) @@ -25,43 +25,18 @@ (= (cell-y l) (cell-y r))) ;; a grid is a list of cells - -(define hrule "-----------") - ;; board : string ... -> grid (define (board . ss) - (match-define - (list r1 r2 r3 (== hrule) - r4 r5 r6 (== hrule) - r7 r8 r9) - ss) - (define rs - (list r1 r2 r3 r4 r5 r6 r7 r8 r9)) - (flatten - (for/list ([r (in-list rs)] - [y (in-naturals)]) - (parse-row y r)))) + (for*/fold ([cells null] + #:result (reverse cells)) + ([str (in-list ss)] + [c (in-port read-char (open-input-string str))] + #:unless (memv c '(#\- #\|))) + (define-values (row col) (quotient/remainder (length cells) 9)) + (cons (cell col row (cond + [(string->number (string c)) => seteq] + [else anything])) cells))) -(define (parse-row y r) - (for/list ([c (in-string r)] - [i (in-naturals)]) - (cond - [(or (= i 3) (= i 7)) - (if (char=? c #\|) - empty - (error 'parse-row))] - [else - (define x - (cond [(< i 3) (- i 0)] - [(< i 7) (- i 1)] - [ else (- i 2)])) - (parse-cell y x c)]))) - -(define (parse-cell y x c) - (cell x y - (if (char=? #\space c) - anything - (seteq (string->number (string c)))))) (define (propagate-one top cs) (let/ec return @@ -69,7 +44,7 @@ (when (cell-solved? top) (define-values (changed? ncs) (for/fold ([changed? #f] [ncs empty]) - ([c (in-list cs)]) + ([c (in-list cs)]) (cond [(neighbor-of? top c) (define before @@ -78,12 +53,12 @@ (set-subtract before (cell-can-be top))) (if (= (set-count before) (set-count after)) - (values changed? - (cons c ncs)) - (values #t - (cons (struct-copy cell c - [can-be after]) - ncs)))] + (values changed? + (cons c ncs)) + (values #t + (cons (struct-copy cell c + [can-be after]) + ncs)))] [else (values changed? (cons c ncs))]))) (return changed? top ncs)) @@ -94,10 +69,10 @@ (define before (cell-can-be top)) (define after (for/fold ([before before]) - ([c (in-list cs)]) + ([c (in-list cs)]) (if (same-x? top c) - (set-subtract before (cell-can-be c)) - before))) + (set-subtract before (cell-can-be c)) + before))) (when (= (set-count after) 1) (return #t (struct-copy cell top @@ -153,8 +128,8 @@ (define-values (changed? ntop nmore) (f top (append tried more))) (if changed? - (values #t (cons ntop nmore)) - (loop (cons top tried) more))]))) + (values #t (cons ntop nmore)) + (loop (cons top tried) more))]))) (define (propagate g) (find-pivot propagate-one g)) @@ -162,12 +137,12 @@ (define (until-fixed-point f o bad? end-f) (define-values (changed? no) (f o)) (if changed? - (cons - no - (if (bad? no) - (end-f no) - (until-fixed-point f no bad? end-f))) - (end-f o))) + (cons + no + (if (bad? no) + (end-f no) + (until-fixed-point f no bad? end-f))) + (end-f o))) (define (solved? g) (andmap (λ (c) (= (set-count (cell-can-be c)) 1)) g)) @@ -178,10 +153,10 @@ ;; solve-it : grid -> (listof grid) (define (solve-it g) (let solve-loop - ([g g] - [backtrack! - (λ (i) - (error 'solve-it "Failed!"))]) + ([g g] + [backtrack! + (λ (i) + (error 'solve-it "Failed!"))]) (define (done? g) (cond [(solved? g) @@ -236,14 +211,14 @@ (define (draw-can-be can-be) (define (figi i) (if (set-member? can-be i) - (fig (number->string i)) - (fig " "))) + (fig (number->string i)) + (fig " "))) (place-image/align (if (= 1 (set-count can-be)) - (scale 3 (fig (number->string (set-first can-be)))) - (above (beside (figi 1) (figi 2) (figi 3)) - (beside (figi 4) (figi 5) (figi 6)) - (beside (figi 7) (figi 8) (figi 9)))) + (scale 3 (fig (number->string (set-first can-be)))) + (above (beside (figi 1) (figi 2) (figi 3)) + (beside (figi 4) (figi 5) (figi 6)) + (beside (figi 7) (figi 8) (figi 9)))) 0 0 "left" "top" (rectangle CELL-W CELL-H @@ -254,7 +229,7 @@ (for/fold ([i (empty-scene (* CELL-W 11) (* CELL-H 11))]) - ([c (in-list g)]) + ([c (in-list g)]) (match-define (cell x y can-be) c) (place-image/align (draw-can-be can-be) @@ -269,60 +244,58 @@ "left" "top" i))) (big-bang (draw-state 0 empty gs) - (on-tick move-right 1/8) - (on-draw draw-draw-state))) + (on-tick move-right 1/8) + (on-draw draw-draw-state))) ;; Wikipedia Example - (define b1 - (board - "53 | 7 | " - "6 |195| " - " 98| | 6 " - "-----------" - "8 | 6 | 3" - "4 |8 3| 1" - "7 | 2 | 6" - "-----------" - " 6 | |28 " - " |419| 5" - " | 8 | 79")) +(define b1 + (board + "53 | 7 | " + "6 |195| " + " 98| | 6 " + "-----------" + "8 | 6 | 3" + "4 |8 3| 1" + "7 | 2 | 6" + "-----------" + " 6 | |28 " + " |419| 5" + " | 8 | 79")) - ;; "Hard" example - (define b2 - (board - " 7 | 2 | 5" - " 9| 87| 3" - " 6 | | 4 " - "-----------" - " | 6 | 17" - "9 4| |8 6" - "71 | 5 | " - "-----------" - " 9 | | 8 " - "5 |21 |4 " - "4 | 9 | 6 ")) +;; "Hard" example +(define b2 + (board + " 7 | 2 | 5" + " 9| 87| 3" + " 6 | | 4 " + "-----------" + " | 6 | 17" + "9 4| |8 6" + "71 | 5 | " + "-----------" + " 9 | | 8 " + "5 |21 |4 " + "4 | 9 | 6 ")) - ;; "Evil" example - (define b3 - (board - " 8| | 45" - " | 8 |9 " - " 2|4 | " - "-----------" - "5 | 1|76 " - " 1 | 7 | 8 " - " 79|5 | 1" - "-----------" - " | 7|4 " - " 7| 6 | " - "65 | |3 ")) +;; "Evil" example +(define b3 + (board + " 8| | 45" + " | 8 |9 " + " 2|4 | " + "-----------" + "5 | 1|76 " + " 1 | 7 | 8 " + " 79|5 | 1" + "-----------" + " | 7|4 " + " 7| 6 | " + "65 | |3 ")) - #;(draw-state-i +#;(draw-state-i (draw-it! (solve-it b2))) - - (require sugar/debug) (time-avg 10 (void (solve-it b1))) (time-avg 10 (void (solve-it b2))) From c6c13bc4865818354eaebd9885c6c239aebc166c Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Fri, 26 Oct 2018 15:27:34 -0700 Subject: [PATCH 198/246] speed --- csp/csp/hacs.rkt | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/csp/csp/hacs.rkt b/csp/csp/hacs.rkt index 74114634..484b7e59 100644 --- a/csp/csp/hacs.rkt +++ b/csp/csp/hacs.rkt @@ -231,7 +231,7 @@ (csp? . -> . (or/c #false (and/c var? (not/c assigned-var?)))) (match (unassigned-vars csp) [(== empty) #false] - [xs (first xs)])) + [uvars (first uvars)])) (define/contract (argmin* proc xs [max-style? #f]) ((procedure? (listof any/c)) (any/c) . ->* . (listof any/c)) @@ -497,6 +497,8 @@ #:inference [inference (or (current-inference) no-inference)]) ((csp?) (#:select-variable procedure? #:order-values procedure? #:inference procedure?) . ->* . generator?) (generator () + (define starting-state-count (state-count prob)) + (define states-examined 0) (define reduce-arity-proc (if (current-arity-reduction) reduce-constraint-arity values)) (let loop ([prob ((if (current-node-consistency) make-nodes-consistent values) prob)]) (match (select-unassigned-variable prob) From 59ae964544172d807bbc969fb8248d851710daf9 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Fri, 26 Oct 2018 17:15:37 -0700 Subject: [PATCH 199/246] more --- csp/csp/hacs-demo-triples.rkt | 15 +- csp/csp/hacs-test-sudoku.rkt | 20 +-- csp/csp/hacs.rkt | 192 ++++++++++++------------ csp/csp/scribblings/csp.scrbl | 265 ++++++++++++++++++++++++++++++---- 4 files changed, 350 insertions(+), 142 deletions(-) diff --git a/csp/csp/hacs-demo-triples.rkt b/csp/csp/hacs-demo-triples.rkt index 8b357e61..654b0389 100644 --- a/csp/csp/hacs-demo-triples.rkt +++ b/csp/csp/hacs-demo-triples.rkt @@ -18,12 +18,9 @@ (time-avg 10 (solve* triples)) -(define (f) - (for*/list ([a (in-range 10 50)] - [b (in-range 10 50)] - #:when (<= a b) - [c (in-range 10 50)] - #:when (and (coprime? a b c) (valid-triple? a b c))) - `((a . ,a) (b . ,b) (c . ,c)))) - -(time-avg 10 (f)) \ No newline at end of file +(for*/list ([a (in-range 10 50)] + [b (in-range 10 50)] + #:when (<= a b) + [c (in-range 10 50)] + #:when (and (coprime? a b c) (valid-triple? a b c))) + (map cons '(a b c) (list a b c))) \ No newline at end of file diff --git a/csp/csp/hacs-test-sudoku.rkt b/csp/csp/hacs-test-sudoku.rkt index f49ec75e..fc07715e 100644 --- a/csp/csp/hacs-test-sudoku.rkt +++ b/csp/csp/hacs-test-sudoku.rkt @@ -1,28 +1,28 @@ #lang debug br (require sugar/debug "hacs.rkt") -(define names (for/list ([i (in-range 81)]) +(define cells (for/list ([i (in-range 81)]) (string->symbol (format "c~a" i)))) (define (make-sudoku) (define sudoku (make-csp)) - (add-vars! sudoku names (range 1 10)) + (add-vars! sudoku cells (range 1 10)) - (define (not= . xs) (= (length xs) (length (remove-duplicates xs =)))) + (define (not= . xs) (not (check-duplicates xs =))) (for ([i (in-range 9)]) - (define row-cells (for/list ([(name idx) (in-indexed names)] + (define row-cells (for/list ([(name idx) (in-indexed cells)] #:when (= (quotient idx 9) i)) name)) (add-pairwise-constraint! sudoku not= row-cells) - (define col-cells (for/list ([(name idx) (in-indexed names)] + (define col-cells (for/list ([(name idx) (in-indexed cells)] #:when (= (remainder idx 9) i)) name)) (add-pairwise-constraint! sudoku not= col-cells)) (for ([i '(0 3 6 27 30 33 54 57 60)]) - (define box-cells (for/list ([j '(0 1 2 9 10 11 18 19 20)]) - (string->symbol (format "c~a" (+ i j))))) + (define box-cells (for/list ([offset '(0 1 2 9 10 11 18 19 20)]) + (string->symbol (format "c~a" (+ i offset))))) (add-pairwise-constraint! sudoku not= box-cells)) sudoku) @@ -35,11 +35,11 @@ (define (board . strs) (define sudoku (make-sudoku)) (define vals - (for*/list ([str strs] - [c (in-port read-char (open-input-string str))] + (for*/list ([str (in-list strs)] + [c (in-string str)] #:unless (memv c '(#\- #\|))) (string->number (string c)))) - (for ([name names] + (for ([name cells] [val vals] #:when val) (add-constraint! sudoku (curry = val) (list name) (string->symbol (format "is-~a" val)))) diff --git a/csp/csp/hacs.rkt b/csp/csp/hacs.rkt index 484b7e59..174756a7 100644 --- a/csp/csp/hacs.rkt +++ b/csp/csp/hacs.rkt @@ -20,7 +20,7 @@ (if (null? argss) (yield (reverse acc)) (for ([arg (car argss)]) - (loop (cdr argss) (cons arg acc)))))))) + (loop (cdr argss) (cons arg acc)))))))) (struct csp (vars constraints) #:mutable #:transparent) (define constraints csp-constraints) @@ -36,7 +36,7 @@ (raise-argument-error 'constraint "csp" prob)) ;; apply proc in many-to-many style (for/and ([args (in-cartesian (map (λ (name) (find-domain prob name)) (constraint-names const)))]) - (apply (constraint-proc const) args)))) + (apply (constraint-proc const) args)))) (define name? symbol?) @@ -57,7 +57,7 @@ (apply add-edge! gr edge) gr)) -(struct var (name domain) #:transparent #:mutable) +(struct var (name domain) #:transparent) (define domain var-domain) (struct checked-variable var (history) #:transparent) @@ -77,19 +77,17 @@ ((name?) ((listof any/c)) . ->* . var?) (var name vals)) -(define/contract (add-vars! prob names-or-procedure [vals-or-procedure empty]) - ((csp? (or/c (listof name?) procedure?)) ((or/c (listof any/c) procedure?)) . ->* . void?) +(define/contract (add-vars! prob names [vals-or-procedure empty]) + ((csp? (listof name?)) ((or/c (listof any/c) procedure?)) . ->* . void?) (for/fold ([vrs (vars prob)] - #:result (set-csp-vars! prob (reverse vrs))) - ([name (in-list (match names-or-procedure - [(? procedure? proc) (proc)] - [names names]))]) + #:result (set-csp-vars! prob vrs)) + ([name (in-list names)]) (when (memq name (map var-name vrs)) (raise-argument-error 'add-vars! "var that doesn't already exist" name)) - (cons (make-var name - (match vals-or-procedure - [(? procedure? proc) (proc)] - [vals vals])) vrs))) + (append vrs (list (make-var name + (match vals-or-procedure + [(? procedure? proc) (proc)] + [vals vals])))))) (define/contract (add-var! prob name [vals-or-procedure empty]) ((csp? name?) ((or/c (listof any/c) procedure?)) . ->* . void?) @@ -99,11 +97,11 @@ ((csp? procedure? (listof (listof name?))) ((or/c #false name?)) . ->* . void?) (set-csp-constraints! prob (append (constraints prob) (for/list ([names (in-list namess)]) - (for ([name (in-list names)]) - (check-name-in-csp! 'add-constraints! prob name)) - (make-constraint names (if proc-name - (procedure-rename proc proc-name) - proc)))))) + (for ([name (in-list names)]) + (check-name-in-csp! 'add-constraints! prob name)) + (make-constraint names (if proc-name + (procedure-rename proc proc-name) + proc)))))) (define/contract (add-pairwise-constraint! prob proc names [proc-name #false]) ((csp? procedure? (listof name?)) (name?) . ->* . void?) @@ -142,7 +140,7 @@ (check-name-in-csp! 'find-var prob name) (for/first ([vr (in-vars prob)] #:when (eq? name (var-name vr))) - vr)) + vr)) (define/contract (find-domain prob name) (csp? name? . -> . (listof any/c)) @@ -185,20 +183,20 @@ (ormap assigned? (constraint-names constraint))) (make-csp (vars prob) (for/list ([const (in-constraints prob)]) - (cond - ;; no point reducing 2-arity functions because they will be consumed by forward checking - [(and (or (not minimum-arity) (<= minimum-arity (constraint-arity const))) - (partially-assigned? const)) - (match-define (constraint cnames proc) const) - ;; pattern is mix of values and boxed symbols (indicating variables to persist) - ;; use boxes here as cheap way to distinguish id symbols from value symbols - (define arity-reduction-pattern (for/list ([cname (in-list cnames)]) - (if (assigned? cname) - (first (find-domain prob cname)) - (box cname)))) - (constraint (filter-not assigned? cnames) - (reduce-function-arity proc arity-reduction-pattern))] - [else const])))) + (cond + ;; no point reducing 2-arity functions because they will be consumed by forward checking + [(and (or (not minimum-arity) (<= minimum-arity (constraint-arity const))) + (partially-assigned? const)) + (match-define (constraint cnames proc) const) + ;; pattern is mix of values and boxed symbols (indicating variables to persist) + ;; use boxes here as cheap way to distinguish id symbols from value symbols + (define arity-reduction-pattern (for/list ([cname (in-list cnames)]) + (if (assigned? cname) + (first (find-domain prob cname)) + (box cname)))) + (constraint (filter-not assigned? cnames) + (reduce-function-arity proc arity-reduction-pattern))] + [else const])))) (define nassns 0) (define nfchecks 0) @@ -213,9 +211,9 @@ (begin0 (make-csp (for/list ([vr (in-vars prob)]) - (if (eq? name (var-name vr)) - (assigned-var name (list val)) - vr)) + (if (eq? name (var-name vr)) + (assigned-var name (list val)) + vr)) (constraints prob)) (when-debug (set! nassns (add1 nassns))))) @@ -245,7 +243,7 @@ (for/list ([x (in-list xs)] [val (in-list vals)] #:when (= val target-val)) - x)])) + x)])) (define/contract (argmax* proc xs) (procedure? (listof any/c) . -> . (listof any/c)) @@ -270,7 +268,7 @@ (csp? var? . -> . natural?) (for/sum ([const (in-constraints prob)] #:when (memq (var-name var) (constraint-names const))) - 1)) + 1)) (define/contract (domain-length var) (var? . -> . natural?) @@ -279,7 +277,7 @@ (define/contract (state-count csp) (csp? . -> . natural?) (for/product ([vr (in-vars csp)]) - (domain-length vr))) + (domain-length vr))) (define/contract (mrv-degree-hybrid prob) (csp? . -> . (or/c #f var?)) @@ -298,8 +296,8 @@ [cnames (in-value (constraint-names const))] #:when (and (= (length names) (length cnames)) (for/and ([name (in-list names)]) - (memq name cnames)))) - const)) + (memq name cnames)))) + const)) (define (one-arity? const) (= 1 (constraint-arity const))) (define (two-arity? const) (= 2 (constraint-arity const))) @@ -313,7 +311,7 @@ ((listof (and/c constraint? two-arity?)) . -> . (listof arc?)) (for*/list ([const (in-list constraints)] [name (in-list (constraint-names const))]) - (arc name const))) + (arc name const))) (require sugar/debug) (define/contract (reduce-domain prob ark) @@ -325,16 +323,16 @@ (λ (val other-val) (constraint-proc other-val val)))) ; otherwise reverse arg order (define (satisfies-arc? val) (for/or ([other-val (in-list (find-domain prob other-name))]) - (proc val other-val))) + (proc val other-val))) (make-csp (for/list ([vr (in-vars prob)]) - (cond - [(assigned-var? vr) vr] - [(eq? name (var-name vr)) - (make-var name (match (filter satisfies-arc? (domain vr)) - [(? empty?) (backtrack!)] - [vals vals]))] - [else vr])) + (cond + [(assigned-var? vr) vr] + [(eq? name (var-name vr)) + (make-var name (match (filter satisfies-arc? (domain vr)) + [(? empty?) (backtrack!)] + [vals vals]))] + [else vr])) (constraints prob))) (define/contract (terminating-at? arcs name) @@ -343,7 +341,7 @@ #:when (and (memq name (constraint-names (arc-const arc))) (not (eq? name (arc-name arc))))) - arc)) + arc)) (define/contract (ac-3 prob ref-name) (csp? name? . -> . csp?) @@ -353,8 +351,8 @@ (define starting-arcs (two-arity-constraints->arcs (for/list ([const (in-constraints prob)] #:when (and (two-arity? const) (for/and ([cname (in-list (constraint-names const))]) - (memq cname checkable-names)))) - const))) + (memq cname checkable-names)))) + const))) (for/fold ([prob prob] [arcs (sort starting-arcs < #:key (λ (a) (length (find-domain prob (arc-name a)))) #:cache-keys? #true)] #:result (prune-singleton-constraints prob)) @@ -385,11 +383,11 @@ (define new-vals (for/list ([val (in-list vals)] #:when (for/and ([const (in-list constraints)]) - (let ([proc (constraint-proc const)]) - (if (eq? name (first (constraint-names const))) - (proc val ref-val) - (proc ref-val val))))) - val)) + (let ([proc (constraint-proc const)]) + (if (eq? name (first (constraint-names const))) + (proc val ref-val) + (proc ref-val val))))) + val)) (checked-variable name new-vals (cons (cons ref-name ref-val) (match vr [(checked-variable _ _ history) history] [else null])))])])) @@ -398,15 +396,15 @@ ((csp?) ((or/c #false name?)) . ->* . csp?) (define singleton-var-names (for/list ([vr (in-vars prob)] #:when (singleton-var? vr)) - (var-name vr))) + (var-name vr))) (make-csp (vars prob) (for/list ([const (in-constraints prob)] #:unless (and (two-arity? const) (or (not ref-name) (constraint-relates? const ref-name)) (for/and ([cname (in-list (constraint-names const))]) - (memq cname singleton-var-names)))) - const))) + (memq cname singleton-var-names)))) + const))) (define/contract (forward-check prob ref-name) (csp? name? . -> . csp?) @@ -415,7 +413,7 @@ ;; conflict-set will be empty if there are no empty domains (as we would hope) (define conflict-set (for/list ([cvr (in-list checked-vars)] #:when (empty? (domain cvr))) - (history cvr))) + (history cvr))) ;; for conflict-directed backjumping it's essential to forward-check ALL vars ;; (even after an empty domain is generated) and combine their conflicts ;; so we can discover the *most recent past var* that could be the culprit. @@ -432,7 +430,7 @@ ;; constraint is checkable if all constraint names ;; are in target list of names. (for/and ([cname (in-list (constraint-names const))]) - (memq cname names))) + (memq cname names))) (define/contract (constraint-arity const) (constraint? . -> . natural?) @@ -449,21 +447,21 @@ (partition (λ (const) (and (constraint-checkable? const assigned-varnames) (or (not mandatory-names) (for/and ([name (in-list mandatory-names)]) - (constraint-relates? const name))))) + (constraint-relates? const name))))) (constraints prob))) (cond [conflict-count? (define conflict-count (for/sum ([constraint (in-list checkable-consts)] #:unless (constraint prob)) - 1)) + 1)) (when-debug (set! nchecks (+ conflict-count nchecks))) conflict-count] [else (for ([(constraint idx) (in-indexed checkable-consts)] #:unless (constraint prob)) - (when-debug (set! nchecks (+ (add1 idx) nchecks))) - (backtrack!)) + (when-debug (set! nchecks (+ (add1 idx) nchecks))) + (backtrack!)) ;; discard checked constraints, since they have no further reason to live (make-csp (vars prob) other-consts)])) @@ -475,26 +473,26 @@ prob (make-csp (for/list ([vr (in-vars prob)]) - (match-define (var name vals) vr) - (define name-constraints (filter (λ (const) (constraint-relates? const name)) unary-constraints)) - (make-var name (for/list ([val (in-list vals)] - #:when (for/and ([const (in-list name-constraints)]) - ((constraint-proc const) val))) - val))) + (match-define (var name vals) vr) + (define name-constraints (filter (λ (const) (constraint-relates? const name)) unary-constraints)) + (make-var name (for/list ([val (in-list vals)] + #:when (for/and ([const (in-list name-constraints)]) + ((constraint-proc const) val))) + val))) other-constraints))) (define ((make-hist-proc assocs) . xs) (not (for/and ([x (in-list xs)] [val (in-list (map cdr assocs))]) - (equal? x val)))) + (equal? x val)))) (define/contract (backtracking-solver prob #:select-variable [select-unassigned-variable (or (current-select-variable) first-unassigned-variable)] #:order-values [order-domain-values (or (current-order-values) first-domain-value)] - #:inference [inference (or (current-inference) no-inference)]) + #:inference [inference (or (current-inference) forward-check)]) ((csp?) (#:select-variable procedure? #:order-values procedure? #:inference procedure?) . ->* . generator?) (generator () (define starting-state-count (state-count prob)) @@ -508,7 +506,7 @@ (and (backtrack? exn) (or (let ([bths (backtrack-histories exn)]) (or (empty? bths) (for*/or ([bth bths] [rec bth]) - (eq? name (car rec)))))))) + (eq? name (car rec)))))))) (for/fold ([conflicts null] #:result (void)) ([val (in-list (order-domain-values domain))]) @@ -518,7 +516,7 @@ (append conflicts (remq name (remove-duplicates (for*/list ([bth bths] [rec bth]) - (car rec)) eq?))))]) + (car rec)) eq?))))]) (let* ([prob (assign-val prob name val)] ;; reduce constraints before inference, ;; to create more forward-checkable (binary) constraints @@ -558,9 +556,9 @@ ((csp?) (integer?) . ->* . generator?) (generator () (for ([thread-count (or (current-thread-count) 1)]) ; todo: what is ideal thread count? - (make-min-conflcts-thread prob thread-count max-steps)) + (make-min-conflcts-thread prob thread-count max-steps)) (for ([i (in-naturals)]) - (yield (thread-receive))))) + (yield (thread-receive))))) (define/contract (optimal-stop-min proc xs) (procedure? (listof any/c) . -> . any/c) @@ -568,7 +566,7 @@ (define threshold (argmin proc sample)) (or (for/first ([candidate (in-list candidates)] #:when (<= (proc candidate) threshold)) - candidate) + candidate) (last candidates))) (define/contract (conflicted-variable-names prob) @@ -576,7 +574,7 @@ ;; Return a list of variables in current assignment that are conflicted (for/list ([name (in-var-names prob)] #:when (positive? (nconflicts prob name))) - name)) + name)) (define/contract (min-conflicts-value prob name vals) (csp? name? (listof any/c) . -> . any/c) @@ -585,7 +583,7 @@ #:cache-keys? #true)) (for/first ([val (in-list vals-by-conflict)] #:unless (equal? val (first (find-domain prob name)))) ;; but change the value - val)) + val)) (define no-value-sig (gensym)) @@ -600,11 +598,11 @@ ((csp?) ((listof name?)) . ->* . (listof (cons/c name? any/c))) (define assocs (for/list ([vr (in-vars prob)]) - (match vr - [(var name (list val)) (cons name val)]))) + (match vr + [(var name (list val)) (cons name val)]))) (if keys (for/list ([key (in-list keys)]) - (assq key assocs)) + (assq key assocs)) assocs)) (define/contract (combine-csps probs) @@ -619,42 +617,42 @@ (make-csp (for/list ([vr (in-vars prob)] #:when (memq (var-name vr) names)) - vr) + vr) (for/list ([const (in-constraints prob)] #:when (for/and ([cname (in-list (constraint-names const))]) - (memq cname names))) - const))) + (memq cname names))) + const))) (define/contract (solve* prob #:finish-proc [finish-proc (λ (p) (csp->assocs p (map var-name (vars prob))))] #:solver [solver (or (current-solver) backtracking-solver)] - #:limit [max-solutions +inf.0]) - ((csp?) (#:finish-proc procedure? #:solver procedure? #:limit natural?) + #:count [max-solutions +inf.0]) + ((csp?) (#:finish-proc procedure? #:solver procedure? #:count natural?) . ->* . (listof any/c)) (when-debug (reset-nassns!) (reset-nfchecks!) (reset-nchecks!)) (define subcsps ; decompose into independent csps. `cc` determines "connected components" (if (current-decompose) (for/list ([nodeset (in-list (cc (csp->graph prob)))]) - (extract-subcsp prob nodeset)) + (extract-subcsp prob nodeset)) (list prob))) (define solgens (map solver subcsps)) (define solstreams (for/list ([solgen (in-list solgens)]) - (for/stream ([sol (in-producer solgen (void))]) - sol))) + (for/stream ([sol (in-producer solgen (void))]) + sol))) (for/list ([solution-pieces (in-cartesian solstreams)] [idx (in-range max-solutions)]) - (finish-proc (combine-csps solution-pieces)))) + (finish-proc (combine-csps solution-pieces)))) (define/contract (solve prob #:finish-proc [finish-proc (λ (p) (csp->assocs p (map var-name (vars prob))))] #:solver [solver (or (current-solver) backtracking-solver)] - #:limit [max-solutions 1]) - ((csp?) (#:finish-proc procedure? #:solver procedure? #:limit natural?) + #:count [max-solutions 1]) + ((csp?) (#:finish-proc procedure? #:solver procedure? #:count natural?) . ->* . (or/c #false any/c)) - (match (solve* prob #:finish-proc finish-proc #:solver solver #:limit max-solutions) + (match (solve* prob #:finish-proc finish-proc #:solver solver #:count max-solutions) [(list solution) solution] [(list) #false] [(list solutions ...) solutions])) diff --git a/csp/csp/scribblings/csp.scrbl b/csp/csp/scribblings/csp.scrbl index 2f14be48..f04e6760 100644 --- a/csp/csp/scribblings/csp.scrbl +++ b/csp/csp/scribblings/csp.scrbl @@ -1,10 +1,13 @@ #lang scribble/manual -@(require scribble/eval (for-label racket csp (except-in math/number-theory permutations))) +@(require (except-in scribble/eval examples) scribble/example (for-label racket csp graph (except-in math/number-theory permutations))) @(define my-eval (make-base-eval)) @(my-eval `(require csp racket/list)) +@(define-syntax-rule (my-examples ARG ...) +(examples #:label #f #:eval my-eval ARG ...)) + @title{Constraint-satisfaction problems} @author[(author+email "Matthew Butterick" "mb@mbtype.com")] @@ -28,72 +31,72 @@ Import into your program like so: @section{Introduction} -A @deftech{constraint-satisfaction problem} (often shortened to @deftech{CSP}) has two ingredients. The first is a set of @deftech{variables}, each associated with a set of possible values (called a @deftech{domain}). The other is a set of @deftech{constraints} that define relationships between the variables. +A @deftech{constraint-satisfaction problem} (often shortened to @deftech{CSP}) has two ingredients. The first is a set of @deftech{variables}, each associated with a set of possible values (called its @deftech{domain}). The other is a set of @deftech{constraints} — a fancy word for @italic{rules} — that describe relationships among the variables. -Solving a CSP means finding a value for each variable from its domain that @deftech{satisfies} (that is, doesn't violate) any constraints. This selection of values is also known as an @deftech{assignment}. A CSP may have any number of assignments that solve the problem (including zero). +When we select a value for each variable, we have what's known as an @deftech{assignment} or a @deftech{state}. Solving a CSP means finding an assignment that @deftech{satisfies} all the constraints. A CSP may have any number of solution states (including zero). Even if the name is new, the idea of a CSP is probably familiar. For instance, many brain teasers — like Sudoku or crosswords or logic puzzles — are really just constraint-satisfaction problems. (Indeed, you can use this package to ruin all of them.) When the computer solves a CSP, it's using an analogous process of deductive reasoning to eliminate impossible assignments, eventually converging on a solution (or determining that no solution exists). -@section{Example} +@section{First example} Suppose we wanted to find @link["http://www.friesian.com/pythag.htm"]{Pythagorean triples} with sides between 10 and 49, inclusive. First we create a new CSP called @racket[triples], using @racket[make-csp]: -@examples[#:eval my-eval +@examples[#:label #f #:eval my-eval (define triples (make-csp)) ] -Then we need variables to represent the values in the triple. For that, we use @racket[add-var!], where each variable has a @tech{symbol} for its name and a list of values for its domain: +We use CSP variables to represent the values in the triple. We insert each one with @racket[add-var!], where each variable has a @tech{symbol} for its name and a list of values for its domain: -@examples[#:eval my-eval +@examples[#:label #f #:eval my-eval (add-var! triples 'a (range 10 50)) (add-var! triples 'b (range 10 50)) (add-var! triples 'c (range 10 50)) ] -Then we need our constraint. We make a function called @racket[valid-triple?] that tests three values to see if they qualify as a Pythagorean triple. Then we insert this function as a constraint using @racket[add-constraint!], where we pass in the function we want to use for the constraint, and a list of variable names that the constraint applies to. +Then we need our constraint. We make a function called @racket[valid-triple?] that tests three values to see if they qualify as a Pythagorean triple. Then we insert this function as a constraint using @racket[add-constraint!], passing as arguments 1) the function we want to use for the constraint, and 2) a list of variable names that the constraint applies to. -@examples[#:eval my-eval +@examples[#:label #f #:eval my-eval (define (valid-triple? x y z) (= (expt z 2) (+ (expt x 2) (expt y 2)))) (add-constraint! triples valid-triple? '(a b c)) ] -The argument names used within the constraint function have nothing to do with the CSP variable names that are passed to the function. This makes sense — we might want constraints that apply the same function to different groups of CSP variables. What's important is that the @tech{arity} of the constraint matches the number of variable names. +Notice that the argument names used within the constraint function (@racket[x] @racket[y] @racket[z]) have nothing to do with the CSP variable names that are passed to the function @racket['(a b c)]. This makes sense — we might want constraints that apply the same function to different groups of CSP variables. What's important is that the @tech{arity} of the constraint function matches the number of variable names, and that the variable names are ordered correctly (the first variable will become the first argument to the constraint function, and so on). Finally we call @racket[solve], which finds a solution (if it exists): -@examples[#:eval my-eval +@examples[#:label #f #:eval my-eval (solve triples) ] -``But that's just the 5--12--13 triple, doubled.'' True. If we wanted to ensure that the values in our solution have no common factors, we can add a new @racket[coprime?] constraint: +``But that's just the 5--12--13 triple, doubled.'' True. Suppose we want to ensure that the values in our solution have no common factors. We add a new @racket[coprime?] constraint: -@examples[#:eval my-eval +@examples[#:label #f #:eval my-eval (require math/number-theory) (add-constraint! triples coprime? '(a b c)) ] -And we can @racket[solve] again to see the new result: +We @racket[solve] again to see the new result: -@examples[#:eval my-eval +@examples[#:label #f #:eval my-eval (solve triples) ] -Maybe we become curious to see how many of these triples exist. We can use @racket[solve*] to find all four solutions: +Perhaps we're curious to see how many of these triples exist. We use @racket[solve*] to find all four solutions: -@examples[#:eval my-eval +@examples[#:label #f #:eval my-eval (solve* triples) ] ``But really there's only two solutions — the values for @racket[a] and @racket[b] are swapped in the other two.'' Fair enough. We might say that this problem is @deftech{symmetric} relative to variables @racket[a] and @racket[b], because they have the same domains and are constrained the same way. We can break the symmetry by adding a constraint that forces @racket[a] to be less than or equal to @racket[b]: -@examples[#:eval my-eval +@examples[#:label #f #:eval my-eval (add-constraint! triples <= '(a b)) (solve* triples) @@ -103,32 +106,32 @@ Now our list of solutions doesn't have any symmetric duplicates. By the way, what if we had accidentally included @racket[c] in the last constraint? -@examples[#:eval my-eval +@examples[#:label #f #:eval my-eval (add-constraint! triples <= '(a b c)) (solve* triples) ] -Nothing changes. Why? Because @racket[c] is necessarily going to be larger because of the existing @racket[valid-triple?] constraint, so it always meets this constraint too. Still, it's good practice to minimize constraints — no need for the ``belt and suspenders'' approach. +Nothing changes. Why not? Because of the existing @racket[valid-triple?] constraint, @racket[c] is necessarily going to be larger than @racket[a] and @racket[b]. So it always meets this constraint too. But generally, it's good practice to minimize constraints — no need for the ``belt and suspenders'' approach. We should use @racket[solve*] with care. It can't finish until the CSP solver examines every possible assignment of values in the problem, which can be a big number. Specifically, it's the product of the domain sizes of each variable, which in this case is 40 × 40 × 40 = 64,000. This realm of possible assignments is also known as the CSP's @deftech{state space}. We can also get this number from @racket[state-count]: -@examples[#:eval my-eval +@examples[#:label #f #:eval my-eval (state-count triples) ] -It's easy for a CSP to have a state count in the zillions. For this reason we can supply @racket[solve*] with an optional @racket[#:limit] argument that will only generate a certain number of solutions: +It's easy for a CSP to have a state count in the zillions. For this reason we can supply @racket[solve*] with an optional @racket[#:count] argument that will only generate a certain number of solutions: -@examples[#:eval my-eval +@examples[#:label #f #:eval my-eval (time (solve* triples)) -(time (solve* triples #:limit 2)) +(time (solve* triples #:count 2)) ] Here, the answers are the same. But the second call to @racket[solve*] finishes sooner, because it quits as soon as it's found two solutions. -Of course, when we use ordinary @racket[solve], we don't know how many assignments it will have to try before it finds a solution. If the problem is impossible, even @racket[solve] will have to examine every possible assignment before it knows for sure. For instance, let's see what happens if we add a constraint that's impossible to meet: +Of course, even when we use ordinary @racket[solve], we don't know how many assignments it will have to try before it finds a solution. If the problem is impossible, even @racket[solve] will have to visit the entire state space before it knows for sure. For instance, let's see what happens if we add a constraint that's impossible to meet: -@examples[#:eval my-eval +@examples[#:label #f #:eval my-eval (add-constraint! triples = '(a b c)) (solve triples) @@ -136,17 +139,227 @@ Of course, when we use ordinary @racket[solve], we don't know how many assignmen Disappointing but accurate. +The whole example in one block: + +@racketblock[ +(require csp) + +(define triples (make-csp)) + +(add-var! triples 'a (range 10 50)) +(add-var! triples 'b (range 10 50)) +(add-var! triples 'c (range 10 50)) + +(define (valid-triple? x y z) + (= (expt z 2) (+ (expt x 2) (expt y 2)))) +(add-constraint! triples valid-triple? '(a b c)) + +(require math/number-theory) +(add-constraint! triples coprime? '(a b c)) + +(add-constraint! triples <= '(a b)) + +(solve* triples #:count 2) +] + +@section{Interlude} + +``Dude, are you kidding me? I can write a much shorter loop to do the same thing—" + +@my-examples[ +(for*/list ([a (in-range 10 50)] + [b (in-range 10 50)] + #:when (<= a b) + [c (in-range 10 50)] + #:when (and (coprime? a b c) (valid-triple? a b c))) + (map cons '(a b c) (list a b c))) +] + +Yes, I agree that in this toy example, the CSP approach is overkill. The variables are few enough, the domains small enough, and the constraints simple enough, that a loop is more concise. Also, with only 64,000 possibilities in the state space, this sort of brute-force approach is cheap & cheerful. + +@section{Second example} + +But what about a more complicated problem — like a Sudoku? A Sudoku has 81 squares, each of which can hold the digits 1 through 9. The goal in Sudoku is to fill the grid so that no row, no column, and no ``box'' (a 3 × 3 subgroup of cells) has a duplicate digit. About 25 of the squares are filled in at the start, so the size of the state space is therefore: + +@my-examples[ +(expt 9 (- 81 25)) +] +Well over a zillion, certainly. Let's optimistically suppose that the 3.7GHz processor in your computer takes one cycle to check an assignment. There are 31,557,600 seconds in a year, so the brute-force method will only take this many years: + +@my-examples[ +(define states (expt 9 (- 81 25))) +(define states-per-second (* 3.7 1e9)) +(define seconds-per-year 31557600) +(/ states states-per-second seconds-per-year) +] + + +@section{Another interlude} + +``Dude, are you serious? The JMAXX Sudoku Solver runs three to four times faster—'' + +@racketblock[ +;; TK +] + +Yes, I agree that an algorithm custom-tailored to the problem will likely beat the CSP solver, which is necessarily general-purpose. + +But let's consider the labor involved. To write something like the JMAXX Sudoku Solver, we'd need a PhD in computer science, and the time to explain not just the rules of Sudoku to the computer, but the process for solving a Sudoku. + +By contrast, when we use a CSP, @italic{all we need are the rules}. The CSP solver does the rest. In this way, a CSP gives us an alternative, simpler way to explain Sudoku to the computer, just like regular expressions are an alternate way of expressing string patterns. And if the CSP solver is half a second slower, that seems like a reasonable tradeoff. + +@margin-note{Daring minds might even consider a CSP solver to be a kind of domain-specific language.} + @section{Making & solving CSPs} +@defstruct[csp ([vars (listof var?)] + [constraints (listof constraint?)]) + #:transparent]{ +TK +} + +@defstruct[var ([name name?] + [domain (listof any/c)]) + #:transparent]{ +TK +} + +@defstruct[constraint ([names (listof name?)] + [proc procedure?]) + #:transparent]{ +TK +} + + +@defproc[(make-csp [vars (listof var?) null] + [constraints (listof constraint?) empty]) + csp?]{ +TK +} + + +@deftogether[( +@defproc[(add-var! +[prob csp?] +[name name?] +[domain (or/c (listof any/c) procedure?) empty]) +void?] +@defproc[(add-vars! +[prob csp?] +[names (listof name?)] +[domain (or/c (listof any/c) procedure?) empty]) +void?] +)]{ +TK +} + +@deftogether[( +@defproc[(add-constraint! +[prob csp?] +[func procedure?] +[names (listof name?)] +[func-name (or/c #false name?) #f]) +void?] +@defproc[(add-constraints! +[prob csp?] +[func procedure?] +[namess (listof (listof name?))] +[func-name (or/c #false name?) #f]) +void?] +)]{ +TK +} + +@defproc[(add-pairwise-constraint! +[prob csp?] +[func procedure?] +[names (listof name?)] +[func-name (or/c #false name?) #f]) +void?]{ +TK +} + +@defproc[(solve +[prob csp?] +[#:count count natural? 1]) +(or/c #false any/c (listof any/c))]{ +TK +} + +@defproc[(solve* +[prob csp?] +[#:count count natural? +inf.0]) +(listof any/c)]{ +TK +} + + @section{Sideshows} +@defproc[(state-count +[prob csp?]) +natural?]{ +TK +} + +@defproc[(csp->graph +[prob csp?]) +graph?]{ +TK +} + +@defproc[(csp->graphviz +[prob csp?]) +string?]{ +TK +} @section{Parameters} +@defparam[current-select-variable val (or/c #false procedure?) #:value #f]{ +TK +} + +@defparam[current-order-values val (or/c #false procedure?) #:value #f]{ +TK +} + +@defparam[current-inference val (or/c #false procedure?) #:value #f]{ +TK +} + +@defparam[current-solver val (or/c #false procedure?) #:value #f]{ +TK +} + +@defparam[current-random val (or/c #false procedure?) #:value #t]{ +TK +} + +@defparam[current-decompose val (or/c #false procedure?) #:value #t]{ +TK +} + +@defparam[current-thread-count val (or/c #false natural?) #:value 4]{ +TK +} + +@defparam[current-node-consistency val (or/c #false procedure?) #:value #f]{ +TK +} + +@defparam[current-arity-reduction val (or/c #false procedure?) #:value #t]{ +TK +} + +@defparam[current-learning val (or/c #false procedure?) #:value #f]{ +TK +} + @section{License & source code} From 286465fd8e3a3dbe0a09733a83c4b6969b389190 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Fri, 26 Oct 2018 18:30:58 -0700 Subject: [PATCH 200/246] oops --- csp/csp/hacs.rkt | 166 ++++++++++++++++++++++++----------------------- 1 file changed, 84 insertions(+), 82 deletions(-) diff --git a/csp/csp/hacs.rkt b/csp/csp/hacs.rkt index 174756a7..c37bd10a 100644 --- a/csp/csp/hacs.rkt +++ b/csp/csp/hacs.rkt @@ -20,7 +20,7 @@ (if (null? argss) (yield (reverse acc)) (for ([arg (car argss)]) - (loop (cdr argss) (cons arg acc)))))))) + (loop (cdr argss) (cons arg acc)))))))) (struct csp (vars constraints) #:mutable #:transparent) (define constraints csp-constraints) @@ -36,7 +36,7 @@ (raise-argument-error 'constraint "csp" prob)) ;; apply proc in many-to-many style (for/and ([args (in-cartesian (map (λ (name) (find-domain prob name)) (constraint-names const)))]) - (apply (constraint-proc const) args)))) + (apply (constraint-proc const) args)))) (define name? symbol?) @@ -97,11 +97,11 @@ ((csp? procedure? (listof (listof name?))) ((or/c #false name?)) . ->* . void?) (set-csp-constraints! prob (append (constraints prob) (for/list ([names (in-list namess)]) - (for ([name (in-list names)]) - (check-name-in-csp! 'add-constraints! prob name)) - (make-constraint names (if proc-name - (procedure-rename proc proc-name) - proc)))))) + (for ([name (in-list names)]) + (check-name-in-csp! 'add-constraints! prob name)) + (make-constraint names (if proc-name + (procedure-rename proc proc-name) + proc)))))) (define/contract (add-pairwise-constraint! prob proc names [proc-name #false]) ((csp? procedure? (listof name?)) (name?) . ->* . void?) @@ -140,7 +140,7 @@ (check-name-in-csp! 'find-var prob name) (for/first ([vr (in-vars prob)] #:when (eq? name (var-name vr))) - vr)) + vr)) (define/contract (find-domain prob name) (csp? name? . -> . (listof any/c)) @@ -183,20 +183,20 @@ (ormap assigned? (constraint-names constraint))) (make-csp (vars prob) (for/list ([const (in-constraints prob)]) - (cond - ;; no point reducing 2-arity functions because they will be consumed by forward checking - [(and (or (not minimum-arity) (<= minimum-arity (constraint-arity const))) - (partially-assigned? const)) - (match-define (constraint cnames proc) const) - ;; pattern is mix of values and boxed symbols (indicating variables to persist) - ;; use boxes here as cheap way to distinguish id symbols from value symbols - (define arity-reduction-pattern (for/list ([cname (in-list cnames)]) - (if (assigned? cname) - (first (find-domain prob cname)) - (box cname)))) - (constraint (filter-not assigned? cnames) - (reduce-function-arity proc arity-reduction-pattern))] - [else const])))) + (cond + ;; no point reducing 2-arity functions because they will be consumed by forward checking + [(and (or (not minimum-arity) (<= minimum-arity (constraint-arity const))) + (partially-assigned? const)) + (match-define (constraint cnames proc) const) + ;; pattern is mix of values and boxed symbols (indicating variables to persist) + ;; use boxes here as cheap way to distinguish id symbols from value symbols + (define arity-reduction-pattern (for/list ([cname (in-list cnames)]) + (if (assigned? cname) + (first (find-domain prob cname)) + (box cname)))) + (constraint (filter-not assigned? cnames) + (reduce-function-arity proc arity-reduction-pattern))] + [else const])))) (define nassns 0) (define nfchecks 0) @@ -211,9 +211,9 @@ (begin0 (make-csp (for/list ([vr (in-vars prob)]) - (if (eq? name (var-name vr)) - (assigned-var name (list val)) - vr)) + (if (eq? name (var-name vr)) + (assigned-var name (list val)) + vr)) (constraints prob)) (when-debug (set! nassns (add1 nassns))))) @@ -243,7 +243,7 @@ (for/list ([x (in-list xs)] [val (in-list vals)] #:when (= val target-val)) - x)])) + x)])) (define/contract (argmax* proc xs) (procedure? (listof any/c) . -> . (listof any/c)) @@ -268,7 +268,7 @@ (csp? var? . -> . natural?) (for/sum ([const (in-constraints prob)] #:when (memq (var-name var) (constraint-names const))) - 1)) + 1)) (define/contract (domain-length var) (var? . -> . natural?) @@ -277,7 +277,7 @@ (define/contract (state-count csp) (csp? . -> . natural?) (for/product ([vr (in-vars csp)]) - (domain-length vr))) + (domain-length vr))) (define/contract (mrv-degree-hybrid prob) (csp? . -> . (or/c #f var?)) @@ -296,8 +296,8 @@ [cnames (in-value (constraint-names const))] #:when (and (= (length names) (length cnames)) (for/and ([name (in-list names)]) - (memq name cnames)))) - const)) + (memq name cnames)))) + const)) (define (one-arity? const) (= 1 (constraint-arity const))) (define (two-arity? const) (= 2 (constraint-arity const))) @@ -311,7 +311,7 @@ ((listof (and/c constraint? two-arity?)) . -> . (listof arc?)) (for*/list ([const (in-list constraints)] [name (in-list (constraint-names const))]) - (arc name const))) + (arc name const))) (require sugar/debug) (define/contract (reduce-domain prob ark) @@ -323,16 +323,16 @@ (λ (val other-val) (constraint-proc other-val val)))) ; otherwise reverse arg order (define (satisfies-arc? val) (for/or ([other-val (in-list (find-domain prob other-name))]) - (proc val other-val))) + (proc val other-val))) (make-csp (for/list ([vr (in-vars prob)]) - (cond - [(assigned-var? vr) vr] - [(eq? name (var-name vr)) - (make-var name (match (filter satisfies-arc? (domain vr)) - [(? empty?) (backtrack!)] - [vals vals]))] - [else vr])) + (cond + [(assigned-var? vr) vr] + [(eq? name (var-name vr)) + (make-var name (match (filter satisfies-arc? (domain vr)) + [(? empty?) (backtrack!)] + [vals vals]))] + [else vr])) (constraints prob))) (define/contract (terminating-at? arcs name) @@ -341,7 +341,7 @@ #:when (and (memq name (constraint-names (arc-const arc))) (not (eq? name (arc-name arc))))) - arc)) + arc)) (define/contract (ac-3 prob ref-name) (csp? name? . -> . csp?) @@ -351,8 +351,8 @@ (define starting-arcs (two-arity-constraints->arcs (for/list ([const (in-constraints prob)] #:when (and (two-arity? const) (for/and ([cname (in-list (constraint-names const))]) - (memq cname checkable-names)))) - const))) + (memq cname checkable-names)))) + const))) (for/fold ([prob prob] [arcs (sort starting-arcs < #:key (λ (a) (length (find-domain prob (arc-name a)))) #:cache-keys? #true)] #:result (prune-singleton-constraints prob)) @@ -383,11 +383,11 @@ (define new-vals (for/list ([val (in-list vals)] #:when (for/and ([const (in-list constraints)]) - (let ([proc (constraint-proc const)]) - (if (eq? name (first (constraint-names const))) - (proc val ref-val) - (proc ref-val val))))) - val)) + (let ([proc (constraint-proc const)]) + (if (eq? name (first (constraint-names const))) + (proc val ref-val) + (proc ref-val val))))) + val)) (checked-variable name new-vals (cons (cons ref-name ref-val) (match vr [(checked-variable _ _ history) history] [else null])))])])) @@ -396,15 +396,15 @@ ((csp?) ((or/c #false name?)) . ->* . csp?) (define singleton-var-names (for/list ([vr (in-vars prob)] #:when (singleton-var? vr)) - (var-name vr))) + (var-name vr))) (make-csp (vars prob) (for/list ([const (in-constraints prob)] #:unless (and (two-arity? const) (or (not ref-name) (constraint-relates? const ref-name)) (for/and ([cname (in-list (constraint-names const))]) - (memq cname singleton-var-names)))) - const))) + (memq cname singleton-var-names)))) + const))) (define/contract (forward-check prob ref-name) (csp? name? . -> . csp?) @@ -413,7 +413,7 @@ ;; conflict-set will be empty if there are no empty domains (as we would hope) (define conflict-set (for/list ([cvr (in-list checked-vars)] #:when (empty? (domain cvr))) - (history cvr))) + (history cvr))) ;; for conflict-directed backjumping it's essential to forward-check ALL vars ;; (even after an empty domain is generated) and combine their conflicts ;; so we can discover the *most recent past var* that could be the culprit. @@ -430,7 +430,7 @@ ;; constraint is checkable if all constraint names ;; are in target list of names. (for/and ([cname (in-list (constraint-names const))]) - (memq cname names))) + (memq cname names))) (define/contract (constraint-arity const) (constraint? . -> . natural?) @@ -447,21 +447,21 @@ (partition (λ (const) (and (constraint-checkable? const assigned-varnames) (or (not mandatory-names) (for/and ([name (in-list mandatory-names)]) - (constraint-relates? const name))))) + (constraint-relates? const name))))) (constraints prob))) (cond [conflict-count? (define conflict-count (for/sum ([constraint (in-list checkable-consts)] #:unless (constraint prob)) - 1)) + 1)) (when-debug (set! nchecks (+ conflict-count nchecks))) conflict-count] [else (for ([(constraint idx) (in-indexed checkable-consts)] #:unless (constraint prob)) - (when-debug (set! nchecks (+ (add1 idx) nchecks))) - (backtrack!)) + (when-debug (set! nchecks (+ (add1 idx) nchecks))) + (backtrack!)) ;; discard checked constraints, since they have no further reason to live (make-csp (vars prob) other-consts)])) @@ -473,19 +473,19 @@ prob (make-csp (for/list ([vr (in-vars prob)]) - (match-define (var name vals) vr) - (define name-constraints (filter (λ (const) (constraint-relates? const name)) unary-constraints)) - (make-var name (for/list ([val (in-list vals)] - #:when (for/and ([const (in-list name-constraints)]) - ((constraint-proc const) val))) - val))) + (match-define (var name vals) vr) + (define name-constraints (filter (λ (const) (constraint-relates? const name)) unary-constraints)) + (make-var name (for/list ([val (in-list vals)] + #:when (for/and ([const (in-list name-constraints)]) + ((constraint-proc const) val))) + val))) other-constraints))) (define ((make-hist-proc assocs) . xs) (not (for/and ([x (in-list xs)] [val (in-list (map cdr assocs))]) - (equal? x val)))) + (equal? x val)))) (define/contract (backtracking-solver prob @@ -506,7 +506,7 @@ (and (backtrack? exn) (or (let ([bths (backtrack-histories exn)]) (or (empty? bths) (for*/or ([bth bths] [rec bth]) - (eq? name (car rec)))))))) + (eq? name (car rec)))))))) (for/fold ([conflicts null] #:result (void)) ([val (in-list (order-domain-values domain))]) @@ -516,15 +516,17 @@ (append conflicts (remq name (remove-duplicates (for*/list ([bth bths] [rec bth]) - (car rec)) eq?))))]) + (car rec)) eq?))))]) (let* ([prob (assign-val prob name val)] ;; reduce constraints before inference, ;; to create more forward-checkable (binary) constraints [prob (reduce-arity-proc prob)] [prob (inference prob name)] [prob (check-constraints prob)]) - (loop prob))) - conflicts)])))) + (loop prob)) + ;; conflicts goes inside the handler expression + ;; so raises can supersede it + conflicts))])))) (define/contract (random-pick xs) ((non-empty-listof any/c) . -> . any/c) @@ -556,9 +558,9 @@ ((csp?) (integer?) . ->* . generator?) (generator () (for ([thread-count (or (current-thread-count) 1)]) ; todo: what is ideal thread count? - (make-min-conflcts-thread prob thread-count max-steps)) + (make-min-conflcts-thread prob thread-count max-steps)) (for ([i (in-naturals)]) - (yield (thread-receive))))) + (yield (thread-receive))))) (define/contract (optimal-stop-min proc xs) (procedure? (listof any/c) . -> . any/c) @@ -566,7 +568,7 @@ (define threshold (argmin proc sample)) (or (for/first ([candidate (in-list candidates)] #:when (<= (proc candidate) threshold)) - candidate) + candidate) (last candidates))) (define/contract (conflicted-variable-names prob) @@ -574,7 +576,7 @@ ;; Return a list of variables in current assignment that are conflicted (for/list ([name (in-var-names prob)] #:when (positive? (nconflicts prob name))) - name)) + name)) (define/contract (min-conflicts-value prob name vals) (csp? name? (listof any/c) . -> . any/c) @@ -583,7 +585,7 @@ #:cache-keys? #true)) (for/first ([val (in-list vals-by-conflict)] #:unless (equal? val (first (find-domain prob name)))) ;; but change the value - val)) + val)) (define no-value-sig (gensym)) @@ -598,11 +600,11 @@ ((csp?) ((listof name?)) . ->* . (listof (cons/c name? any/c))) (define assocs (for/list ([vr (in-vars prob)]) - (match vr - [(var name (list val)) (cons name val)]))) + (match vr + [(var name (list val)) (cons name val)]))) (if keys (for/list ([key (in-list keys)]) - (assq key assocs)) + (assq key assocs)) assocs)) (define/contract (combine-csps probs) @@ -617,11 +619,11 @@ (make-csp (for/list ([vr (in-vars prob)] #:when (memq (var-name vr) names)) - vr) + vr) (for/list ([const (in-constraints prob)] #:when (for/and ([cname (in-list (constraint-names const))]) - (memq cname names))) - const))) + (memq cname names))) + const))) (define/contract (solve* prob #:finish-proc [finish-proc (λ (p) (csp->assocs p (map var-name (vars prob))))] @@ -634,17 +636,17 @@ (define subcsps ; decompose into independent csps. `cc` determines "connected components" (if (current-decompose) (for/list ([nodeset (in-list (cc (csp->graph prob)))]) - (extract-subcsp prob nodeset)) + (extract-subcsp prob nodeset)) (list prob))) (define solgens (map solver subcsps)) (define solstreams (for/list ([solgen (in-list solgens)]) - (for/stream ([sol (in-producer solgen (void))]) - sol))) + (for/stream ([sol (in-producer solgen (void))]) + sol))) (for/list ([solution-pieces (in-cartesian solstreams)] [idx (in-range max-solutions)]) - (finish-proc (combine-csps solution-pieces)))) + (finish-proc (combine-csps solution-pieces)))) (define/contract (solve prob #:finish-proc [finish-proc (λ (p) (csp->assocs p (map var-name (vars prob))))] From 3b341f8a13a019c646cd6edf66ee5cfaa50c21bc Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Fri, 26 Oct 2018 19:04:25 -0700 Subject: [PATCH 201/246] nits --- csp/csp/hacs.rkt | 45 ++++++++++++++++++++++----------------------- 1 file changed, 22 insertions(+), 23 deletions(-) diff --git a/csp/csp/hacs.rkt b/csp/csp/hacs.rkt index c37bd10a..3f7acad2 100644 --- a/csp/csp/hacs.rkt +++ b/csp/csp/hacs.rkt @@ -348,11 +348,12 @@ ;; csp is arc-consistent if every pair of variables (x y) ;; has values in their domain that satisfy every binary constraint (define checkable-names (cons ref-name (filter-not (λ (vn) (assigned-name? prob vn)) (map var-name (vars prob))))) - (define starting-arcs (two-arity-constraints->arcs (for/list ([const (in-constraints prob)] - #:when (and (two-arity? const) - (for/and ([cname (in-list (constraint-names const))]) - (memq cname checkable-names)))) - const))) + (define starting-arcs + (two-arity-constraints->arcs (for/list ([const (in-constraints prob)] + #:when (and (two-arity? const) + (for/and ([cname (in-list (constraint-names const))]) + (memq cname checkable-names)))) + const))) (for/fold ([prob prob] [arcs (sort starting-arcs < #:key (λ (a) (length (find-domain prob (arc-name a)))) #:cache-keys? #true)] #:result (prune-singleton-constraints prob)) @@ -360,22 +361,21 @@ #:break (empty? arcs)) (match-define (cons (arc name proc) other-arcs) arcs) (define reduced-csp (reduce-domain prob (arc name proc))) - (values reduced-csp (if (= (length (find-domain prob name)) (length (find-domain reduced-csp name))) - ;; revision did not reduce the domain, so keep going - other-arcs - ;; revision reduced the domain, so supplement the list of arcs - (remove-duplicates (append (starting-arcs . terminating-at? . name) other-arcs)))))) + (define (domain-reduced? name) + (= (length (find-domain prob name)) (length (find-domain reduced-csp name)))) + (values reduced-csp (if (domain-reduced? name) + (remove-duplicates (append (starting-arcs . terminating-at? . name) other-arcs)) + other-arcs)))) (define/contract (forward-check-var prob ref-name vr) (csp? name? var? . -> . var?) - (cond + (match vr ;; don't check against assigned vars, or the reference var ;; (which is probably assigned but maybe not) - [(assigned-var? vr) vr] - [(eq? (var-name vr) ref-name) vr] - [else - (match-define (var name vals) vr) + [(? assigned-var? vr) vr] + [(var (== ref-name eq?) _) vr] + [(var name vals) (match ((constraints prob) . relating-only . (list ref-name name)) [(? empty?) vr] [constraints @@ -383,14 +383,13 @@ (define new-vals (for/list ([val (in-list vals)] #:when (for/and ([const (in-list constraints)]) - (let ([proc (constraint-proc const)]) - (if (eq? name (first (constraint-names const))) - (proc val ref-val) - (proc ref-val val))))) + (match const + [(constraint (list (== name eq?) _) proc) (proc val ref-val)] + [(constraint _ proc) (proc ref-val val)]))) val)) (checked-variable name new-vals (cons (cons ref-name ref-val) (match vr [(checked-variable _ _ history) history] - [else null])))])])) + [_ null])))])])) (define/contract (prune-singleton-constraints prob [ref-name #false]) ((csp?) ((or/c #false name?)) . ->* . csp?) @@ -419,7 +418,7 @@ ;; so we can discover the *most recent past var* that could be the culprit. ;; If we just bail out at the first conflict, we may backjump too far based on its history ;; (and thereby miss parts of the search tree) - (when (pair? conflict-set) + (unless (empty? conflict-set) (backtrack! conflict-set)) ;; Discard constraints that have produced singleton domains ;; (they have no further use) @@ -514,8 +513,8 @@ (λ (bt) (define bths (backtrack-histories bt)) (append conflicts (remq name (remove-duplicates - (for*/list ([bth bths] - [rec bth]) + (for*/list ([bth (in-list bths)] + [rec (in-list bth)]) (car rec)) eq?))))]) (let* ([prob (assign-val prob name val)] ;; reduce constraints before inference, From 5b407c62d562ca7a71c6ff2b2572196fd688133f Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Fri, 26 Oct 2018 19:14:55 -0700 Subject: [PATCH 202/246] suspend --- csp/csp/hacs.rkt | 3 +++ 1 file changed, 3 insertions(+) diff --git a/csp/csp/hacs.rkt b/csp/csp/hacs.rkt index 3f7acad2..13a79541 100644 --- a/csp/csp/hacs.rkt +++ b/csp/csp/hacs.rkt @@ -2,6 +2,9 @@ (require racket/generator graph) (provide (all-defined-out)) +(define-syntax-rule (define/contract EXPR CONTRACT . BODY) + (define EXPR . BODY)) + (define-syntax when-debug (let () (define debug #t) From 8ae81f377b041faada4032d02113bc1423a5ec04 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Fri, 26 Oct 2018 21:02:44 -0700 Subject: [PATCH 203/246] test --- csp/csp/hacs-cryptarithmetic.rkt | 40 ++++++++++++++++++++++++++++++++ 1 file changed, 40 insertions(+) create mode 100644 csp/csp/hacs-cryptarithmetic.rkt diff --git a/csp/csp/hacs-cryptarithmetic.rkt b/csp/csp/hacs-cryptarithmetic.rkt new file mode 100644 index 00000000..457e106c --- /dev/null +++ b/csp/csp/hacs-cryptarithmetic.rkt @@ -0,0 +1,40 @@ +#lang debug racket +(require "hacs.rkt" sugar/debug) +(module+ test (require rackunit)) + +(define (word-value d str) + (define xs (for/list ([c (in-string str)]) + (dict-ref d (string->symbol (string c))))) + (for/sum ([(x idx) (in-indexed (reverse xs))]) + (* x (expt 10 idx)))) + +(define (math-csp str) + (define input str) + (define words (map string-downcase (string-split input))) + (match-define (list terms ... sum) words) + (define vars (map string->symbol (remove-duplicates (for*/list ([word words] + [c word]) + (string c))))) + (unless (<= (length vars) 10) + (raise-argument-error 'too-many-letters)) + + (define (not= x y) (not (= x y))) + + (define math (make-csp)) + (add-vars! math vars (range 0 10)) + ;; all letters have different values + (add-pairwise-constraint! math not= vars) +;; first letters cannot be zero + (define firsts (remove-duplicates (map (compose1 string->symbol string car string->list) words) eq?)) + (for ([first firsts]) + (add-constraint! math positive? (list first))) + (add-constraint! math (λ args + (define dict (map cons vars args)) + (= (apply + (map (λ (w) (word-value dict w)) terms)) (word-value dict sum))) vars) + math) + +#;(solve (math-csp "TWO TWO FOUR")) +#;(solve (math-csp "DUCK DUCK GOOSE")) +#;(solve (math-csp "TICK TICK BOOM")) +#;(solve (math-csp "SEND MORE MONEY")) +#;(solve (math-csp "THIS THAT OTHER")) \ No newline at end of file From 0af5d7e57bfa0abcd296d6cf2d1eafe22c595e60 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Sat, 27 Oct 2018 08:15:02 -0700 Subject: [PATCH 204/246] nit --- csp/csp/scribblings/csp.scrbl | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/csp/csp/scribblings/csp.scrbl b/csp/csp/scribblings/csp.scrbl index f04e6760..b88585be 100644 --- a/csp/csp/scribblings/csp.scrbl +++ b/csp/csp/scribblings/csp.scrbl @@ -112,7 +112,7 @@ By the way, what if we had accidentally included @racket[c] in the last constrai (solve* triples) ] -Nothing changes. Why not? Because of the existing @racket[valid-triple?] constraint, @racket[c] is necessarily going to be larger than @racket[a] and @racket[b]. So it always meets this constraint too. But generally, it's good practice to minimize constraints — no need for the ``belt and suspenders'' approach. +Nothing changes. Why not? Because of the existing @racket[valid-triple?] constraint, @racket[c] is necessarily going to be larger than @racket[a] and @racket[b]. So it always meets this constraint too. It's good practice to not duplicate constraints between the same sets of variables — the ``belt and suspenders'' approach just adds work for no benefit. We should use @racket[solve*] with care. It can't finish until the CSP solver examines every possible assignment of values in the problem, which can be a big number. Specifically, it's the product of the domain sizes of each variable, which in this case is 40 × 40 × 40 = 64,000. This realm of possible assignments is also known as the CSP's @deftech{state space}. We can also get this number from @racket[state-count]: From 6e942167bfbdf266e3402976ae542e1486cd56ed Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Sat, 27 Oct 2018 16:02:24 -0700 Subject: [PATCH 205/246] in-solutions --- csp/csp/hacs.rkt | 208 +++++++++++++++++----------------- csp/csp/scribblings/csp.scrbl | 16 +-- 2 files changed, 116 insertions(+), 108 deletions(-) diff --git a/csp/csp/hacs.rkt b/csp/csp/hacs.rkt index 13a79541..a967fc3f 100644 --- a/csp/csp/hacs.rkt +++ b/csp/csp/hacs.rkt @@ -1,6 +1,6 @@ #lang debug racket (require racket/generator graph) -(provide (all-defined-out)) +(provide (except-out (all-defined-out) define/contract)) (define-syntax-rule (define/contract EXPR CONTRACT . BODY) (define EXPR . BODY)) @@ -23,7 +23,7 @@ (if (null? argss) (yield (reverse acc)) (for ([arg (car argss)]) - (loop (cdr argss) (cons arg acc)))))))) + (loop (cdr argss) (cons arg acc)))))))) (struct csp (vars constraints) #:mutable #:transparent) (define constraints csp-constraints) @@ -39,7 +39,7 @@ (raise-argument-error 'constraint "csp" prob)) ;; apply proc in many-to-many style (for/and ([args (in-cartesian (map (λ (name) (find-domain prob name)) (constraint-names const)))]) - (apply (constraint-proc const) args)))) + (apply (constraint-proc const) args)))) (define name? symbol?) @@ -100,11 +100,11 @@ ((csp? procedure? (listof (listof name?))) ((or/c #false name?)) . ->* . void?) (set-csp-constraints! prob (append (constraints prob) (for/list ([names (in-list namess)]) - (for ([name (in-list names)]) - (check-name-in-csp! 'add-constraints! prob name)) - (make-constraint names (if proc-name - (procedure-rename proc proc-name) - proc)))))) + (for ([name (in-list names)]) + (check-name-in-csp! 'add-constraints! prob name)) + (make-constraint names (if proc-name + (procedure-rename proc proc-name) + proc)))))) (define/contract (add-pairwise-constraint! prob proc names [proc-name #false]) ((csp? procedure? (listof name?)) (name?) . ->* . void?) @@ -143,7 +143,7 @@ (check-name-in-csp! 'find-var prob name) (for/first ([vr (in-vars prob)] #:when (eq? name (var-name vr))) - vr)) + vr)) (define/contract (find-domain prob name) (csp? name? . -> . (listof any/c)) @@ -186,20 +186,20 @@ (ormap assigned? (constraint-names constraint))) (make-csp (vars prob) (for/list ([const (in-constraints prob)]) - (cond - ;; no point reducing 2-arity functions because they will be consumed by forward checking - [(and (or (not minimum-arity) (<= minimum-arity (constraint-arity const))) - (partially-assigned? const)) - (match-define (constraint cnames proc) const) - ;; pattern is mix of values and boxed symbols (indicating variables to persist) - ;; use boxes here as cheap way to distinguish id symbols from value symbols - (define arity-reduction-pattern (for/list ([cname (in-list cnames)]) - (if (assigned? cname) - (first (find-domain prob cname)) - (box cname)))) - (constraint (filter-not assigned? cnames) - (reduce-function-arity proc arity-reduction-pattern))] - [else const])))) + (cond + ;; no point reducing 2-arity functions because they will be consumed by forward checking + [(and (or (not minimum-arity) (<= minimum-arity (constraint-arity const))) + (partially-assigned? const)) + (match-define (constraint cnames proc) const) + ;; pattern is mix of values and boxed symbols (indicating variables to persist) + ;; use boxes here as cheap way to distinguish id symbols from value symbols + (define arity-reduction-pattern (for/list ([cname (in-list cnames)]) + (if (assigned? cname) + (first (find-domain prob cname)) + (box cname)))) + (constraint (filter-not assigned? cnames) + (reduce-function-arity proc arity-reduction-pattern))] + [else const])))) (define nassns 0) (define nfchecks 0) @@ -214,9 +214,9 @@ (begin0 (make-csp (for/list ([vr (in-vars prob)]) - (if (eq? name (var-name vr)) - (assigned-var name (list val)) - vr)) + (if (eq? name (var-name vr)) + (assigned-var name (list val)) + vr)) (constraints prob)) (when-debug (set! nassns (add1 nassns))))) @@ -246,7 +246,7 @@ (for/list ([x (in-list xs)] [val (in-list vals)] #:when (= val target-val)) - x)])) + x)])) (define/contract (argmax* proc xs) (procedure? (listof any/c) . -> . (listof any/c)) @@ -271,7 +271,7 @@ (csp? var? . -> . natural?) (for/sum ([const (in-constraints prob)] #:when (memq (var-name var) (constraint-names const))) - 1)) + 1)) (define/contract (domain-length var) (var? . -> . natural?) @@ -280,7 +280,7 @@ (define/contract (state-count csp) (csp? . -> . natural?) (for/product ([vr (in-vars csp)]) - (domain-length vr))) + (domain-length vr))) (define/contract (mrv-degree-hybrid prob) (csp? . -> . (or/c #f var?)) @@ -299,8 +299,8 @@ [cnames (in-value (constraint-names const))] #:when (and (= (length names) (length cnames)) (for/and ([name (in-list names)]) - (memq name cnames)))) - const)) + (memq name cnames)))) + const)) (define (one-arity? const) (= 1 (constraint-arity const))) (define (two-arity? const) (= 2 (constraint-arity const))) @@ -314,7 +314,7 @@ ((listof (and/c constraint? two-arity?)) . -> . (listof arc?)) (for*/list ([const (in-list constraints)] [name (in-list (constraint-names const))]) - (arc name const))) + (arc name const))) (require sugar/debug) (define/contract (reduce-domain prob ark) @@ -326,16 +326,16 @@ (λ (val other-val) (constraint-proc other-val val)))) ; otherwise reverse arg order (define (satisfies-arc? val) (for/or ([other-val (in-list (find-domain prob other-name))]) - (proc val other-val))) + (proc val other-val))) (make-csp (for/list ([vr (in-vars prob)]) - (cond - [(assigned-var? vr) vr] - [(eq? name (var-name vr)) - (make-var name (match (filter satisfies-arc? (domain vr)) - [(? empty?) (backtrack!)] - [vals vals]))] - [else vr])) + (cond + [(assigned-var? vr) vr] + [(eq? name (var-name vr)) + (make-var name (match (filter satisfies-arc? (domain vr)) + [(? empty?) (backtrack!)] + [vals vals]))] + [else vr])) (constraints prob))) (define/contract (terminating-at? arcs name) @@ -344,7 +344,7 @@ #:when (and (memq name (constraint-names (arc-const arc))) (not (eq? name (arc-name arc))))) - arc)) + arc)) (define/contract (ac-3 prob ref-name) (csp? name? . -> . csp?) @@ -355,8 +355,8 @@ (two-arity-constraints->arcs (for/list ([const (in-constraints prob)] #:when (and (two-arity? const) (for/and ([cname (in-list (constraint-names const))]) - (memq cname checkable-names)))) - const))) + (memq cname checkable-names)))) + const))) (for/fold ([prob prob] [arcs (sort starting-arcs < #:key (λ (a) (length (find-domain prob (arc-name a)))) #:cache-keys? #true)] #:result (prune-singleton-constraints prob)) @@ -386,10 +386,10 @@ (define new-vals (for/list ([val (in-list vals)] #:when (for/and ([const (in-list constraints)]) - (match const - [(constraint (list (== name eq?) _) proc) (proc val ref-val)] - [(constraint _ proc) (proc ref-val val)]))) - val)) + (match const + [(constraint (list (== name eq?) _) proc) (proc val ref-val)] + [(constraint _ proc) (proc ref-val val)]))) + val)) (checked-variable name new-vals (cons (cons ref-name ref-val) (match vr [(checked-variable _ _ history) history] [_ null])))])])) @@ -398,15 +398,15 @@ ((csp?) ((or/c #false name?)) . ->* . csp?) (define singleton-var-names (for/list ([vr (in-vars prob)] #:when (singleton-var? vr)) - (var-name vr))) + (var-name vr))) (make-csp (vars prob) (for/list ([const (in-constraints prob)] #:unless (and (two-arity? const) (or (not ref-name) (constraint-relates? const ref-name)) (for/and ([cname (in-list (constraint-names const))]) - (memq cname singleton-var-names)))) - const))) + (memq cname singleton-var-names)))) + const))) (define/contract (forward-check prob ref-name) (csp? name? . -> . csp?) @@ -415,7 +415,7 @@ ;; conflict-set will be empty if there are no empty domains (as we would hope) (define conflict-set (for/list ([cvr (in-list checked-vars)] #:when (empty? (domain cvr))) - (history cvr))) + (history cvr))) ;; for conflict-directed backjumping it's essential to forward-check ALL vars ;; (even after an empty domain is generated) and combine their conflicts ;; so we can discover the *most recent past var* that could be the culprit. @@ -432,7 +432,7 @@ ;; constraint is checkable if all constraint names ;; are in target list of names. (for/and ([cname (in-list (constraint-names const))]) - (memq cname names))) + (memq cname names))) (define/contract (constraint-arity const) (constraint? . -> . natural?) @@ -449,21 +449,21 @@ (partition (λ (const) (and (constraint-checkable? const assigned-varnames) (or (not mandatory-names) (for/and ([name (in-list mandatory-names)]) - (constraint-relates? const name))))) + (constraint-relates? const name))))) (constraints prob))) (cond [conflict-count? (define conflict-count (for/sum ([constraint (in-list checkable-consts)] #:unless (constraint prob)) - 1)) + 1)) (when-debug (set! nchecks (+ conflict-count nchecks))) conflict-count] [else (for ([(constraint idx) (in-indexed checkable-consts)] #:unless (constraint prob)) - (when-debug (set! nchecks (+ (add1 idx) nchecks))) - (backtrack!)) + (when-debug (set! nchecks (+ (add1 idx) nchecks))) + (backtrack!)) ;; discard checked constraints, since they have no further reason to live (make-csp (vars prob) other-consts)])) @@ -475,19 +475,19 @@ prob (make-csp (for/list ([vr (in-vars prob)]) - (match-define (var name vals) vr) - (define name-constraints (filter (λ (const) (constraint-relates? const name)) unary-constraints)) - (make-var name (for/list ([val (in-list vals)] - #:when (for/and ([const (in-list name-constraints)]) - ((constraint-proc const) val))) - val))) + (match-define (var name vals) vr) + (define name-constraints (filter (λ (const) (constraint-relates? const name)) unary-constraints)) + (make-var name (for/list ([val (in-list vals)] + #:when (for/and ([const (in-list name-constraints)]) + ((constraint-proc const) val))) + val))) other-constraints))) (define ((make-hist-proc assocs) . xs) (not (for/and ([x (in-list xs)] [val (in-list (map cdr assocs))]) - (equal? x val)))) + (equal? x val)))) (define/contract (backtracking-solver prob @@ -508,7 +508,7 @@ (and (backtrack? exn) (or (let ([bths (backtrack-histories exn)]) (or (empty? bths) (for*/or ([bth bths] [rec bth]) - (eq? name (car rec)))))))) + (eq? name (car rec)))))))) (for/fold ([conflicts null] #:result (void)) ([val (in-list (order-domain-values domain))]) @@ -518,7 +518,7 @@ (append conflicts (remq name (remove-duplicates (for*/list ([bth (in-list bths)] [rec (in-list bth)]) - (car rec)) eq?))))]) + (car rec)) eq?))))]) (let* ([prob (assign-val prob name val)] ;; reduce constraints before inference, ;; to create more forward-checkable (binary) constraints @@ -560,9 +560,9 @@ ((csp?) (integer?) . ->* . generator?) (generator () (for ([thread-count (or (current-thread-count) 1)]) ; todo: what is ideal thread count? - (make-min-conflcts-thread prob thread-count max-steps)) + (make-min-conflcts-thread prob thread-count max-steps)) (for ([i (in-naturals)]) - (yield (thread-receive))))) + (yield (thread-receive))))) (define/contract (optimal-stop-min proc xs) (procedure? (listof any/c) . -> . any/c) @@ -570,7 +570,7 @@ (define threshold (argmin proc sample)) (or (for/first ([candidate (in-list candidates)] #:when (<= (proc candidate) threshold)) - candidate) + candidate) (last candidates))) (define/contract (conflicted-variable-names prob) @@ -578,7 +578,7 @@ ;; Return a list of variables in current assignment that are conflicted (for/list ([name (in-var-names prob)] #:when (positive? (nconflicts prob name))) - name)) + name)) (define/contract (min-conflicts-value prob name vals) (csp? name? (listof any/c) . -> . any/c) @@ -587,7 +587,7 @@ #:cache-keys? #true)) (for/first ([val (in-list vals-by-conflict)] #:unless (equal? val (first (find-domain prob name)))) ;; but change the value - val)) + val)) (define no-value-sig (gensym)) @@ -602,11 +602,11 @@ ((csp?) ((listof name?)) . ->* . (listof (cons/c name? any/c))) (define assocs (for/list ([vr (in-vars prob)]) - (match vr - [(var name (list val)) (cons name val)]))) + (match vr + [(var name (list val)) (cons name val)]))) (if keys (for/list ([key (in-list keys)]) - (assq key assocs)) + (assq key assocs)) assocs)) (define/contract (combine-csps probs) @@ -621,45 +621,51 @@ (make-csp (for/list ([vr (in-vars prob)] #:when (memq (var-name vr) names)) - vr) + vr) (for/list ([const (in-constraints prob)] #:when (for/and ([cname (in-list (constraint-names const))]) - (memq cname names))) - const))) + (memq cname names))) + const))) -(define/contract (solve* prob +(define (decompose-prob prob) + ; decompose into independent csps. `cc` determines "connected components" + (if (current-decompose) + (for/list ([nodeset (in-list (cc (csp->graph prob)))]) + (extract-subcsp prob nodeset)) + (list prob))) + +(define (make-solution-generator prob) + (generator () + (define subprobs (decompose-prob prob)) + (define solgens (map (current-solver) subprobs)) + (define solstreams (for/list ([solgen (in-list solgens)]) + (for/stream ([sol (in-producer solgen (void))]) + sol))) + (for ([solution-pieces (in-cartesian solstreams)]) + (yield (combine-csps solution-pieces))))) + +(define-syntax-rule (in-solutions PROB) + (in-producer (make-solution-generator PROB) (void))) + +(define/contract (solve* prob [max-solutions +inf.0] #:finish-proc [finish-proc (λ (p) (csp->assocs p (map var-name (vars prob))))] - #:solver [solver (or (current-solver) backtracking-solver)] - #:count [max-solutions +inf.0]) - ((csp?) (#:finish-proc procedure? #:solver procedure? #:count natural?) - . ->* . (listof any/c)) + #:solver [solver #f]) + ((csp?) (natural? #:finish-proc procedure? #:solver procedure?) . ->* . (listof any/c)) (when-debug (reset-nassns!) (reset-nfchecks!) (reset-nchecks!)) - (define subcsps ; decompose into independent csps. `cc` determines "connected components" - (if (current-decompose) - (for/list ([nodeset (in-list (cc (csp->graph prob)))]) - (extract-subcsp prob nodeset)) - (list prob))) - - (define solgens (map solver subcsps)) - (define solstreams (for/list ([solgen (in-list solgens)]) - (for/stream ([sol (in-producer solgen (void))]) - sol))) - - (for/list ([solution-pieces (in-cartesian solstreams)] - [idx (in-range max-solutions)]) - (finish-proc (combine-csps solution-pieces)))) + (parameterize ([current-solver (or solver (current-solver) backtracking-solver)]) + (for/list ([sol (in-solutions prob)] + [idx (in-range max-solutions)]) + (finish-proc sol)))) (define/contract (solve prob #:finish-proc [finish-proc (λ (p) (csp->assocs p (map var-name (vars prob))))] - #:solver [solver (or (current-solver) backtracking-solver)] - #:count [max-solutions 1]) - ((csp?) (#:finish-proc procedure? #:solver procedure? #:count natural?) + #:solver [solver #f]) + ((csp?) (#:finish-proc procedure? #:solver procedure?) . ->* . (or/c #false any/c)) - (match (solve* prob #:finish-proc finish-proc #:solver solver #:count max-solutions) + (match (solve* prob 1 #:finish-proc finish-proc #:solver solver) [(list solution) solution] - [(list) #false] - [(list solutions ...) solutions])) + [_ #false])) (define (<> a b) (not (= a b))) (define (neq? a b) (not (eq? a b))) diff --git a/csp/csp/scribblings/csp.scrbl b/csp/csp/scribblings/csp.scrbl index b88585be..f24aff53 100644 --- a/csp/csp/scribblings/csp.scrbl +++ b/csp/csp/scribblings/csp.scrbl @@ -8,7 +8,7 @@ @(define-syntax-rule (my-examples ARG ...) (examples #:label #f #:eval my-eval ARG ...)) -@title{Constraint-satisfaction problems} +@title{Constraint-satisfaction problems (and how to solve them)} @author[(author+email "Matthew Butterick" "mb@mbtype.com")] @@ -120,11 +120,11 @@ We should use @racket[solve*] with care. It can't finish until the CSP solver e (state-count triples) ] -It's easy for a CSP to have a state count in the zillions. For this reason we can supply @racket[solve*] with an optional @racket[#:count] argument that will only generate a certain number of solutions: +It's easy for a CSP to have a state count in the zillions. For this reason we can supply @racket[solve*] with an optional argument that will only generate a certain number of solutions: @examples[#:label #f #:eval my-eval (time (solve* triples)) -(time (solve* triples #:count 2)) +(time (solve* triples 2)) ] Here, the answers are the same. But the second call to @racket[solve*] finishes sooner, because it quits as soon as it's found two solutions. @@ -159,7 +159,7 @@ The whole example in one block: (add-constraint! triples <= '(a b)) -(solve* triples #:count 2) +(solve* triples 2) ] @section{Interlude} @@ -282,19 +282,21 @@ TK } @defproc[(solve -[prob csp?] -[#:count count natural? 1]) +[prob csp?] ) (or/c #false any/c (listof any/c))]{ TK } @defproc[(solve* [prob csp?] -[#:count count natural? +inf.0]) +[count natural? +inf.0]) (listof any/c)]{ TK } +@defform[(in-solutions prob)]{ +TK +} @section{Sideshows} From 2186873782b80afc072c0d6a0287f27e8cda515d Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Sat, 27 Oct 2018 17:15:33 -0700 Subject: [PATCH 206/246] fac --- csp/csp/hacs.rkt | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/csp/csp/hacs.rkt b/csp/csp/hacs.rkt index a967fc3f..c9d477eb 100644 --- a/csp/csp/hacs.rkt +++ b/csp/csp/hacs.rkt @@ -623,8 +623,7 @@ #:when (memq (var-name vr) names)) vr) (for/list ([const (in-constraints prob)] - #:when (for/and ([cname (in-list (constraint-names const))]) - (memq cname names))) + #:when (constraint-checkable? const names)) const))) (define (decompose-prob prob) From 9750ec411e419b3973ba51ee178faf1ce78ce5b4 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Sat, 1 Dec 2018 11:23:31 -0800 Subject: [PATCH 207/246] settish --- csp/csp/hacs.rkt | 13 +++++++------ 1 file changed, 7 insertions(+), 6 deletions(-) diff --git a/csp/csp/hacs.rkt b/csp/csp/hacs.rkt index c9d477eb..34318605 100644 --- a/csp/csp/hacs.rkt +++ b/csp/csp/hacs.rkt @@ -1,5 +1,5 @@ #lang debug racket -(require racket/generator graph) +(require racket/generator graph racket/set) (provide (except-out (all-defined-out) define/contract)) (define-syntax-rule (define/contract EXPR CONTRACT . BODY) @@ -78,7 +78,7 @@ (define/contract (make-var name [vals null]) ((name?) ((listof any/c)) . ->* . var?) - (var name vals)) + (var name (list->set vals))) (define/contract (add-vars! prob names [vals-or-procedure empty]) ((csp? (listof name?)) ((or/c (listof any/c) procedure?)) . ->* . void?) @@ -275,7 +275,7 @@ (define/contract (domain-length var) (var? . -> . natural?) - (length (domain var))) + (set-count (domain var))) (define/contract (state-count csp) (csp? . -> . natural?) @@ -384,7 +384,7 @@ [constraints (define ref-val (first (find-domain prob ref-name))) (define new-vals - (for/list ([val (in-list vals)] + (for/set ([val (in-set vals)] #:when (for/and ([const (in-list constraints)]) (match const [(constraint (list (== name eq?) _) proc) (proc val ref-val)] @@ -414,7 +414,7 @@ (when-debug (set! nfchecks (+ (length checked-vars) nchecks))) ;; conflict-set will be empty if there are no empty domains (as we would hope) (define conflict-set (for/list ([cvr (in-list checked-vars)] - #:when (empty? (domain cvr))) + #:when (set-empty? (domain cvr))) (history cvr))) ;; for conflict-directed backjumping it's essential to forward-check ALL vars ;; (even after an empty domain is generated) and combine their conflicts @@ -511,7 +511,8 @@ (eq? name (car rec)))))))) (for/fold ([conflicts null] #:result (void)) - ([val (in-list (order-domain-values domain))]) + ([val #;(in-list (order-domain-values domain)) + (in-set domain)]) (with-handlers ([wants-backtrack? (λ (bt) (define bths (backtrack-histories bt)) From 69f87fe1a286ed71f6c850887725ceb183abdaa9 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Sat, 1 Dec 2018 11:31:19 -0800 Subject: [PATCH 208/246] set tweaks --- csp/csp/hacs-test.rkt | 8 ++++---- csp/csp/hacs.rkt | 5 ++--- 2 files changed, 6 insertions(+), 7 deletions(-) diff --git a/csp/csp/hacs-test.rkt b/csp/csp/hacs-test.rkt index b51435c2..24c335f2 100644 --- a/csp/csp/hacs-test.rkt +++ b/csp/csp/hacs-test.rkt @@ -23,21 +23,21 @@ (csp-vars (forward-check (forward-check (csp (list (avar 'a '(1)) (avar 'b '(0)) (var 'c '(0 1 2))) (list (constraint '(a c) (negate =)) (constraint '(b c) (negate =)))) 'a) 'b)) - (list (avar 'a '(1)) (avar 'b '(0)) (cvar 'c '(2) '((b . 0) (a . 1))))) + (list (avar 'a '(1)) (avar 'b '(0)) (cvar 'c (set 2) '((b . 0) (a . 1))))) (check-equal? ;; no inconsistency: b≠c not checked when fc is relative to a (csp-vars (forward-check (csp (list (avar 'a '(1)) (var 'b (range 2)) (var 'c '(0))) (list (constraint '(a b) (negate =)) (constraint '(b c) (negate =)))) 'a)) - (list (avar 'a '(1)) (cvar 'b '(0) '((a . 1))) (var 'c '(0)))) + (list (avar 'a '(1)) (cvar 'b (set 0) '((a . 1))) (var 'c '(0)))) (check-equal? ;; no inconsistency: a≠b not checked when fc ignores a, which is already assigned (csp-vars (forward-check (csp (list (avar 'a '(1)) (avar 'b '(1)) (var 'c (range 2))) (list (constraint '(a b) (negate =)) (constraint '(b c) (negate =)))) 'b)) - (list (avar 'a '(1)) (avar 'b '(1)) (cvar 'c '(0) '((b . 1))))) + (list (avar 'a '(1)) (avar 'b '(1)) (cvar 'c (set 0) '((b . 1))))) (check-exn backtrack? (λ () (csp-vars (forward-check (csp (list (avar 'a '(1)) @@ -48,7 +48,7 @@ (check-equal? (csp-vars (forward-check (csp (list (var 'a '(0)) (var 'b (range 3))) (list (constraint '(a b) <))) 'a)) - (list (var 'a '(0)) (cvar 'b '(1 2) '((a . 0))))) + (list (var 'a '(0)) (cvar 'b (set 1 2) '((a . 0))))) (check-equal? (parameterize ([current-inference forward-check]) diff --git a/csp/csp/hacs.rkt b/csp/csp/hacs.rkt index 34318605..c0e8bbe1 100644 --- a/csp/csp/hacs.rkt +++ b/csp/csp/hacs.rkt @@ -477,7 +477,7 @@ (for/list ([vr (in-vars prob)]) (match-define (var name vals) vr) (define name-constraints (filter (λ (const) (constraint-relates? const name)) unary-constraints)) - (make-var name (for/list ([val (in-list vals)] + (make-var name (for/set ([val (in-set vals)] #:when (for/and ([const (in-list name-constraints)]) ((constraint-proc const) val))) val))) @@ -511,8 +511,7 @@ (eq? name (car rec)))))))) (for/fold ([conflicts null] #:result (void)) - ([val #;(in-list (order-domain-values domain)) - (in-set domain)]) + ([val (in-list (order-domain-values (set->list domain)))]) (with-handlers ([wants-backtrack? (λ (bt) (define bths (backtrack-histories bt)) From b8dbea9d1305bca415db9fca5ed09be13fff7ff7 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Thu, 27 Dec 2018 14:21:52 -0800 Subject: [PATCH 209/246] deps --- csp/info.rkt | 10 ++++++++-- 1 file changed, 8 insertions(+), 2 deletions(-) diff --git a/csp/info.rkt b/csp/info.rkt index 2e2dc245..f4b28d84 100644 --- a/csp/info.rkt +++ b/csp/info.rkt @@ -1,4 +1,10 @@ #lang info (define collection 'multi) -(define deps '(("base" #:version "6.0") "sugar" "rackunit-lib" "debug" "graph")) -(define update-implies '("sugar")) \ No newline at end of file +(define deps '("beautiful-racket-lib" + "htdp-lib" + "math-lib" + ("base" #:version "6.0") "sugar" "rackunit-lib" "debug" "graph")) +(define update-implies '("sugar"))(define build-deps '("at-exp-lib" + "math-doc" + "racket-doc" + "scribble-lib")) From ebbbda4a5610bf45043c9e27b992a87c3a373eca Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Fri, 10 May 2019 12:12:26 -0700 Subject: [PATCH 210/246] suppress testing for now --- csp/csp/info.rkt | 1 + 1 file changed, 1 insertion(+) diff --git a/csp/csp/info.rkt b/csp/csp/info.rkt index b9324dc8..a08157b3 100644 --- a/csp/csp/info.rkt +++ b/csp/csp/info.rkt @@ -1,3 +1,4 @@ #lang info (define scribblings '(("scribblings/csp.scrbl" ()))) +(define test-omit-paths 'all) \ No newline at end of file From d60bb7287484ff8ba59d20647a38aa5c64f19220 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Sat, 28 Dec 2019 10:47:01 -0800 Subject: [PATCH 211/246] Update LICENSE --- csp/LICENSE | 506 +--------------------------------------------------- 1 file changed, 5 insertions(+), 501 deletions(-) diff --git a/csp/LICENSE b/csp/LICENSE index 40c8ae62..e2d48bb1 100644 --- a/csp/LICENSE +++ b/csp/LICENSE @@ -1,505 +1,9 @@ -GNU LESSER GENERAL PUBLIC LICENSE - Version 2.1, February 1999 +MIT License for CSP - Copyright (C) 1991, 1999 Free Software Foundation, Inc. - 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA - Everyone is permitted to copy and distribute verbatim copies - of this license document, but changing it is not allowed. +© 2014-2019 Matthew Butterick -(This is the first released version of the Lesser GPL. It also counts - as the successor of the GNU Library Public License, version 2, hence - the version number 2.1.) +Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the “Software”), to deal in the Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the Software is furnished to do so, subject to the following conditions: - Preamble - - The licenses for most software are designed to take away your -freedom to share and change it. By contrast, the GNU General Public -Licenses are intended to guarantee your freedom to share and change -free software--to make sure the software is free for all its users. - - This license, the Lesser General Public License, applies to some -specially designated software packages--typically libraries--of the -Free Software Foundation and other authors who decide to use it. You -can use it too, but we suggest you first think carefully about whether -this license or the ordinary General Public License is the better -strategy to use in any particular case, based on the explanations below. - - When we speak of free software, we are referring to freedom of use, -not price. Our General Public Licenses are designed to make sure that -you have the freedom to distribute copies of free software (and charge -for this service if you wish); that you receive source code or can get -it if you want it; that you can change the software and use pieces of -it in new free programs; and that you are informed that you can do -these things. - - To protect your rights, we need to make restrictions that forbid -distributors to deny you these rights or to ask you to surrender these -rights. These restrictions translate to certain responsibilities for -you if you distribute copies of the library or if you modify it. - - For example, if you distribute copies of the library, whether gratis -or for a fee, you must give the recipients all the rights that we gave -you. You must make sure that they, too, receive or can get the source -code. If you link other code with the library, you must provide -complete object files to the recipients, so that they can relink them -with the library after making changes to the library and recompiling -it. And you must show them these terms so they know their rights. - - We protect your rights with a two-step method: (1) we copyright the -library, and (2) we offer you this license, which gives you legal -permission to copy, distribute and/or modify the library. - - To protect each distributor, we want to make it very clear that -there is no warranty for the free library. Also, if the library is -modified by someone else and passed on, the recipients should know -that what they have is not the original version, so that the original -author's reputation will not be affected by problems that might be -introduced by others. - - Finally, software patents pose a constant threat to the existence of -any free program. We wish to make sure that a company cannot -effectively restrict the users of a free program by obtaining a -restrictive license from a patent holder. Therefore, we insist that -any patent license obtained for a version of the library must be -consistent with the full freedom of use specified in this license. - - Most GNU software, including some libraries, is covered by the -ordinary GNU General Public License. This license, the GNU Lesser -General Public License, applies to certain designated libraries, and -is quite different from the ordinary General Public License. We use -this license for certain libraries in order to permit linking those -libraries into non-free programs. - - When a program is linked with a library, whether statically or using -a shared library, the combination of the two is legally speaking a -combined work, a derivative of the original library. The ordinary -General Public License therefore permits such linking only if the -entire combination fits its criteria of freedom. The Lesser General -Public License permits more lax criteria for linking other code with -the library. - - We call this license the "Lesser" General Public License because it -does Less to protect the user's freedom than the ordinary General -Public License. It also provides other free software developers Less -of an advantage over competing non-free programs. These disadvantages -are the reason we use the ordinary General Public License for many -libraries. However, the Lesser license provides advantages in certain -special circumstances. - - For example, on rare occasions, there may be a special need to -encourage the widest possible use of a certain library, so that it becomes -a de-facto standard. To achieve this, non-free programs must be -allowed to use the library. A more frequent case is that a free -library does the same job as widely used non-free libraries. In this -case, there is little to gain by limiting the free library to free -software only, so we use the Lesser General Public License. - - In other cases, permission to use a particular library in non-free -programs enables a greater number of people to use a large body of -free software. For example, permission to use the GNU C Library in -non-free programs enables many more people to use the whole GNU -operating system, as well as its variant, the GNU/Linux operating -system. - - Although the Lesser General Public License is Less protective of the -users' freedom, it does ensure that the user of a program that is -linked with the Library has the freedom and the wherewithal to run -that program using a modified version of the Library. - - The precise terms and conditions for copying, distribution and -modification follow. Pay close attention to the difference between a -"work based on the library" and a "work that uses the library". The -former contains code derived from the library, whereas the latter must -be combined with the library in order to run. - - GNU LESSER GENERAL PUBLIC LICENSE - TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION - - 0. This License Agreement applies to any software library or other -program which contains a notice placed by the copyright holder or -other authorized party saying it may be distributed under the terms of -this Lesser General Public License (also called "this License"). -Each licensee is addressed as "you". - - A "library" means a collection of software functions and/or data -prepared so as to be conveniently linked with application programs -(which use some of those functions and data) to form executables. - - The "Library", below, refers to any such software library or work -which has been distributed under these terms. A "work based on the -Library" means either the Library or any derivative work under -copyright law: that is to say, a work containing the Library or a -portion of it, either verbatim or with modifications and/or translated -straightforwardly into another language. (Hereinafter, translation is -included without limitation in the term "modification".) - - "Source code" for a work means the preferred form of the work for -making modifications to it. For a library, complete source code means -all the source code for all modules it contains, plus any associated -interface definition files, plus the scripts used to control compilation -and installation of the library. - - Activities other than copying, distribution and modification are not -covered by this License; they are outside its scope. The act of -running a program using the Library is not restricted, and output from -such a program is covered only if its contents constitute a work based -on the Library (independent of the use of the Library in a tool for -writing it). Whether that is true depends on what the Library does -and what the program that uses the Library does. - - 1. You may copy and distribute verbatim copies of the Library's -complete source code as you receive it, in any medium, provided that -you conspicuously and appropriately publish on each copy an -appropriate copyright notice and disclaimer of warranty; keep intact -all the notices that refer to this License and to the absence of any -warranty; and distribute a copy of this License along with the -Library. - - You may charge a fee for the physical act of transferring a copy, -and you may at your option offer warranty protection in exchange for a -fee. - - 2. You may modify your copy or copies of the Library or any portion -of it, thus forming a work based on the Library, and copy and -distribute such modifications or work under the terms of Section 1 -above, provided that you also meet all of these conditions: - - a) The modified work must itself be a software library. - - b) You must cause the files modified to carry prominent notices - stating that you changed the files and the date of any change. - - c) You must cause the whole of the work to be licensed at no - charge to all third parties under the terms of this License. - - d) If a facility in the modified Library refers to a function or a - table of data to be supplied by an application program that uses - the facility, other than as an argument passed when the facility - is invoked, then you must make a good faith effort to ensure that, - in the event an application does not supply such function or - table, the facility still operates, and performs whatever part of - its purpose remains meaningful. - - (For example, a function in a library to compute square roots has - a purpose that is entirely well-defined independent of the - application. Therefore, Subsection 2d requires that any - application-supplied function or table used by this function must - be optional: if the application does not supply it, the square - root function must still compute square roots.) - -These requirements apply to the modified work as a whole. If -identifiable sections of that work are not derived from the Library, -and can be reasonably considered independent and separate works in -themselves, then this License, and its terms, do not apply to those -sections when you distribute them as separate works. But when you -distribute the same sections as part of a whole which is a work based -on the Library, the distribution of the whole must be on the terms of -this License, whose permissions for other licensees extend to the -entire whole, and thus to each and every part regardless of who wrote -it. - -Thus, it is not the intent of this section to claim rights or contest -your rights to work written entirely by you; rather, the intent is to -exercise the right to control the distribution of derivative or -collective works based on the Library. - -In addition, mere aggregation of another work not based on the Library -with the Library (or with a work based on the Library) on a volume of -a storage or distribution medium does not bring the other work under -the scope of this License. - - 3. You may opt to apply the terms of the ordinary GNU General Public -License instead of this License to a given copy of the Library. To do -this, you must alter all the notices that refer to this License, so -that they refer to the ordinary GNU General Public License, version 2, -instead of to this License. (If a newer version than version 2 of the -ordinary GNU General Public License has appeared, then you can specify -that version instead if you wish.) Do not make any other change in -these notices. - - Once this change is made in a given copy, it is irreversible for -that copy, so the ordinary GNU General Public License applies to all -subsequent copies and derivative works made from that copy. - - This option is useful when you wish to copy part of the code of -the Library into a program that is not a library. - - 4. You may copy and distribute the Library (or a portion or -derivative of it, under Section 2) in object code or executable form -under the terms of Sections 1 and 2 above provided that you accompany -it with the complete corresponding machine-readable source code, which -must be distributed under the terms of Sections 1 and 2 above on a -medium customarily used for software interchange. - - If distribution of object code is made by offering access to copy -from a designated place, then offering equivalent access to copy the -source code from the same place satisfies the requirement to -distribute the source code, even though third parties are not -compelled to copy the source along with the object code. - - 5. A program that contains no derivative of any portion of the -Library, but is designed to work with the Library by being compiled or -linked with it, is called a "work that uses the Library". Such a -work, in isolation, is not a derivative work of the Library, and -therefore falls outside the scope of this License. - - However, linking a "work that uses the Library" with the Library -creates an executable that is a derivative of the Library (because it -contains portions of the Library), rather than a "work that uses the -library". The executable is therefore covered by this License. -Section 6 states terms for distribution of such executables. - - When a "work that uses the Library" uses material from a header file -that is part of the Library, the object code for the work may be a -derivative work of the Library even though the source code is not. -Whether this is true is especially significant if the work can be -linked without the Library, or if the work is itself a library. The -threshold for this to be true is not precisely defined by law. - - If such an object file uses only numerical parameters, data -structure layouts and accessors, and small macros and small inline -functions (ten lines or less in length), then the use of the object -file is unrestricted, regardless of whether it is legally a derivative -work. (Executables containing this object code plus portions of the -Library will still fall under Section 6.) - - Otherwise, if the work is a derivative of the Library, you may -distribute the object code for the work under the terms of Section 6. -Any executables containing that work also fall under Section 6, -whether or not they are linked directly with the Library itself. - - 6. As an exception to the Sections above, you may also combine or -link a "work that uses the Library" with the Library to produce a -work containing portions of the Library, and distribute that work -under terms of your choice, provided that the terms permit -modification of the work for the customer's own use and reverse -engineering for debugging such modifications. - - You must give prominent notice with each copy of the work that the -Library is used in it and that the Library and its use are covered by -this License. You must supply a copy of this License. If the work -during execution displays copyright notices, you must include the -copyright notice for the Library among them, as well as a reference -directing the user to the copy of this License. Also, you must do one -of these things: - - a) Accompany the work with the complete corresponding - machine-readable source code for the Library including whatever - changes were used in the work (which must be distributed under - Sections 1 and 2 above); and, if the work is an executable linked - with the Library, with the complete machine-readable "work that - uses the Library", as object code and/or source code, so that the - user can modify the Library and then relink to produce a modified - executable containing the modified Library. (It is understood - that the user who changes the contents of definitions files in the - Library will not necessarily be able to recompile the application - to use the modified definitions.) - - b) Use a suitable shared library mechanism for linking with the - Library. A suitable mechanism is one that (1) uses at run time a - copy of the library already present on the user's computer system, - rather than copying library functions into the executable, and (2) - will operate properly with a modified version of the library, if - the user installs one, as long as the modified version is - interface-compatible with the version that the work was made with. - - c) Accompany the work with a written offer, valid for at - least three years, to give the same user the materials - specified in Subsection 6a, above, for a charge no more - than the cost of performing this distribution. - - d) If distribution of the work is made by offering access to copy - from a designated place, offer equivalent access to copy the above - specified materials from the same place. - - e) Verify that the user has already received a copy of these - materials or that you have already sent this user a copy. - - For an executable, the required form of the "work that uses the -Library" must include any data and utility programs needed for -reproducing the executable from it. However, as a special exception, -the materials to be distributed need not include anything that is -normally distributed (in either source or binary form) with the major -components (compiler, kernel, and so on) of the operating system on -which the executable runs, unless that component itself accompanies -the executable. - - It may happen that this requirement contradicts the license -restrictions of other proprietary libraries that do not normally -accompany the operating system. Such a contradiction means you cannot -use both them and the Library together in an executable that you -distribute. - - 7. You may place library facilities that are a work based on the -Library side-by-side in a single library together with other library -facilities not covered by this License, and distribute such a combined -library, provided that the separate distribution of the work based on -the Library and of the other library facilities is otherwise -permitted, and provided that you do these two things: - - a) Accompany the combined library with a copy of the same work - based on the Library, uncombined with any other library - facilities. This must be distributed under the terms of the - Sections above. - - b) Give prominent notice with the combined library of the fact - that part of it is a work based on the Library, and explaining - where to find the accompanying uncombined form of the same work. - - 8. You may not copy, modify, sublicense, link with, or distribute -the Library except as expressly provided under this License. Any -attempt otherwise to copy, modify, sublicense, link with, or -distribute the Library is void, and will automatically terminate your -rights under this License. However, parties who have received copies, -or rights, from you under this License will not have their licenses -terminated so long as such parties remain in full compliance. - - 9. You are not required to accept this License, since you have not -signed it. However, nothing else grants you permission to modify or -distribute the Library or its derivative works. These actions are -prohibited by law if you do not accept this License. Therefore, by -modifying or distributing the Library (or any work based on the -Library), you indicate your acceptance of this License to do so, and -all its terms and conditions for copying, distributing or modifying -the Library or works based on it. - - 10. Each time you redistribute the Library (or any work based on the -Library), the recipient automatically receives a license from the -original licensor to copy, distribute, link with or modify the Library -subject to these terms and conditions. You may not impose any further -restrictions on the recipients' exercise of the rights granted herein. -You are not responsible for enforcing compliance by third parties with -this License. - - 11. If, as a consequence of a court judgment or allegation of patent -infringement or for any other reason (not limited to patent issues), -conditions are imposed on you (whether by court order, agreement or -otherwise) that contradict the conditions of this License, they do not -excuse you from the conditions of this License. If you cannot -distribute so as to satisfy simultaneously your obligations under this -License and any other pertinent obligations, then as a consequence you -may not distribute the Library at all. For example, if a patent -license would not permit royalty-free redistribution of the Library by -all those who receive copies directly or indirectly through you, then -the only way you could satisfy both it and this License would be to -refrain entirely from distribution of the Library. - -If any portion of this section is held invalid or unenforceable under any -particular circumstance, the balance of the section is intended to apply, -and the section as a whole is intended to apply in other circumstances. - -It is not the purpose of this section to induce you to infringe any -patents or other property right claims or to contest validity of any -such claims; this section has the sole purpose of protecting the -integrity of the free software distribution system which is -implemented by public license practices. Many people have made -generous contributions to the wide range of software distributed -through that system in reliance on consistent application of that -system; it is up to the author/donor to decide if he or she is willing -to distribute software through any other system and a licensee cannot -impose that choice. - -This section is intended to make thoroughly clear what is believed to -be a consequence of the rest of this License. - - 12. If the distribution and/or use of the Library is restricted in -certain countries either by patents or by copyrighted interfaces, the -original copyright holder who places the Library under this License may add -an explicit geographical distribution limitation excluding those countries, -so that distribution is permitted only in or among countries not thus -excluded. In such case, this License incorporates the limitation as if -written in the body of this License. - - 13. The Free Software Foundation may publish revised and/or new -versions of the Lesser 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 Library -specifies a version number of this License which applies to it and -"any later version", you have the option of following the terms and -conditions either of that version or of any later version published by -the Free Software Foundation. If the Library does not specify a -license version number, you may choose any version ever published by -the Free Software Foundation. - - 14. If you wish to incorporate parts of the Library into other free -programs whose distribution conditions are incompatible with these, -write to the author to ask for permission. For software which is -copyrighted by the Free Software Foundation, write to the Free -Software Foundation; we sometimes make exceptions for this. Our -decision will be guided by the two goals of preserving the free status -of all derivatives of our free software and of promoting the sharing -and reuse of software generally. - - NO WARRANTY - - 15. BECAUSE THE LIBRARY IS LICENSED FREE OF CHARGE, THERE IS NO -WARRANTY FOR THE LIBRARY, TO THE EXTENT PERMITTED BY APPLICABLE LAW. -EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR -OTHER PARTIES PROVIDE THE LIBRARY "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 -LIBRARY IS WITH YOU. SHOULD THE LIBRARY PROVE DEFECTIVE, YOU ASSUME -THE COST OF ALL NECESSARY SERVICING, REPAIR OR CORRECTION. - - 16. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN -WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY -AND/OR REDISTRIBUTE THE LIBRARY 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 -LIBRARY (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 LIBRARY TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF -SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH -DAMAGES. - - END OF TERMS AND CONDITIONS - - How to Apply These Terms to Your New Libraries - - If you develop a new library, and you want it to be of the greatest -possible use to the public, we recommend making it free software that -everyone can redistribute and change. You can do so by permitting -redistribution under these terms (or, alternatively, under the terms of the -ordinary General Public License). - - To apply these terms, attach the following notices to the library. It is -safest to attach them to the start of each source file to most effectively -convey the exclusion of warranty; and each file should have at least the -"copyright" line and a pointer to where the full notice is found. - - {description} - Copyright (C) {year} {fullname} - - This library is free software; you can redistribute it and/or - modify it under the terms of the GNU Lesser General Public - License as published by the Free Software Foundation; either - version 2.1 of the License, or (at your option) any later version. - - This library 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 - Lesser General Public License for more details. - - You should have received a copy of the GNU Lesser General Public - License along with this library; if not, write to the Free Software - Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 - USA - -Also add information on how to contact you by electronic and paper mail. - -You should also get your employer (if you work as a programmer) or your -school, if any, to sign a "copyright disclaimer" for the library, if -necessary. Here is a sample; alter the names: - - Yoyodyne, Inc., hereby disclaims all copyright interest in the - library `Frob' (a library for tweaking knobs) written by James Random - Hacker. - - {signature of Ty Coon}, 1 April 1990 - Ty Coon, President of Vice - -That's all there is to it! +The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software. +THE SOFTWARE IS PROVIDED “AS IS”, WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. From e9fba389ce2bc8c4fc8aae9e15f084f46fa7e5f0 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Sat, 28 Dec 2019 10:47:10 -0800 Subject: [PATCH 212/246] Rename LICENSE to LICENSE.md --- csp/{LICENSE => LICENSE.md} | 0 1 file changed, 0 insertions(+), 0 deletions(-) rename csp/{LICENSE => LICENSE.md} (100%) diff --git a/csp/LICENSE b/csp/LICENSE.md similarity index 100% rename from csp/LICENSE rename to csp/LICENSE.md From ce7e898fa232d21370af6ce7f9d0276e981a75a9 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Sat, 26 Dec 2020 18:01:17 -0800 Subject: [PATCH 213/246] more docs --- csp/csp/scribblings/csp.scrbl | 133 ++++++++++++++++++++++------------ 1 file changed, 85 insertions(+), 48 deletions(-) diff --git a/csp/csp/scribblings/csp.scrbl b/csp/csp/scribblings/csp.scrbl index f24aff53..050f0fe1 100644 --- a/csp/csp/scribblings/csp.scrbl +++ b/csp/csp/scribblings/csp.scrbl @@ -214,29 +214,11 @@ By contrast, when we use a CSP, @italic{all we need are the rules}. The CSP solv @section{Making & solving CSPs} -@defstruct[csp ([vars (listof var?)] - [constraints (listof constraint?)]) - #:transparent]{ -TK -} - -@defstruct[var ([name name?] - [domain (listof any/c)]) - #:transparent]{ -TK -} - -@defstruct[constraint ([names (listof name?)] - [proc procedure?]) - #:transparent]{ -TK -} - @defproc[(make-csp [vars (listof var?) null] [constraints (listof constraint?) empty]) csp?]{ -TK +Create a new CSP. Variables and constraints can be added to the CSP by passing them as arguments. Or you can create an empty CSP and then add variables and constraints imperatively (e.g., with @racket[add-var!] or @racket[add-constraint!]). } @@ -252,7 +234,9 @@ void?] [domain (or/c (listof any/c) procedure?) empty]) void?] )]{ -TK +Imperatively add a new variable called @racket[_name] to the CSP with permissible values listed in @racket[_domain]. The solution to a CSP is a list of pairs where each variable has been assigned a value from its domain. + +@racket[add-vars!] is the same, but adds multiple variables that have the same domain. } @deftogether[( @@ -269,7 +253,7 @@ void?] [func-name (or/c #false name?) #f]) void?] )]{ -TK +Imperatively add a new constraint. The constraint applies the function @racket[_func] to the list of variable names given in @racket[_names]. The return value of @racket[_func] does not need to be a Boolean, but any return value other than @racket[#false] is treated as if it were @racket[#true]. } @defproc[(add-pairwise-constraint! @@ -278,24 +262,68 @@ TK [names (listof name?)] [func-name (or/c #false name?) #f]) void?]{ -TK +Similar to @racket[add-constraint!], but it takes a two-arity procedure @racket[_func] and adds it as a constraint between each pair of names in @racket[_names]. + +Why? CSPs are more efficient with lower-arity constraints (roughly, because you can rule out invalid values sooner). So usually, decomposing a larger-arity constraint into a group of smaller ones is a good idea. + +For instance, suppose you have three variables, and you want them to end up holding values that are coprime. Your constraint function is @racket[coprime?]. This function is variadic (meaning, it can take any number of arguments) so you could use @racket[add-constraint!] like so: + +@racketblock[ +(add-constraint! my-csp coprime? '(a b c)) +] + +But because the comparison can be done two at a time, we could write this instead: + +@racketblock[ +(add-pairwise-constraint! my-csp coprime? '(a b c)) +] + +Which would be equivalent to: + +@racketblock[ +(add-constraint! my-csp coprime? '(a b)) +(add-constraint! my-csp coprime? '(b c)) +(add-constraint! my-csp coprime? '(a c)) +] + +Still, @racket[add-pairwise-constraint!] doesn't substitute for thoughtful constraint design. For instance, suppose instead we want our variables to be strictly increasing. This time, our constraint function is @racket[<]: + +@racketblock[ +(add-constraint! my-csp < '(a b c)) +] + +And we could instead write: + +@racketblock[ +(add-pairwise-constraint! my-csp < '(a b c)) +] + +Which would become: + +@racketblock[ +(add-constraint! my-csp < '(a b)) +(add-constraint! my-csp < '(b c)) +(add-constraint! my-csp < '(a c)) +] + +This is better, but also overkill, because if @racket[(< a b)] and @racket[(< b c)], then by transitivity, @racket[(< a c)] is necessarily true. So this is a case where pairwise expands into more constraints than we actually need. This will not produce any wrong solutions, but especially on larger lists of variables, it creates unnecessary work that my slow down the solution search. } @defproc[(solve [prob csp?] ) -(or/c #false any/c (listof any/c))]{ -TK +(or/c #false (listof (cons/c symbol? any/c)))]{ +Return a solution for the CSP, or @racket[#false] if no solution exists. } @defproc[(solve* [prob csp?] [count natural? +inf.0]) -(listof any/c)]{ -TK +(listof (listof (cons/c symbol? any/c)))]{ +Return all the solutions for the CSP. If there are none, returns @racket[null]. The optional @racket[_count] argument returns a certain number of solutions (or fewer, if not that many solutions exist) } @defform[(in-solutions prob)]{ -TK +Iterator form for use with @racket[for] loops that incrementally returns solutions to @racket[_prob]. } @@ -304,62 +332,71 @@ TK @defproc[(state-count [prob csp?]) natural?]{ -TK +Number of possible variable assignments for @racket[_prob], otherwise known as the state space. This is the product of the domain sizes of each variable. So a CSP that assigns five variables, each of which can have the values @racket["a-z"], has a state count of @racket[(expt 5 26)] = @racket[1490116119384765625]. } @defproc[(csp->graph [prob csp?]) graph?]{ -TK +Creates an undirected graph (using Racket's @racket[graph] library) where each CSP variable is represented in the graph as a vertex, and each constraint between any pair of variables is represented as an edge. } @defproc[(csp->graphviz [prob csp?]) string?]{ -TK +Produce a Graphviz representation of the CSP that can be rendered into a beautiful diagram. } @section{Parameters} - @defparam[current-select-variable val (or/c #false procedure?) #:value #f]{ -TK -} - -@defparam[current-order-values val (or/c #false procedure?) #:value #f]{ -TK +Next variable that the CSP solver will attempt to assign a value to. If @racket[#false], solver just picks the first unassigned variable. } @defparam[current-inference val (or/c #false procedure?) #:value #f]{ -TK +Current inference rule used by the solver. If @racket[#false], solver uses a forward checker. } @defparam[current-solver val (or/c #false procedure?) #:value #f]{ -TK -} - -@defparam[current-random val (or/c #false procedure?) #:value #t]{ -TK +Current solver algorithm used to solve the CSP. If @racket[#false], CSP will use a backtracking solver. } @defparam[current-decompose val (or/c #false procedure?) #:value #t]{ -TK +Whether CSP will be decomposed into independent subproblems (if possible), because smaller CSPs are typically easier to solve than larger ones (and then the component solutions are reassembled into a larger solution). } @defparam[current-thread-count val (or/c #false natural?) #:value 4]{ -TK +Number of threads used by the minimum-conflicts solver. } @defparam[current-node-consistency val (or/c #false procedure?) #:value #f]{ -TK +Whether node consistency is applied. Node consistency is helpful for certain CSPs, but not others, so it is @racket[#false] by default. } @defparam[current-arity-reduction val (or/c #false procedure?) #:value #t]{ -TK +Whether constraints are reduced in arity where possible. This usually helps, so the default is @racket[#true]. } -@defparam[current-learning val (or/c #false procedure?) #:value #f]{ -TK + +@section{Structure types} + + +@defstruct[csp ([vars (listof var?)] + [constraints (listof constraint?)]) + #:transparent]{ +Represents a CSP. +} + +@defstruct[var ([name name?] + [domain (listof any/c)]) + #:transparent]{ +Represents a variable in a CSP. +} + +@defstruct[constraint ([names (listof name?)] + [proc procedure?]) + #:transparent]{ +Represents a constraing in a CSP. } From 1f52342a554308ac4813e1ad9a556daed819c553 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Sat, 26 Dec 2020 18:12:16 -0800 Subject: [PATCH 214/246] add `make-var-names` helper --- csp/csp/hacs.rkt | 5 +++++ csp/csp/scribblings/csp.scrbl | 14 ++++++++++++++ 2 files changed, 19 insertions(+) diff --git a/csp/csp/hacs.rkt b/csp/csp/hacs.rkt index c0e8bbe1..c9192c9a 100644 --- a/csp/csp/hacs.rkt +++ b/csp/csp/hacs.rkt @@ -80,6 +80,11 @@ ((name?) ((listof any/c)) . ->* . var?) (var name (list->set vals))) +(define/contract (make-var-names prefix vals [suffix ""]) + ((string? (listof any/c)) ((string?)) . ->* . (listof name?)) + (for/list ([val (in-list vals)]) + (string->symbol (format "~a~a~a" prefix val suffix)))) + (define/contract (add-vars! prob names [vals-or-procedure empty]) ((csp? (listof name?)) ((or/c (listof any/c) procedure?)) . ->* . void?) (for/fold ([vrs (vars prob)] diff --git a/csp/csp/scribblings/csp.scrbl b/csp/csp/scribblings/csp.scrbl index 050f0fe1..205ad640 100644 --- a/csp/csp/scribblings/csp.scrbl +++ b/csp/csp/scribblings/csp.scrbl @@ -309,6 +309,20 @@ Which would become: This is better, but also overkill, because if @racket[(< a b)] and @racket[(< b c)], then by transitivity, @racket[(< a c)] is necessarily true. So this is a case where pairwise expands into more constraints than we actually need. This will not produce any wrong solutions, but especially on larger lists of variables, it creates unnecessary work that my slow down the solution search. } +@defproc[(make-var-names +[prefix string?] +[vals (listof any/c)] +[suffix string? ""]) +(listof symbol?)]{ +Helper function to generate mass quantities of variable names. The @racket[_prefix] and (optional) @racket[_suffix] strings are wrapped around each value in @racket[_vals], and converted to a symbol. + +@my-examples[ +(make-var-names "foo" (range 6) "bar") +(make-var-names "col" (range 10)) +] + +} + @defproc[(solve [prob csp?] ) (or/c #false (listof (cons/c symbol? any/c)))]{ From c0eaa6ac57413f15c008e06e519bdf8ba1033e11 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Sat, 26 Dec 2020 18:27:56 -0800 Subject: [PATCH 215/246] some more errors --- csp/csp/hacs.rkt | 176 ++++++++++++++++++---------------- csp/csp/scribblings/csp.scrbl | 2 + 2 files changed, 94 insertions(+), 84 deletions(-) diff --git a/csp/csp/hacs.rkt b/csp/csp/hacs.rkt index c9192c9a..653434fa 100644 --- a/csp/csp/hacs.rkt +++ b/csp/csp/hacs.rkt @@ -23,7 +23,7 @@ (if (null? argss) (yield (reverse acc)) (for ([arg (car argss)]) - (loop (cdr argss) (cons arg acc)))))))) + (loop (cdr argss) (cons arg acc)))))))) (struct csp (vars constraints) #:mutable #:transparent) (define constraints csp-constraints) @@ -39,7 +39,7 @@ (raise-argument-error 'constraint "csp" prob)) ;; apply proc in many-to-many style (for/and ([args (in-cartesian (map (λ (name) (find-domain prob name)) (constraint-names const)))]) - (apply (constraint-proc const) args)))) + (apply (constraint-proc const) args)))) (define name? symbol?) @@ -101,27 +101,35 @@ ((csp? name?) ((or/c (listof any/c) procedure?)) . ->* . void?) (add-vars! prob (list name) vals-or-procedure)) -(define/contract (add-constraints! prob proc namess [proc-name #false]) +(define/contract (add-constraints! prob proc namess [proc-name #false] + #:caller [caller-id 'add-constraints!]) ((csp? procedure? (listof (listof name?))) ((or/c #false name?)) . ->* . void?) + (unless (procedure? proc) + (raise-argument-error caller-id "procedure" proc)) + (unless (and (list? namess) (andmap (λ (ns) (and (list? ns) (andmap name? ns))) namess)) + (raise-argument-error caller-id "list of lists of names" namess)) (set-csp-constraints! prob (append (constraints prob) (for/list ([names (in-list namess)]) - (for ([name (in-list names)]) - (check-name-in-csp! 'add-constraints! prob name)) - (make-constraint names (if proc-name - (procedure-rename proc proc-name) - proc)))))) + (for ([name (in-list names)]) + (check-name-in-csp! 'add-constraints! prob name)) + (make-constraint names (if proc-name + (procedure-rename proc proc-name) + proc)))))) (define/contract (add-pairwise-constraint! prob proc names [proc-name #false]) ((csp? procedure? (listof name?)) (name?) . ->* . void?) - (add-constraints! prob proc (combinations names 2) proc-name)) + (unless (and (list? names) (andmap name? names)) + (raise-argument-error 'add-pairwise-constraint! "list of names" names)) + (add-constraints! prob proc (combinations names 2) proc-name #:caller 'add-pairwise-constraint!)) (define/contract (add-constraint! prob proc names [proc-name #false]) ((csp? procedure? (listof name?)) (name?) . ->* . void?) - (add-constraints! prob proc (list names) proc-name)) + (add-constraints! prob proc (list names) proc-name #:caller 'add-constraint!)) -(define/contract (alldiff= x y) +(define/contract (alldiff x y) (any/c any/c . -> . boolean?) (not (= x y))) +(define alldiff= alldiff) (struct backtrack (histories) #:transparent) (define (backtrack! [names null]) (raise (backtrack names))) @@ -148,7 +156,7 @@ (check-name-in-csp! 'find-var prob name) (for/first ([vr (in-vars prob)] #:when (eq? name (var-name vr))) - vr)) + vr)) (define/contract (find-domain prob name) (csp? name? . -> . (listof any/c)) @@ -191,20 +199,20 @@ (ormap assigned? (constraint-names constraint))) (make-csp (vars prob) (for/list ([const (in-constraints prob)]) - (cond - ;; no point reducing 2-arity functions because they will be consumed by forward checking - [(and (or (not minimum-arity) (<= minimum-arity (constraint-arity const))) - (partially-assigned? const)) - (match-define (constraint cnames proc) const) - ;; pattern is mix of values and boxed symbols (indicating variables to persist) - ;; use boxes here as cheap way to distinguish id symbols from value symbols - (define arity-reduction-pattern (for/list ([cname (in-list cnames)]) - (if (assigned? cname) - (first (find-domain prob cname)) - (box cname)))) - (constraint (filter-not assigned? cnames) - (reduce-function-arity proc arity-reduction-pattern))] - [else const])))) + (cond + ;; no point reducing 2-arity functions because they will be consumed by forward checking + [(and (or (not minimum-arity) (<= minimum-arity (constraint-arity const))) + (partially-assigned? const)) + (match-define (constraint cnames proc) const) + ;; pattern is mix of values and boxed symbols (indicating variables to persist) + ;; use boxes here as cheap way to distinguish id symbols from value symbols + (define arity-reduction-pattern (for/list ([cname (in-list cnames)]) + (if (assigned? cname) + (first (find-domain prob cname)) + (box cname)))) + (constraint (filter-not assigned? cnames) + (reduce-function-arity proc arity-reduction-pattern))] + [else const])))) (define nassns 0) (define nfchecks 0) @@ -219,9 +227,9 @@ (begin0 (make-csp (for/list ([vr (in-vars prob)]) - (if (eq? name (var-name vr)) - (assigned-var name (list val)) - vr)) + (if (eq? name (var-name vr)) + (assigned-var name (list val)) + vr)) (constraints prob)) (when-debug (set! nassns (add1 nassns))))) @@ -251,7 +259,7 @@ (for/list ([x (in-list xs)] [val (in-list vals)] #:when (= val target-val)) - x)])) + x)])) (define/contract (argmax* proc xs) (procedure? (listof any/c) . -> . (listof any/c)) @@ -276,7 +284,7 @@ (csp? var? . -> . natural?) (for/sum ([const (in-constraints prob)] #:when (memq (var-name var) (constraint-names const))) - 1)) + 1)) (define/contract (domain-length var) (var? . -> . natural?) @@ -285,7 +293,7 @@ (define/contract (state-count csp) (csp? . -> . natural?) (for/product ([vr (in-vars csp)]) - (domain-length vr))) + (domain-length vr))) (define/contract (mrv-degree-hybrid prob) (csp? . -> . (or/c #f var?)) @@ -304,8 +312,8 @@ [cnames (in-value (constraint-names const))] #:when (and (= (length names) (length cnames)) (for/and ([name (in-list names)]) - (memq name cnames)))) - const)) + (memq name cnames)))) + const)) (define (one-arity? const) (= 1 (constraint-arity const))) (define (two-arity? const) (= 2 (constraint-arity const))) @@ -319,7 +327,7 @@ ((listof (and/c constraint? two-arity?)) . -> . (listof arc?)) (for*/list ([const (in-list constraints)] [name (in-list (constraint-names const))]) - (arc name const))) + (arc name const))) (require sugar/debug) (define/contract (reduce-domain prob ark) @@ -331,16 +339,16 @@ (λ (val other-val) (constraint-proc other-val val)))) ; otherwise reverse arg order (define (satisfies-arc? val) (for/or ([other-val (in-list (find-domain prob other-name))]) - (proc val other-val))) + (proc val other-val))) (make-csp (for/list ([vr (in-vars prob)]) - (cond - [(assigned-var? vr) vr] - [(eq? name (var-name vr)) - (make-var name (match (filter satisfies-arc? (domain vr)) - [(? empty?) (backtrack!)] - [vals vals]))] - [else vr])) + (cond + [(assigned-var? vr) vr] + [(eq? name (var-name vr)) + (make-var name (match (filter satisfies-arc? (domain vr)) + [(? empty?) (backtrack!)] + [vals vals]))] + [else vr])) (constraints prob))) (define/contract (terminating-at? arcs name) @@ -349,7 +357,7 @@ #:when (and (memq name (constraint-names (arc-const arc))) (not (eq? name (arc-name arc))))) - arc)) + arc)) (define/contract (ac-3 prob ref-name) (csp? name? . -> . csp?) @@ -360,8 +368,8 @@ (two-arity-constraints->arcs (for/list ([const (in-constraints prob)] #:when (and (two-arity? const) (for/and ([cname (in-list (constraint-names const))]) - (memq cname checkable-names)))) - const))) + (memq cname checkable-names)))) + const))) (for/fold ([prob prob] [arcs (sort starting-arcs < #:key (λ (a) (length (find-domain prob (arc-name a)))) #:cache-keys? #true)] #:result (prune-singleton-constraints prob)) @@ -390,11 +398,11 @@ (define ref-val (first (find-domain prob ref-name))) (define new-vals (for/set ([val (in-set vals)] - #:when (for/and ([const (in-list constraints)]) - (match const - [(constraint (list (== name eq?) _) proc) (proc val ref-val)] - [(constraint _ proc) (proc ref-val val)]))) - val)) + #:when (for/and ([const (in-list constraints)]) + (match const + [(constraint (list (== name eq?) _) proc) (proc val ref-val)] + [(constraint _ proc) (proc ref-val val)]))) + val)) (checked-variable name new-vals (cons (cons ref-name ref-val) (match vr [(checked-variable _ _ history) history] [_ null])))])])) @@ -403,15 +411,15 @@ ((csp?) ((or/c #false name?)) . ->* . csp?) (define singleton-var-names (for/list ([vr (in-vars prob)] #:when (singleton-var? vr)) - (var-name vr))) + (var-name vr))) (make-csp (vars prob) (for/list ([const (in-constraints prob)] #:unless (and (two-arity? const) (or (not ref-name) (constraint-relates? const ref-name)) (for/and ([cname (in-list (constraint-names const))]) - (memq cname singleton-var-names)))) - const))) + (memq cname singleton-var-names)))) + const))) (define/contract (forward-check prob ref-name) (csp? name? . -> . csp?) @@ -420,7 +428,7 @@ ;; conflict-set will be empty if there are no empty domains (as we would hope) (define conflict-set (for/list ([cvr (in-list checked-vars)] #:when (set-empty? (domain cvr))) - (history cvr))) + (history cvr))) ;; for conflict-directed backjumping it's essential to forward-check ALL vars ;; (even after an empty domain is generated) and combine their conflicts ;; so we can discover the *most recent past var* that could be the culprit. @@ -437,7 +445,7 @@ ;; constraint is checkable if all constraint names ;; are in target list of names. (for/and ([cname (in-list (constraint-names const))]) - (memq cname names))) + (memq cname names))) (define/contract (constraint-arity const) (constraint? . -> . natural?) @@ -454,21 +462,21 @@ (partition (λ (const) (and (constraint-checkable? const assigned-varnames) (or (not mandatory-names) (for/and ([name (in-list mandatory-names)]) - (constraint-relates? const name))))) + (constraint-relates? const name))))) (constraints prob))) (cond [conflict-count? (define conflict-count (for/sum ([constraint (in-list checkable-consts)] #:unless (constraint prob)) - 1)) + 1)) (when-debug (set! nchecks (+ conflict-count nchecks))) conflict-count] [else (for ([(constraint idx) (in-indexed checkable-consts)] #:unless (constraint prob)) - (when-debug (set! nchecks (+ (add1 idx) nchecks))) - (backtrack!)) + (when-debug (set! nchecks (+ (add1 idx) nchecks))) + (backtrack!)) ;; discard checked constraints, since they have no further reason to live (make-csp (vars prob) other-consts)])) @@ -480,19 +488,19 @@ prob (make-csp (for/list ([vr (in-vars prob)]) - (match-define (var name vals) vr) - (define name-constraints (filter (λ (const) (constraint-relates? const name)) unary-constraints)) - (make-var name (for/set ([val (in-set vals)] - #:when (for/and ([const (in-list name-constraints)]) - ((constraint-proc const) val))) - val))) + (match-define (var name vals) vr) + (define name-constraints (filter (λ (const) (constraint-relates? const name)) unary-constraints)) + (make-var name (for/set ([val (in-set vals)] + #:when (for/and ([const (in-list name-constraints)]) + ((constraint-proc const) val))) + val))) other-constraints))) (define ((make-hist-proc assocs) . xs) (not (for/and ([x (in-list xs)] [val (in-list (map cdr assocs))]) - (equal? x val)))) + (equal? x val)))) (define/contract (backtracking-solver prob @@ -513,7 +521,7 @@ (and (backtrack? exn) (or (let ([bths (backtrack-histories exn)]) (or (empty? bths) (for*/or ([bth bths] [rec bth]) - (eq? name (car rec)))))))) + (eq? name (car rec)))))))) (for/fold ([conflicts null] #:result (void)) ([val (in-list (order-domain-values (set->list domain)))]) @@ -523,7 +531,7 @@ (append conflicts (remq name (remove-duplicates (for*/list ([bth (in-list bths)] [rec (in-list bth)]) - (car rec)) eq?))))]) + (car rec)) eq?))))]) (let* ([prob (assign-val prob name val)] ;; reduce constraints before inference, ;; to create more forward-checkable (binary) constraints @@ -565,9 +573,9 @@ ((csp?) (integer?) . ->* . generator?) (generator () (for ([thread-count (or (current-thread-count) 1)]) ; todo: what is ideal thread count? - (make-min-conflcts-thread prob thread-count max-steps)) + (make-min-conflcts-thread prob thread-count max-steps)) (for ([i (in-naturals)]) - (yield (thread-receive))))) + (yield (thread-receive))))) (define/contract (optimal-stop-min proc xs) (procedure? (listof any/c) . -> . any/c) @@ -575,7 +583,7 @@ (define threshold (argmin proc sample)) (or (for/first ([candidate (in-list candidates)] #:when (<= (proc candidate) threshold)) - candidate) + candidate) (last candidates))) (define/contract (conflicted-variable-names prob) @@ -583,7 +591,7 @@ ;; Return a list of variables in current assignment that are conflicted (for/list ([name (in-var-names prob)] #:when (positive? (nconflicts prob name))) - name)) + name)) (define/contract (min-conflicts-value prob name vals) (csp? name? (listof any/c) . -> . any/c) @@ -592,7 +600,7 @@ #:cache-keys? #true)) (for/first ([val (in-list vals-by-conflict)] #:unless (equal? val (first (find-domain prob name)))) ;; but change the value - val)) + val)) (define no-value-sig (gensym)) @@ -607,11 +615,11 @@ ((csp?) ((listof name?)) . ->* . (listof (cons/c name? any/c))) (define assocs (for/list ([vr (in-vars prob)]) - (match vr - [(var name (list val)) (cons name val)]))) + (match vr + [(var name (list val)) (cons name val)]))) (if keys (for/list ([key (in-list keys)]) - (assq key assocs)) + (assq key assocs)) assocs)) (define/contract (combine-csps probs) @@ -626,16 +634,16 @@ (make-csp (for/list ([vr (in-vars prob)] #:when (memq (var-name vr) names)) - vr) + vr) (for/list ([const (in-constraints prob)] #:when (constraint-checkable? const names)) - const))) + const))) (define (decompose-prob prob) ; decompose into independent csps. `cc` determines "connected components" (if (current-decompose) (for/list ([nodeset (in-list (cc (csp->graph prob)))]) - (extract-subcsp prob nodeset)) + (extract-subcsp prob nodeset)) (list prob))) (define (make-solution-generator prob) @@ -643,10 +651,10 @@ (define subprobs (decompose-prob prob)) (define solgens (map (current-solver) subprobs)) (define solstreams (for/list ([solgen (in-list solgens)]) - (for/stream ([sol (in-producer solgen (void))]) - sol))) + (for/stream ([sol (in-producer solgen (void))]) + sol))) (for ([solution-pieces (in-cartesian solstreams)]) - (yield (combine-csps solution-pieces))))) + (yield (combine-csps solution-pieces))))) (define-syntax-rule (in-solutions PROB) (in-producer (make-solution-generator PROB) (void))) @@ -660,7 +668,7 @@ (parameterize ([current-solver (or solver (current-solver) backtracking-solver)]) (for/list ([sol (in-solutions prob)] [idx (in-range max-solutions)]) - (finish-proc sol)))) + (finish-proc sol)))) (define/contract (solve prob #:finish-proc [finish-proc (λ (p) (csp->assocs p (map var-name (vars prob))))] diff --git a/csp/csp/scribblings/csp.scrbl b/csp/csp/scribblings/csp.scrbl index 205ad640..946b8b7e 100644 --- a/csp/csp/scribblings/csp.scrbl +++ b/csp/csp/scribblings/csp.scrbl @@ -254,6 +254,8 @@ void?] void?] )]{ Imperatively add a new constraint. The constraint applies the function @racket[_func] to the list of variable names given in @racket[_names]. The return value of @racket[_func] does not need to be a Boolean, but any return value other than @racket[#false] is treated as if it were @racket[#true]. + +@racket[add-constraints!] is the same, but adds the constraint @racket[_func] to each list of variable names in @racket[_namess] (which is therefore a list of lists of variable names). } @defproc[(add-pairwise-constraint! From 7973ed10a2013638b6d31a367ad20e124738f23c Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Sat, 26 Dec 2020 19:38:09 -0800 Subject: [PATCH 216/246] error --- csp/csp/hacs.rkt | 2 ++ 1 file changed, 2 insertions(+) diff --git a/csp/csp/hacs.rkt b/csp/csp/hacs.rkt index 653434fa..58dc1292 100644 --- a/csp/csp/hacs.rkt +++ b/csp/csp/hacs.rkt @@ -124,6 +124,8 @@ (define/contract (add-constraint! prob proc names [proc-name #false]) ((csp? procedure? (listof name?)) (name?) . ->* . void?) + (unless (and (list? names) (andmap name? names)) + (raise-argument-error 'add-constraint! "list of names" names)) (add-constraints! prob proc (list names) proc-name #:caller 'add-constraint!)) (define/contract (alldiff x y) From e56a83d5cc14ff88f88afc064eeb5cfc491d803b Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Sat, 26 Dec 2020 19:44:27 -0800 Subject: [PATCH 217/246] docs --- csp/csp/scribblings/csp.scrbl | 33 ++++++++++++++++++++++++++++++++- 1 file changed, 32 insertions(+), 1 deletion(-) diff --git a/csp/csp/scribblings/csp.scrbl b/csp/csp/scribblings/csp.scrbl index 946b8b7e..e8fdfff7 100644 --- a/csp/csp/scribblings/csp.scrbl +++ b/csp/csp/scribblings/csp.scrbl @@ -369,8 +369,12 @@ Produce a Graphviz representation of the CSP that can be rendered into a beautif Next variable that the CSP solver will attempt to assign a value to. If @racket[#false], solver just picks the first unassigned variable. } +@defparam[current-order-values val (or/c #false procedure?) #:value #f]{ +Procedure that orders the remaining values in a domain. Default is @racket[#false], which means that the domain values are tried in their original order. If bad values are likely to be clustered together, it can be worth trying @racket[shuffle] for this parameter, which randomizes which value gets chosen next. Shuffling is also helpful in CSPs where all the variable values must be different (because otherwise, the values for every variable are tried in the same order, which means that the search space is front-loaded with failure). +} + @defparam[current-inference val (or/c #false procedure?) #:value #f]{ -Current inference rule used by the solver. If @racket[#false], solver uses a forward checker. +Current inference rule used by the solver. If @racket[#false], solver uses @racket[forward-check]. } @defparam[current-solver val (or/c #false procedure?) #:value #f]{ @@ -387,12 +391,39 @@ Number of threads used by the minimum-conflicts solver. @defparam[current-node-consistency val (or/c #false procedure?) #:value #f]{ Whether node consistency is applied. Node consistency is helpful for certain CSPs, but not others, so it is @racket[#false] by default. + +Helpful for which CSPs? ``Node consistency'' means that for any one-arity (aka unary) constraints on a variable, we immediately filter out any domain values that don't satisfy the constraint. } @defparam[current-arity-reduction val (or/c #false procedure?) #:value #t]{ Whether constraints are reduced in arity where possible. This usually helps, so the default is @racket[#true]. + +Why does it help? Because lower-arity constraints tend to be faster to test, and the solver can use node consistency on one-arity constraints (see @racket[current-node-cosistency]). + +For instance, suppose we have variables representing positive integers @racket[a] and @racket[b] and the constraint says @racket[(< a b)]. Further suppose that @racket[b] is assigned value @racket[5]. At that point, this constraint can be ``rephrased'' as the one-arity function @racket[(< a 5)]. This implies that there are only four possible values for @racket[a] (namely, @racket['(1 2 3 4)])). If node consistency is active, the domain of @racket[a] can immediately be checked to see if it includes any of those values. But none of this is possible if we don't reduce the arity. +} + +@section{Other helpers} + +@defproc[(mrv-degree-hybrid +[prob csp?]) +(or/c #false var?)]{ +Use this with @racket[current-select-variable]. Selects next variable for assignment by choosing the one with the shortest remaining domain length and maximum number of constraints. The idea is that this variable is likely to fail more quickly than others, so we'd rather trigger that failure as soon as we can (in which case we know we need to explore a different part of the state space). } +@defproc[(forward-check +[prob csp?] +[name name?]) +csp?]{ +Used for inference when @racket[current-inference] is not otherwise set. Tests whether the newest variable assignment necessarily causes any other variable domains to collapse, and thereby discovers a failure faster than backtracking alone. +} + +@defproc[(ac-3 +[prob csp?] +[name name?]) +csp?]{ +Can be used for inference by passing to @racket[current-inference]. Applies the AC-3 arc-consistency algorithm. Similar to forward checking, but checks pairs of variables rather than single variables. Thus, it is a more thorough form of inference, but for that reason it will usually take longer (and may not add much value). +} @section{Structure types} From fb6b209d0e2c621e347d352e645a039bdfbf8539 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Sun, 27 Dec 2020 09:00:55 -0800 Subject: [PATCH 218/246] spelling --- csp/csp/scribblings/csp.scrbl | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/csp/csp/scribblings/csp.scrbl b/csp/csp/scribblings/csp.scrbl index e8fdfff7..f9897bc1 100644 --- a/csp/csp/scribblings/csp.scrbl +++ b/csp/csp/scribblings/csp.scrbl @@ -392,13 +392,13 @@ Number of threads used by the minimum-conflicts solver. @defparam[current-node-consistency val (or/c #false procedure?) #:value #f]{ Whether node consistency is applied. Node consistency is helpful for certain CSPs, but not others, so it is @racket[#false] by default. -Helpful for which CSPs? ``Node consistency'' means that for any one-arity (aka unary) constraints on a variable, we immediately filter out any domain values that don't satisfy the constraint. +Helpful for which CSPs? ``Node consistency'' means that for any one-arity (aka unary) constraints on a variable, we can filter out any domain values that don't satisfy the constraint, thereby reducing the size of the search space. So if the CSP starts with unary constraints, and the constraints foreclose certain values, node consistency can be useful. The cost of node consistency is proportional to the number of values in the domain (because all of them have to be tested). } @defparam[current-arity-reduction val (or/c #false procedure?) #:value #t]{ Whether constraints are reduced in arity where possible. This usually helps, so the default is @racket[#true]. -Why does it help? Because lower-arity constraints tend to be faster to test, and the solver can use node consistency on one-arity constraints (see @racket[current-node-cosistency]). +Why does it help? Because lower-arity constraints tend to be faster to test, and the solver can use node consistency on one-arity constraints (see @racket[current-node-consistency]). For instance, suppose we have variables representing positive integers @racket[a] and @racket[b] and the constraint says @racket[(< a b)]. Further suppose that @racket[b] is assigned value @racket[5]. At that point, this constraint can be ``rephrased'' as the one-arity function @racket[(< a 5)]. This implies that there are only four possible values for @racket[a] (namely, @racket['(1 2 3 4)])). If node consistency is active, the domain of @racket[a] can immediately be checked to see if it includes any of those values. But none of this is possible if we don't reduce the arity. } From d17c3b0f9f7854fdfbe761adf2a5def36808069d Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Sun, 27 Dec 2020 09:34:24 -0800 Subject: [PATCH 219/246] note --- csp/csp/scribblings/csp.scrbl | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/csp/csp/scribblings/csp.scrbl b/csp/csp/scribblings/csp.scrbl index f9897bc1..e71f3df7 100644 --- a/csp/csp/scribblings/csp.scrbl +++ b/csp/csp/scribblings/csp.scrbl @@ -39,6 +39,13 @@ Even if the name is new, the idea of a CSP is probably familiar. For instance, When the computer solves a CSP, it's using an analogous process of deductive reasoning to eliminate impossible assignments, eventually converging on a solution (or determining that no solution exists). +@section{So this is the ultimate tool for the lazy programmer?} + +It allows us to describe a problem to the computer in higher-level terms than we usually do. That can be helpful when we have no idea how to create a specialized algorithm, or we just don't feel like it. + +But there's still some finesse and artistry involved in setting up the CSP, especially its constraints. In general, a CSP with more constraints will converge on a solution faster. Furthermore, since we're not just lazy but also impatient, we usually want our answer in a few seconds, not tomorrow or next week. So it's usually worth spending a little extra effort to specify the constraints as carefully as we can, to maximize our chances of getting an answer in a reasonable time. + + @section{First example} Suppose we wanted to find @link["http://www.friesian.com/pythag.htm"]{Pythagorean triples} with sides between 10 and 49, inclusive. From b4412ef7a6b9fd06049cfae284aff1f2968c5f1a Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Sun, 27 Dec 2020 18:13:35 -0800 Subject: [PATCH 220/246] more --- csp/csp/hacs.rkt | 22 ++++++---- csp/csp/scribblings/csp.scrbl | 77 +++++++++++++++++++++++++++-------- 2 files changed, 73 insertions(+), 26 deletions(-) diff --git a/csp/csp/hacs.rkt b/csp/csp/hacs.rkt index 58dc1292..e2b7332b 100644 --- a/csp/csp/hacs.rkt +++ b/csp/csp/hacs.rkt @@ -15,14 +15,14 @@ (define (print-debug-info) (when-debug - (displayln (format "assignments: ~a forward checks ~a checks: ~a " nassns nchecks nfchecks)))) + (displayln (format "assignments: ~a forward checks: ~a checks: ~a " nassns nchecks nfchecks)))) (define-syntax-rule (in-cartesian x) (in-generator (let ([argss x]) (let loop ([argss argss][acc empty]) (if (null? argss) (yield (reverse acc)) - (for ([arg (car argss)]) + (for ([arg (in-stream (car argss))]) (loop (cdr argss) (cons arg acc)))))))) (struct csp (vars constraints) #:mutable #:transparent) @@ -41,8 +41,6 @@ (for/and ([args (in-cartesian (map (λ (name) (find-domain prob name)) (constraint-names const)))]) (apply (constraint-proc const) args)))) -(define name? symbol?) - (define/contract (make-constraint [names null] [proc values]) (() ((listof name?) procedure?) . ->* . constraint?) (constraint names proc)) @@ -61,6 +59,7 @@ gr)) (struct var (name domain) #:transparent) +(define (var-name? x) #true) ; anything is ok for now (define domain var-domain) (struct checked-variable var (history) #:transparent) @@ -106,7 +105,7 @@ ((csp? procedure? (listof (listof name?))) ((or/c #false name?)) . ->* . void?) (unless (procedure? proc) (raise-argument-error caller-id "procedure" proc)) - (unless (and (list? namess) (andmap (λ (ns) (and (list? ns) (andmap name? ns))) namess)) + (unless (and (list? namess) (andmap list? namess)) (raise-argument-error caller-id "list of lists of names" namess)) (set-csp-constraints! prob (append (constraints prob) (for/list ([names (in-list namess)]) @@ -118,13 +117,13 @@ (define/contract (add-pairwise-constraint! prob proc names [proc-name #false]) ((csp? procedure? (listof name?)) (name?) . ->* . void?) - (unless (and (list? names) (andmap name? names)) + (unless (list? names) (raise-argument-error 'add-pairwise-constraint! "list of names" names)) (add-constraints! prob proc (combinations names 2) proc-name #:caller 'add-pairwise-constraint!)) (define/contract (add-constraint! prob proc names [proc-name #false]) ((csp? procedure? (listof name?)) (name?) . ->* . void?) - (unless (and (list? names) (andmap name? names)) + (unless (list? names) (raise-argument-error 'add-constraint! "list of names" names)) (add-constraints! prob proc (list names) proc-name #:caller 'add-constraint!)) @@ -133,6 +132,11 @@ (not (= x y))) (define alldiff= alldiff) +(define (add-all-diff-constraint! prob [names (map var-name (csp-vars prob))] + #:proc [equal-proc equal?]) + (add-pairwise-constraint! prob (λ (x y) (not (equal-proc x y))) names + (string->symbol (format "all-diff-~a" (object-name equal-proc))))) + (struct backtrack (histories) #:transparent) (define (backtrack! [names null]) (raise (backtrack names))) @@ -521,8 +525,8 @@ [(var name domain) (define (wants-backtrack? exn) (and (backtrack? exn) (or (let ([bths (backtrack-histories exn)]) - (or (empty? bths) (for*/or ([bth bths] - [rec bth]) + (or (empty? bths) (for*/or ([bth (in-list bths)] + [rec (in-list bth)]) (eq? name (car rec)))))))) (for/fold ([conflicts null] #:result (void)) diff --git a/csp/csp/scribblings/csp.scrbl b/csp/csp/scribblings/csp.scrbl index e71f3df7..9ba15098 100644 --- a/csp/csp/scribblings/csp.scrbl +++ b/csp/csp/scribblings/csp.scrbl @@ -232,12 +232,12 @@ Create a new CSP. Variables and constraints can be added to the CSP by passing t @deftogether[( @defproc[(add-var! [prob csp?] -[name name?] +[name var-name?] [domain (or/c (listof any/c) procedure?) empty]) void?] @defproc[(add-vars! [prob csp?] -[names (listof name?)] +[names (listof var-name?)] [domain (or/c (listof any/c) procedure?) empty]) void?] )]{ @@ -250,14 +250,14 @@ Imperatively add a new variable called @racket[_name] to the CSP with permissibl @defproc[(add-constraint! [prob csp?] [func procedure?] -[names (listof name?)] -[func-name (or/c #false name?) #f]) +[names (listof var-name?)] +[func-name (or/c #false var-name?) #f]) void?] @defproc[(add-constraints! [prob csp?] [func procedure?] -[namess (listof (listof name?))] -[func-name (or/c #false name?) #f]) +[namess (listof (listof var-name?))] +[func-name (or/c #false var-name?) #f]) void?] )]{ Imperatively add a new constraint. The constraint applies the function @racket[_func] to the list of variable names given in @racket[_names]. The return value of @racket[_func] does not need to be a Boolean, but any return value other than @racket[#false] is treated as if it were @racket[#true]. @@ -265,11 +265,20 @@ Imperatively add a new constraint. The constraint applies the function @racket[_ @racket[add-constraints!] is the same, but adds the constraint @racket[_func] to each list of variable names in @racket[_namess] (which is therefore a list of lists of variable names). } +@defproc[(add-all-diff-constraint! +[prob csp?] +[names (listof var-name?) (map var-name (csp-vars prob))] +[#:proc equal-proc equal?]) +void?]{ +Imperatively add an ``all diff'' constraint, which is a pairwise @racket[(compose1 not equal?)] constraint. A equality function other than @racket[equal?] can be passed via the @racket[#:proc] argument. There is nothing special about using this function vs. applying the constraint manually. +} + + @defproc[(add-pairwise-constraint! [prob csp?] [func procedure?] -[names (listof name?)] -[func-name (or/c #false name?) #f]) +[names (listof var-name?)] +[func-name (or/c #false var-name?) #f]) void?]{ Similar to @racket[add-constraint!], but it takes a two-arity procedure @racket[_func] and adds it as a constraint between each pair of names in @racket[_names]. @@ -410,29 +419,58 @@ Why does it help? Because lower-arity constraints tend to be faster to test, and For instance, suppose we have variables representing positive integers @racket[a] and @racket[b] and the constraint says @racket[(< a b)]. Further suppose that @racket[b] is assigned value @racket[5]. At that point, this constraint can be ``rephrased'' as the one-arity function @racket[(< a 5)]. This implies that there are only four possible values for @racket[a] (namely, @racket['(1 2 3 4)])). If node consistency is active, the domain of @racket[a] can immediately be checked to see if it includes any of those values. But none of this is possible if we don't reduce the arity. } -@section{Other helpers} + +@section{Selecting the next variable} + +Pass these functions to @racket[current-select-variable]. @defproc[(mrv-degree-hybrid [prob csp?]) (or/c #false var?)]{ -Use this with @racket[current-select-variable]. Selects next variable for assignment by choosing the one with the shortest remaining domain length and maximum number of constraints. The idea is that this variable is likely to fail more quickly than others, so we'd rather trigger that failure as soon as we can (in which case we know we need to explore a different part of the state space). +Selects next variable for assignment by choosing the one with the fewest values in its domain (aka @italic{minimum remaining values} or @italic{mrv}; see also @racket[minimum-remaining-values]) and largest number of constraints (aka @italic{degree}; see also @racket[max-degree]). The idea is that this variable is likely to fail more quickly than others, so we'd rather trigger that failure as soon as we can (in which case we know we need to explore a different part of the state space). } +@defproc[(minimum-remaining-values +[prob csp?]) +(or/c #false var?)]{ +Selects next variable for assignment by choosing the one with the fewest values in its domain. +} + +@defproc[(max-degree +[prob csp?]) +(or/c #false var?)]{ +Selects next variable for assignment by choosing the one with the largest number of constraints. +} + +@section{Inference} + +Pass these functions to @racket[current-inference]. + @defproc[(forward-check [prob csp?] -[name name?]) +[name var-name?]) csp?]{ Used for inference when @racket[current-inference] is not otherwise set. Tests whether the newest variable assignment necessarily causes any other variable domains to collapse, and thereby discovers a failure faster than backtracking alone. } @defproc[(ac-3 [prob csp?] -[name name?]) +[name var-name?]) +csp?]{ +Applies the AC-3 arc-consistency algorithm. Similar to forward checking, but checks pairs of variables rather than single variables. Thus, it is a more thorough form of inference, but for that reason it will usually take longer (and may not add much value). +} + + +@defproc[(no-inference +[prob csp?] +[name var-name?]) csp?]{ -Can be used for inference by passing to @racket[current-inference]. Applies the AC-3 arc-consistency algorithm. Similar to forward checking, but checks pairs of variables rather than single variables. Thus, it is a more thorough form of inference, but for that reason it will usually take longer (and may not add much value). +Truth in advertising: performs no inference. } -@section{Structure types} + + +@section{Structure types & predicates} @defstruct[csp ([vars (listof var?)] @@ -441,22 +479,27 @@ Can be used for inference by passing to @racket[current-inference]. Applies the Represents a CSP. } -@defstruct[var ([name name?] +@defstruct[var ([name var-name?] [domain (listof any/c)]) #:transparent]{ Represents a variable in a CSP. } -@defstruct[constraint ([names (listof name?)] +@defstruct[constraint ([names (listof var-name?)] [proc procedure?]) #:transparent]{ Represents a constraing in a CSP. } +@defproc[(var-name? +[x any/c]) +boolean?]{ +Check whether @racket[_x] is a valid CSP variable name, which today can mean any value, but I might change my mind. +} @section{License & source code} -This module is licensed under the LGPL. +This module is licensed under the MIT license. Source repository at @link["http://github.com/mbutterick/csp"]{http://github.com/mbutterick/csp}. Suggestions & corrections welcome. From 096bf798510ace9f8ee1b5d27012ab988836d712 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Sun, 27 Dec 2020 18:21:29 -0800 Subject: [PATCH 221/246] simplify --- csp/csp/hacs-test-queens.rkt | 20 +++++++++----------- 1 file changed, 9 insertions(+), 11 deletions(-) diff --git a/csp/csp/hacs-test-queens.rkt b/csp/csp/hacs-test-queens.rkt index 14aa0a1b..da040551 100644 --- a/csp/csp/hacs-test-queens.rkt +++ b/csp/csp/hacs-test-queens.rkt @@ -12,27 +12,25 @@ (define board-size 8) (define queens (make-csp)) -(define qs (for/list ([q board-size]) (string->symbol (format "q~a" q)))) +(define qs (range board-size)) (define rows (range (length qs))) (add-vars! queens qs rows) -(define (q-col q) (string->number (string-trim (symbol->string q) "q"))) (for* ([qs (in-combinations qs 2)]) (match-define (list qa qb) qs) - (match-define (list qa-col qb-col) (map q-col qs)) (add-constraint! queens (λ (qa-row qb-row) - (not (= (abs (- qa-row qb-row)) (abs (- (q-col qa) (q-col qb)))))) ; same diag? - (list qa qb)) - (add-constraint! queens (negate =) (list qa qb))) + (not (= (abs (- qa-row qb-row)) (abs (- qa qb))))) ; same diag? + (list qa qb))) +(add-all-diff-constraint! queens #:proc eq?) (define (sol->string sol) (define assocs (csp->assocs sol)) - (string-join (for/list ([q (in-list (sort assocs stringstring car)))]) - (apply string (add-between (for/list ([idx (in-range board-size)]) - (if (= idx (cdr q)) #\@ #\·)) #\space))) "\n")) + (string-join (for/list ([q (in-list (sort assocs < #:key car))]) + (apply string (add-between (for/list ([idx (in-range board-size)]) + (if (= idx (cdr q)) #\@ #\·)) #\space))) "\n")) (current-thread-count 4) (displayln (solve queens #:finish-proc sol->string)) -(parameterize ([current-solver min-conflicts-solver]) - (time (solve queens))) +(parameterize (#;[current-solver min-conflicts-solver]) + (time (solve queens))) From 0274fb999f154a6a5e93122121dafd935f512903 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Mon, 28 Dec 2020 08:16:49 -0800 Subject: [PATCH 222/246] fix min-conflicts-solver (closes #2) --- csp/csp/hacs.rkt | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/csp/csp/hacs.rkt b/csp/csp/hacs.rkt index e2b7332b..3736c846 100644 --- a/csp/csp/hacs.rkt +++ b/csp/csp/hacs.rkt @@ -377,14 +377,14 @@ (memq cname checkable-names)))) const))) (for/fold ([prob prob] - [arcs (sort starting-arcs < #:key (λ (a) (length (find-domain prob (arc-name a)))) #:cache-keys? #true)] + [arcs (sort starting-arcs < #:key (λ (a) (domain-length (find-domain prob (arc-name a)))) #:cache-keys? #true)] #:result (prune-singleton-constraints prob)) ([i (in-naturals)] #:break (empty? arcs)) (match-define (cons (arc name proc) other-arcs) arcs) (define reduced-csp (reduce-domain prob (arc name proc))) (define (domain-reduced? name) - (= (length (find-domain prob name)) (length (find-domain reduced-csp name)))) + (= (domain-length (find-domain prob name)) (domain-length (find-domain reduced-csp name)))) (values reduced-csp (if (domain-reduced? name) (remove-duplicates (append (starting-arcs . terminating-at? . name) other-arcs)) other-arcs)))) @@ -553,7 +553,7 @@ ((non-empty-listof any/c) . -> . any/c) (match xs [(list x) x] - [xs (list-ref xs (random (length xs)))])) + [(app set->list xs) (list-ref xs (random (length xs)))])) (define (assign-random-vals prob) (for/fold ([new-csp prob]) @@ -602,7 +602,7 @@ (define/contract (min-conflicts-value prob name vals) (csp? name? (listof any/c) . -> . any/c) ;; Return the value that will give var the least number of conflicts - (define vals-by-conflict (sort vals < #:key (λ (val) (nconflicts prob name val)) + (define vals-by-conflict (sort (set->list vals) < #:key (λ (val) (nconflicts prob name val)) #:cache-keys? #true)) (for/first ([val (in-list vals-by-conflict)] #:unless (equal? val (first (find-domain prob name)))) ;; but change the value From c562ddbdb7ed3bff8490c3139311f1c8e9e7c47c Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Mon, 28 Dec 2020 08:42:04 -0800 Subject: [PATCH 223/246] document solvers --- csp/csp/hacs.rkt | 2 +- csp/csp/scribblings/csp.scrbl | 33 +++++++++++++++++++++++++++++++-- 2 files changed, 32 insertions(+), 3 deletions(-) diff --git a/csp/csp/hacs.rkt b/csp/csp/hacs.rkt index 3736c846..6415e3fa 100644 --- a/csp/csp/hacs.rkt +++ b/csp/csp/hacs.rkt @@ -576,7 +576,7 @@ (assign-val prob name val)])))))) (define/contract (min-conflicts-solver prob [max-steps 100]) - ((csp?) (integer?) . ->* . generator?) + ((csp?) (exact-positive-integer?) . ->* . generator?) (generator () (for ([thread-count (or (current-thread-count) 1)]) ; todo: what is ideal thread count? (make-min-conflcts-thread prob thread-count max-steps)) diff --git a/csp/csp/scribblings/csp.scrbl b/csp/csp/scribblings/csp.scrbl index 9ba15098..9ed97cdc 100644 --- a/csp/csp/scribblings/csp.scrbl +++ b/csp/csp/scribblings/csp.scrbl @@ -394,7 +394,7 @@ Current inference rule used by the solver. If @racket[#false], solver uses @rack } @defparam[current-solver val (or/c #false procedure?) #:value #f]{ -Current solver algorithm used to solve the CSP. If @racket[#false], CSP will use a backtracking solver. +Current solver algorithm used to solve the CSP. If @racket[#false], CSP will use @racket[backtracking-solver]. } @defparam[current-decompose val (or/c #false procedure?) #:value #t]{ @@ -402,7 +402,7 @@ Whether CSP will be decomposed into independent subproblems (if possible), becau } @defparam[current-thread-count val (or/c #false natural?) #:value 4]{ -Number of threads used by the minimum-conflicts solver. +Number of threads used by the @racket[min-conflicts-solver]. } @defparam[current-node-consistency val (or/c #false procedure?) #:value #f]{ @@ -419,6 +419,35 @@ Why does it help? Because lower-arity constraints tend to be faster to test, and For instance, suppose we have variables representing positive integers @racket[a] and @racket[b] and the constraint says @racket[(< a b)]. Further suppose that @racket[b] is assigned value @racket[5]. At that point, this constraint can be ``rephrased'' as the one-arity function @racket[(< a 5)]. This implies that there are only four possible values for @racket[a] (namely, @racket['(1 2 3 4)])). If node consistency is active, the domain of @racket[a] can immediately be checked to see if it includes any of those values. But none of this is possible if we don't reduce the arity. } +@section{Solvers} + +Pass these functions to @racket[current-solver]. + +@defproc[(backtracking-solver +[prob csp?]) +generator?]{ +The default solver. Conducts an exhaustive, deterministic search of the state space. @italic{Backtracking} means that when the solver reaches a dead end in the search space, it unwinds to the last successful variable assignment and tries again. The details of its behavior are modified by @racket[current-select-variable], @racket[current-inference], and @racket[current-node-consistency]. + +The advantage of the backtracking solver: it proceeds through the search space in a systematic matter. If there is a solution, the backtracking solver will find it. Eventually. + +The disadvantage: the same. Some search spaces are so huge, and the solutions so rare, that concentrating the effort on searching any particular branch is likely to be futile. For a more probabilistic approach, try @racket[min-conflicts-solver]. +} + +@defproc[(min-conflicts-solver +[prob csp?] +[max-steps exact-positive-integer? 100]) +generator?]{ +An alternative solver. Begins with a random assignment and then tries to minimize the number of conflicts (that is, constraint violations), up to @racket[_max-steps] (which defaults to 100). In essence, this is a probabilistic hill-climbing algorithm, where the solver makes random guesses and then tries to nudge those guesses toward the correct answer. + +I like to imagine the solver flying above the search space with a planeload of paratroopers, who are dropped into the search territory. Each of them tries to walk from the place they land (= the initial random assignment) toward a solution. + +It's a little weird that this works at all, but it does. Sometimes even better than the @racket[backtracking-solver], because the minimum-conflicts solver is ``sampling'' the search space at many diverse locations. Whereas the @racket[backtracking-solver] can get stuck in a fruitless area of the search space, the minimum-conflicts solver keeps moving around. + +Of course, to avoid getting stuck, the minimum-conflicts solver has to abandon guesses that aren't panning out. Hence the @racket[_max-steps] argument, which controls the number of steps the solver takes on a certain attempt before giving up. + +The other parameter that affects this solver is @racket[current-thread-count], which defaults to 4. The solver is multithreaded in the sense that it pursues multiple solutions simultaneously. This way, if one thread finds a solution earlier, it will not be blocked by the others. +} + @section{Selecting the next variable} From b7608d35aad271b90c625d1351b723fe9b73e148 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Mon, 28 Dec 2020 08:47:34 -0800 Subject: [PATCH 224/246] link --- csp/csp/hacs.rkt | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/csp/csp/hacs.rkt b/csp/csp/hacs.rkt index 6415e3fa..3fe86d6a 100644 --- a/csp/csp/hacs.rkt +++ b/csp/csp/hacs.rkt @@ -585,7 +585,11 @@ (define/contract (optimal-stop-min proc xs) (procedure? (listof any/c) . -> . any/c) - (define-values (sample candidates) (split-at xs (inexact->exact (floor (* .458 (length xs)))))) + ;; coefficient from + ;; https://www.math.ucla.edu/~tom/Stopping/sr2.pdf + (define optimal-stopping-coefficient .458) + (define-values (sample candidates) + (split-at xs (inexact->exact (floor (* optimal-stopping-coefficient (length xs)))))) (define threshold (argmin proc sample)) (or (for/first ([candidate (in-list candidates)] #:when (<= (proc candidate) threshold)) From 7a700bc5647516fcb8338d972ba371f26f3a82a2 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Mon, 28 Dec 2020 09:54:23 -0800 Subject: [PATCH 225/246] fix ac-3 (closes #3) --- csp/csp/hacs.rkt | 35 +++++++++++++++++++---------------- csp/csp/scribblings/csp.scrbl | 6 ++++-- 2 files changed, 23 insertions(+), 18 deletions(-) diff --git a/csp/csp/hacs.rkt b/csp/csp/hacs.rkt index 3fe86d6a..9578d15c 100644 --- a/csp/csp/hacs.rkt +++ b/csp/csp/hacs.rkt @@ -344,14 +344,14 @@ constraint-proc ; so val stays on left (λ (val other-val) (constraint-proc other-val val)))) ; otherwise reverse arg order (define (satisfies-arc? val) - (for/or ([other-val (in-list (find-domain prob other-name))]) + (for/or ([other-val (in-set (find-domain prob other-name))]) (proc val other-val))) (make-csp (for/list ([vr (in-vars prob)]) (cond [(assigned-var? vr) vr] [(eq? name (var-name vr)) - (make-var name (match (filter satisfies-arc? (domain vr)) + (make-var name (match (filter satisfies-arc? (set->list (domain vr))) [(? empty?) (backtrack!)] [vals vals]))] [else vr])) @@ -371,24 +371,27 @@ ;; has values in their domain that satisfy every binary constraint (define checkable-names (cons ref-name (filter-not (λ (vn) (assigned-name? prob vn)) (map var-name (vars prob))))) (define starting-arcs - (two-arity-constraints->arcs (for/list ([const (in-constraints prob)] - #:when (and (two-arity? const) - (for/and ([cname (in-list (constraint-names const))]) - (memq cname checkable-names)))) - const))) + (two-arity-constraints->arcs + (for/list ([const (in-constraints prob)] + #:when (and (two-arity? const) + (for/and ([cname (in-list (constraint-names const))]) + (memq cname checkable-names)))) + const))) (for/fold ([prob prob] - [arcs (sort starting-arcs < #:key (λ (a) (domain-length (find-domain prob (arc-name a)))) #:cache-keys? #true)] + [arcs (sort starting-arcs < #:key (λ (a) (domain-length (find-var prob (arc-name a)))) #:cache-keys? #true)] #:result (prune-singleton-constraints prob)) ([i (in-naturals)] #:break (empty? arcs)) - (match-define (cons (arc name proc) other-arcs) arcs) - (define reduced-csp (reduce-domain prob (arc name proc))) - (define (domain-reduced? name) - (= (domain-length (find-domain prob name)) (domain-length (find-domain reduced-csp name)))) - (values reduced-csp (if (domain-reduced? name) - (remove-duplicates (append (starting-arcs . terminating-at? . name) other-arcs)) - other-arcs)))) - + (match-define (cons (and first-arc (arc name _)) other-arcs) arcs) + (define reduced-csp (reduce-domain prob first-arc)) + (define domain-reduced? + (< (domain-length (find-var reduced-csp name)) (domain-length (find-var prob name)))) + (values reduced-csp + (if domain-reduced? + ;; revision reduced the domain, so supplement the list of arcs + (remove-duplicates (append (starting-arcs . terminating-at? . name) other-arcs)) + ;; revision did not reduce the domain, so keep going + other-arcs)))) (define/contract (forward-check-var prob ref-name vr) (csp? name? var? . -> . var?) diff --git a/csp/csp/scribblings/csp.scrbl b/csp/csp/scribblings/csp.scrbl index 9ed97cdc..1aa22e86 100644 --- a/csp/csp/scribblings/csp.scrbl +++ b/csp/csp/scribblings/csp.scrbl @@ -479,14 +479,16 @@ Pass these functions to @racket[current-inference]. [prob csp?] [name var-name?]) csp?]{ -Used for inference when @racket[current-inference] is not otherwise set. Tests whether the newest variable assignment necessarily causes any other variable domains to collapse, and thereby discovers a failure faster than backtracking alone. +Used for inference when @racket[current-inference] is not otherwise set. Tests whether the newest variable assignment necessarily causes any other variable domains to become empty. and thereby discovers a failure faster than backtracking alone. } @defproc[(ac-3 [prob csp?] [name var-name?]) csp?]{ -Applies the AC-3 arc-consistency algorithm. Similar to forward checking, but checks pairs of variables rather than single variables. Thus, it is a more thorough form of inference, but for that reason it will usually take longer (and may not add much value). +Applies the AC-3 arc-consistency algorithm. Similar to forward checking, but checks pairs of variables rather than single variables. Thus, it is a more thorough form of inference, but for that reason it will usually take longer. + +Specifically: following a new variable assignment, AC-3 examines the remaining constraints that link exactly two variables. It checks that each variable has at least one value in its domain that can be paired with the other to satisfy the constraint. If no such pair exists, then the constraint can never be satisfied, so the new variable assignment must fail. } From 7d033a748dff53c241c5f9f8f68528cfa8397d9a Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Mon, 28 Dec 2020 10:45:53 -0800 Subject: [PATCH 226/246] typo --- csp/csp/scribblings/csp.scrbl | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/csp/csp/scribblings/csp.scrbl b/csp/csp/scribblings/csp.scrbl index 1aa22e86..d00dbf76 100644 --- a/csp/csp/scribblings/csp.scrbl +++ b/csp/csp/scribblings/csp.scrbl @@ -370,7 +370,7 @@ Number of possible variable assignments for @racket[_prob], otherwise known as t @defproc[(csp->graph [prob csp?]) graph?]{ -Creates an undirected graph (using Racket's @racket[graph] library) where each CSP variable is represented in the graph as a vertex, and each constraint between any pair of variables is represented as an edge. +Create an undirected graph (using Racket's @racket[graph] library) where each CSP variable is represented in the graph as a vertex, and each constraint between any pair of variables is represented as an edge. } @defproc[(csp->graphviz From 4e55c4c2a8adff85447ed63275881a37427abec4 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Mon, 28 Dec 2020 10:49:40 -0800 Subject: [PATCH 227/246] typos --- csp/csp/scribblings/csp.scrbl | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/csp/csp/scribblings/csp.scrbl b/csp/csp/scribblings/csp.scrbl index d00dbf76..bf1c64b2 100644 --- a/csp/csp/scribblings/csp.scrbl +++ b/csp/csp/scribblings/csp.scrbl @@ -370,7 +370,7 @@ Number of possible variable assignments for @racket[_prob], otherwise known as t @defproc[(csp->graph [prob csp?]) graph?]{ -Create an undirected graph (using Racket's @racket[graph] library) where each CSP variable is represented in the graph as a vertex, and each constraint between any pair of variables is represented as an edge. +Create an undirected graph (using Racket's @racketmodname[graph] library) where each CSP variable is represented in the graph as a vertex, and each constraint between any pair of variables is represented as an edge. } @defproc[(csp->graphviz @@ -398,7 +398,7 @@ Current solver algorithm used to solve the CSP. If @racket[#false], CSP will use } @defparam[current-decompose val (or/c #false procedure?) #:value #t]{ -Whether CSP will be decomposed into independent subproblems (if possible), because smaller CSPs are typically easier to solve than larger ones (and then the component solutions are reassembled into a larger solution). +Whether the CSP will be decomposed into independent subproblems (if possible), because smaller CSPs are typically easier to solve than larger ones (and then the component solutions are reassembled into a larger solution). } @defparam[current-thread-count val (or/c #false natural?) #:value 4]{ @@ -408,7 +408,7 @@ Number of threads used by the @racket[min-conflicts-solver]. @defparam[current-node-consistency val (or/c #false procedure?) #:value #f]{ Whether node consistency is applied. Node consistency is helpful for certain CSPs, but not others, so it is @racket[#false] by default. -Helpful for which CSPs? ``Node consistency'' means that for any one-arity (aka unary) constraints on a variable, we can filter out any domain values that don't satisfy the constraint, thereby reducing the size of the search space. So if the CSP starts with unary constraints, and the constraints foreclose certain values, node consistency can be useful. The cost of node consistency is proportional to the number of values in the domain (because all of them have to be tested). +Helpful for which CSPs? @italic{Node consistency} means that for any one-arity (aka unary) constraints on a variable, we can filter out any domain values that don't satisfy the constraint, thereby reducing the size of the search space. So if the CSP starts with unary constraints, and the constraints foreclose certain values, node consistency can be useful. The cost of node consistency is proportional to the number of values in the domain (because all of them have to be tested). } @defparam[current-arity-reduction val (or/c #false procedure?) #:value #t]{ @@ -416,7 +416,7 @@ Whether constraints are reduced in arity where possible. This usually helps, so Why does it help? Because lower-arity constraints tend to be faster to test, and the solver can use node consistency on one-arity constraints (see @racket[current-node-consistency]). -For instance, suppose we have variables representing positive integers @racket[a] and @racket[b] and the constraint says @racket[(< a b)]. Further suppose that @racket[b] is assigned value @racket[5]. At that point, this constraint can be ``rephrased'' as the one-arity function @racket[(< a 5)]. This implies that there are only four possible values for @racket[a] (namely, @racket['(1 2 3 4)])). If node consistency is active, the domain of @racket[a] can immediately be checked to see if it includes any of those values. But none of this is possible if we don't reduce the arity. +For instance, suppose we have variables representing positive integers @racket[a] and @racket[b] and the constraint says @racket[(< a b)]. Further suppose that @racket[b] is assigned value @racket[5]. At that point, this constraint can be expressed instead as the one-arity function @racket[(< a 5)]. This implies that there are only four possible values for @racket[a] (namely, @racket['(1 2 3 4)])). If node consistency is active, the domain of @racket[a] can immediately be checked to see if it includes any of those values. But none of this is possible if we don't reduce the arity. } @section{Solvers} From a9ec24a78d151127a3c6c8b640b610f26b62d6e5 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Mon, 28 Dec 2020 11:16:37 -0800 Subject: [PATCH 228/246] sudoku example --- csp/csp/hacs-test-sudoku.rkt | 69 +++++++++++++++-------------------- csp/csp/hacs.rkt | 1 - csp/csp/scribblings/csp.scrbl | 56 ++++++++++++++++++++++++++++ 3 files changed, 86 insertions(+), 40 deletions(-) diff --git a/csp/csp/hacs-test-sudoku.rkt b/csp/csp/hacs-test-sudoku.rkt index fc07715e..ce442b91 100644 --- a/csp/csp/hacs-test-sudoku.rkt +++ b/csp/csp/hacs-test-sudoku.rkt @@ -1,54 +1,46 @@ #lang debug br (require sugar/debug "hacs.rkt") -(define cells (for/list ([i (in-range 81)]) - (string->symbol (format "c~a" i)))) - -(define (make-sudoku) +(define (make-base-sudoku) (define sudoku (make-csp)) + + (define cells (range 81)) (add-vars! sudoku cells (range 1 10)) - (define (not= . xs) (not (check-duplicates xs =))) - - (for ([i (in-range 9)]) - (define row-cells (for/list ([(name idx) (in-indexed cells)] - #:when (= (quotient idx 9) i)) - name)) - (add-pairwise-constraint! sudoku not= row-cells) - (define col-cells (for/list ([(name idx) (in-indexed cells)] - #:when (= (remainder idx 9) i)) - name)) - (add-pairwise-constraint! sudoku not= col-cells)) - - (for ([i '(0 3 6 27 30 33 54 57 60)]) - (define box-cells (for/list ([offset '(0 1 2 9 10 11 18 19 20)]) - (string->symbol (format "c~a" (+ i offset))))) - (add-pairwise-constraint! sudoku not= box-cells)) + (for ([i 9]) + (define row-cells (filter (λ (cell) (= (quotient cell 9) i)) cells)) + (add-all-diff-constraint! sudoku row-cells) + + (define col-cells (filter (λ (cell) (= (remainder cell 9) i)) cells)) + (add-all-diff-constraint! sudoku col-cells)) + + (define box-starts '(0 3 6 27 30 33 54 57 60)) + (define box-offsets '(0 1 2 9 10 11 18 19 20)) + (for ([start box-starts]) + (add-all-diff-constraint! sudoku (map (curry + start) box-offsets))) sudoku) +(define (make-sudoku-board . strs) + (define sudoku (make-base-sudoku)) + (define vals (for*/list ([str (in-list strs)] + [c (in-string str)] + #:unless (memv c '(#\- #\|))) + (string->number (string c)))) + (for ([(val vidx) (in-indexed vals)] + #:when val) + (add-constraint! sudoku (curry = val) (list vidx))) + sudoku) + (require racket/sequence) (define (print-grid sol) (displayln (string-join (map ~a (for/list ([row (in-slice 9 (csp->assocs sol))]) (map cdr row))) "\n"))) -(define (board . strs) - (define sudoku (make-sudoku)) - (define vals - (for*/list ([str (in-list strs)] - [c (in-string str)] - #:unless (memv c '(#\- #\|))) - (string->number (string c)))) - (for ([name cells] - [val vals] - #:when val) - (add-constraint! sudoku (curry = val) (list name) (string->symbol (format "is-~a" val)))) - sudoku) - ;; http://jeapostrophe.github.io/2013-10-23-sudoku-post.html (define b1 - (board + (make-sudoku-board "53 | 7 | " "6 |195| " " 98| | 6 " @@ -63,7 +55,7 @@ ;; "Hard" example (define b2 - (board + (make-sudoku-board " 7 | 2 | 5" " 9| 87| 3" " 6 | | 4 " @@ -78,7 +70,7 @@ ;; "Evil" example (define b3 - (board + (make-sudoku-board " 8| | 45" " | 8 |9 " " 2|4 | " @@ -94,7 +86,6 @@ (current-inference forward-check) (current-select-variable mrv-degree-hybrid) (current-order-values shuffle) -(current-random #true) (current-node-consistency #t) (current-arity-reduction #t) (define trials 5) @@ -108,7 +99,7 @@ (define (euler-value sol) (match sol - [(list (cons (== 'c0) h) (cons (== 'c1) t) (cons (== 'c2) d) _ ...) + [(list (cons 0 h) (cons 1 t) (cons 2 d) _ ...) (+ (* 100 h) (* 10 t) d)])) @@ -124,4 +115,4 @@ (for/list ([puz (in-slice 10 (string-split (port->string (open-input-file "euler-sudoku-grids.txt")) "\n"))]) (map (λ (str) (string-replace str "0" " ")) (cdr puz)))) (for/sum ([bstr bstrs]) - (euler-value (solve (apply board bstr))))) + (euler-value (solve (apply make-sudoku-board bstr))))) diff --git a/csp/csp/hacs.rkt b/csp/csp/hacs.rkt index 9578d15c..be175117 100644 --- a/csp/csp/hacs.rkt +++ b/csp/csp/hacs.rkt @@ -144,7 +144,6 @@ (define current-order-values (make-parameter #f)) (define current-inference (make-parameter #f)) (define current-solver (make-parameter #f)) -(define current-random (make-parameter #t)) (define current-decompose (make-parameter #t)) (define current-thread-count (make-parameter 4)) (define current-node-consistency (make-parameter #f)) diff --git a/csp/csp/scribblings/csp.scrbl b/csp/csp/scribblings/csp.scrbl index bf1c64b2..196f6009 100644 --- a/csp/csp/scribblings/csp.scrbl +++ b/csp/csp/scribblings/csp.scrbl @@ -202,6 +202,62 @@ Well over a zillion, certainly. Let's optimistically suppose that the 3.7GHz pro (/ states states-per-second seconds-per-year) ] +@racketmod[ +#:file "sudoku.rkt" +racket +(require csp) + +(define (make-base-sudoku) + (define sudoku (make-csp)) + + (define cells (range 81)) + (add-vars! sudoku cells (range 1 10)) + + (for ([i 9]) + (define row-cells (filter (λ (cell) (= (quotient cell 9) i)) cells)) + (add-all-diff-constraint! sudoku row-cells) + + (define col-cells (filter (λ (cell) (= (remainder cell 9) i)) cells)) + (add-all-diff-constraint! sudoku col-cells)) + + (define box-starts '(0 3 6 27 30 33 54 57 60)) + (define box-offsets '(0 1 2 9 10 11 18 19 20)) + (for ([start box-starts]) + (add-all-diff-constraint! sudoku (map (curry + start) box-offsets))) + + sudoku) + +(define (make-sudoku-board . strs) + (define sudoku (make-base-sudoku)) + (define vals (for*/list ([str (in-list strs)] + [c (in-string str)] + #:unless (memv c '(#\- #\|))) + (string->number (string c)))) + (for ([(val vidx) (in-indexed vals)] + #:when val) + (add-constraint! sudoku (curry = val) (list vidx))) + sudoku) + +(current-inference forward-check) +(current-select-variable mrv-degree-hybrid) +(current-order-values shuffle) +(current-node-consistency #t) +(current-arity-reduction #t) + +(solve (make-sudoku-board + " 8| | 45" + " | 8 |9 " + " 2|4 | " + "-----------" + "5 | 1|76 " + " 1 | 7 | 8 " + " 79|5 | 1" + "-----------" + " | 7|4 " + " 7| 6 | " + "65 | |3 ")) +] + @section{Another interlude} From 3d87b916a65c04d3b89cacd7184f460e5656542e Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Mon, 28 Dec 2020 11:17:39 -0800 Subject: [PATCH 229/246] Update README.md --- csp/README.md | 2 ++ 1 file changed, 2 insertions(+) diff --git a/csp/README.md b/csp/README.md index d609aaef..334f8bd6 100644 --- a/csp/README.md +++ b/csp/README.md @@ -1,2 +1,4 @@ csp === + +`raco pkg install csp` From 576b4bee9d7f908324981b6e1271996c19cbe987 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Mon, 28 Dec 2020 11:29:35 -0800 Subject: [PATCH 230/246] node consistency note --- csp/csp/scribblings/csp.scrbl | 2 ++ 1 file changed, 2 insertions(+) diff --git a/csp/csp/scribblings/csp.scrbl b/csp/csp/scribblings/csp.scrbl index 196f6009..bfd30661 100644 --- a/csp/csp/scribblings/csp.scrbl +++ b/csp/csp/scribblings/csp.scrbl @@ -465,6 +465,8 @@ Number of threads used by the @racket[min-conflicts-solver]. Whether node consistency is applied. Node consistency is helpful for certain CSPs, but not others, so it is @racket[#false] by default. Helpful for which CSPs? @italic{Node consistency} means that for any one-arity (aka unary) constraints on a variable, we can filter out any domain values that don't satisfy the constraint, thereby reducing the size of the search space. So if the CSP starts with unary constraints, and the constraints foreclose certain values, node consistency can be useful. The cost of node consistency is proportional to the number of values in the domain (because all of them have to be tested). + +Node consistency tends to be especially helpful in CSPs where all the assignment values have to be different, and even more so where the variables all have the same domain (say, 100 variables, each with a value between 0 and 99 inclusive). In a case like this, any assignment to one variable means that value can no longer be used by any other variable. Node consistency will remove these values from the other variable domains, thereby pruning the search space aggressively. } @defparam[current-arity-reduction val (or/c #false procedure?) #:value #t]{ From bf1c4d1c98552caca33d3747fdb57bfa49aa2734 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Mon, 28 Dec 2020 12:38:40 -0800 Subject: [PATCH 231/246] use seteq sometimes --- csp/csp/hacs.rkt | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/csp/csp/hacs.rkt b/csp/csp/hacs.rkt index be175117..893cbe05 100644 --- a/csp/csp/hacs.rkt +++ b/csp/csp/hacs.rkt @@ -77,7 +77,9 @@ (define/contract (make-var name [vals null]) ((name?) ((listof any/c)) . ->* . var?) - (var name (list->set vals))) + (var name (match vals + [(list (or (? fixnum?) (? symbol?)) ...) (list->seteq vals)] + [_ (list->set vals)]))) (define/contract (make-var-names prefix vals [suffix ""]) ((string? (listof any/c)) ((string?)) . ->* . (listof name?)) @@ -435,8 +437,8 @@ (when-debug (set! nfchecks (+ (length checked-vars) nchecks))) ;; conflict-set will be empty if there are no empty domains (as we would hope) (define conflict-set (for/list ([cvr (in-list checked-vars)] - #:when (set-empty? (domain cvr))) - (history cvr))) + #:when (set-empty? (domain cvr))) + (history cvr))) ;; for conflict-directed backjumping it's essential to forward-check ALL vars ;; (even after an empty domain is generated) and combine their conflicts ;; so we can discover the *most recent past var* that could be the culprit. From bb3e5655e366eef92bfcddb0900864d9592d7e3e Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Mon, 28 Dec 2020 12:42:41 -0800 Subject: [PATCH 232/246] ac-3 notes --- csp/csp/scribblings/csp.scrbl | 12 +++++++++--- 1 file changed, 9 insertions(+), 3 deletions(-) diff --git a/csp/csp/scribblings/csp.scrbl b/csp/csp/scribblings/csp.scrbl index bfd30661..ab2d595c 100644 --- a/csp/csp/scribblings/csp.scrbl +++ b/csp/csp/scribblings/csp.scrbl @@ -537,16 +537,22 @@ Pass these functions to @racket[current-inference]. [prob csp?] [name var-name?]) csp?]{ -Used for inference when @racket[current-inference] is not otherwise set. Tests whether the newest variable assignment necessarily causes any other variable domains to become empty. and thereby discovers a failure faster than backtracking alone. +Used for inference when @racket[current-inference] is not otherwise set. Forward checking determines whether the assignment to @racket[_name] necessarily causes another variable domain to become empty. How? It examines the remaining two-arity constraints that link variable @racket[_name] to an unassigned variable. For each of these constraints, it plugs in the new value for @racket[_name] and checks that the other variable still has values in its domain that can meet the constraint. If not, the assignment to @racket[_name] must fail. Forward checking can discover failures faster than backtracking alone. } @defproc[(ac-3 [prob csp?] [name var-name?]) csp?]{ -Applies the AC-3 arc-consistency algorithm. Similar to forward checking, but checks pairs of variables rather than single variables. Thus, it is a more thorough form of inference, but for that reason it will usually take longer. +Applies the AC-3 arc-consistency algorithm. Similar to forward checking, but checks farther ahead. For that reason, it will usually take longer. (It is not necessarily better, however.) -Specifically: following a new variable assignment, AC-3 examines the remaining constraints that link exactly two variables. It checks that each variable has at least one value in its domain that can be paired with the other to satisfy the constraint. If no such pair exists, then the constraint can never be satisfied, so the new variable assignment must fail. +Specifically: following a new variable assignment, AC-3 examines all constraints that link exactly two unassigned variables. It checks that each variable has at least one value in its domain that can be paired with the other to satisfy the constraint (this pair comprises the eponymous @italic{arc}). If no such pair exists, then the constraint can never be satisfied, so the new variable assignment must fail. + +``So AC-3 is a superset of @racket[forward-check]?" Yes. Both techniques examine two-arity constraints after variable @racket[_name] has been assigned a value. Forward checking, however, only examines two-arity functions that include variable @racket[_name] in the constraint. Whereas AC-3 checks @italic{all} two-arity functions (even those that don't include @racket[_name]). + +In this way, AC-3 can detect inconsistencies that forward checking would miss. For instance, consider a CSP with three variables @italic{a} @italic{b} and @italic{c}, and three constraints @italic{ab}, @italic{ac}, and @italic{ab}. We assign a value to @italic{a}. Forward checking would then check constraints @italic{ab} and @italic{ac}, perhaps removing values from the domains of @italic{b} and @italic{c} to be consistent with the new value of @italic{a}. These domain reductions, however, might be inconsistent with constraint @italic{bc}. Forward checking won't notice this, because it never tests @italic{bc}. But AC-3 does test @italic{bc}, so it would notice the inconsistency. + +The problem with AC-3 is that it's necessarily recursive: each time it eliminates a domain value from a certain variable, it has to recheck all the two-arity constraints (because any of them might have been made inconsistent by the removal of this value). AC-3 only stops when it can no longer remove any value from any domain. So yes, compared to simple forward checking, it does more. But it also potentially costs a lot more, especially if the variables have large domains. } From ca615dc293db74d158192e7c66b29f6635b8e8ca Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Mon, 28 Dec 2020 13:35:07 -0800 Subject: [PATCH 233/246] kill solver threads --- csp/csp/hacs.rkt | 108 ++++++++++++++++++++++++++--------------------- 1 file changed, 59 insertions(+), 49 deletions(-) diff --git a/csp/csp/hacs.rkt b/csp/csp/hacs.rkt index 893cbe05..b7d9141a 100644 --- a/csp/csp/hacs.rkt +++ b/csp/csp/hacs.rkt @@ -437,8 +437,8 @@ (when-debug (set! nfchecks (+ (length checked-vars) nchecks))) ;; conflict-set will be empty if there are no empty domains (as we would hope) (define conflict-set (for/list ([cvr (in-list checked-vars)] - #:when (set-empty? (domain cvr))) - (history cvr))) + #:when (set-empty? (domain cvr))) + (history cvr))) ;; for conflict-directed backjumping it's essential to forward-check ALL vars ;; (even after an empty domain is generated) and combine their conflicts ;; so we can discover the *most recent past var* that could be the culprit. @@ -512,46 +512,51 @@ [val (in-list (map cdr assocs))]) (equal? x val)))) +(struct solver (generator kill) #:transparent + #:property prop:procedure 0) + (define/contract (backtracking-solver prob #:select-variable [select-unassigned-variable (or (current-select-variable) first-unassigned-variable)] #:order-values [order-domain-values (or (current-order-values) first-domain-value)] #:inference [inference (or (current-inference) forward-check)]) - ((csp?) (#:select-variable procedure? #:order-values procedure? #:inference procedure?) . ->* . generator?) - (generator () - (define starting-state-count (state-count prob)) - (define states-examined 0) - (define reduce-arity-proc (if (current-arity-reduction) reduce-constraint-arity values)) - (let loop ([prob ((if (current-node-consistency) make-nodes-consistent values) prob)]) - (match (select-unassigned-variable prob) - [#false (yield prob)] - [(var name domain) - (define (wants-backtrack? exn) - (and (backtrack? exn) (or (let ([bths (backtrack-histories exn)]) - (or (empty? bths) (for*/or ([bth (in-list bths)] - [rec (in-list bth)]) - (eq? name (car rec)))))))) - (for/fold ([conflicts null] - #:result (void)) - ([val (in-list (order-domain-values (set->list domain)))]) - (with-handlers ([wants-backtrack? - (λ (bt) - (define bths (backtrack-histories bt)) - (append conflicts (remq name (remove-duplicates - (for*/list ([bth (in-list bths)] - [rec (in-list bth)]) - (car rec)) eq?))))]) - (let* ([prob (assign-val prob name val)] - ;; reduce constraints before inference, - ;; to create more forward-checkable (binary) constraints - [prob (reduce-arity-proc prob)] - [prob (inference prob name)] - [prob (check-constraints prob)]) - (loop prob)) - ;; conflicts goes inside the handler expression - ;; so raises can supersede it - conflicts))])))) + ((csp?) (#:select-variable procedure? #:order-values procedure? #:inference procedure?) . ->* . solver?) + (solver + (generator () + (define starting-state-count (state-count prob)) + (define states-examined 0) + (define reduce-arity-proc (if (current-arity-reduction) reduce-constraint-arity values)) + (let loop ([prob ((if (current-node-consistency) make-nodes-consistent values) prob)]) + (match (select-unassigned-variable prob) + [#false (yield prob)] + [(var name domain) + (define (wants-backtrack? exn) + (and (backtrack? exn) (or (let ([bths (backtrack-histories exn)]) + (or (empty? bths) (for*/or ([bth (in-list bths)] + [rec (in-list bth)]) + (eq? name (car rec)))))))) + (for/fold ([conflicts null] + #:result (void)) + ([val (in-list (order-domain-values (set->list domain)))]) + (with-handlers ([wants-backtrack? + (λ (bt) + (define bths (backtrack-histories bt)) + (append conflicts (remq name (remove-duplicates + (for*/list ([bth (in-list bths)] + [rec (in-list bth)]) + (car rec)) eq?))))]) + (let* ([prob (assign-val prob name val)] + ;; reduce constraints before inference, + ;; to create more forward-checkable (binary) constraints + [prob (reduce-arity-proc prob)] + [prob (inference prob name)] + [prob (check-constraints prob)]) + (loop prob)) + ;; conflicts goes inside the handler expression + ;; so raises can supersede it + conflicts))]))) + void)) (define/contract (random-pick xs) ((non-empty-listof any/c) . -> . any/c) @@ -580,12 +585,16 @@ (assign-val prob name val)])))))) (define/contract (min-conflicts-solver prob [max-steps 100]) - ((csp?) (exact-positive-integer?) . ->* . generator?) - (generator () - (for ([thread-count (or (current-thread-count) 1)]) ; todo: what is ideal thread count? - (make-min-conflcts-thread prob thread-count max-steps)) - (for ([i (in-naturals)]) - (yield (thread-receive))))) + ((csp?) (exact-positive-integer?) . ->* . solver?) + ; todo: what is ideal thread count? + (define threads (for/list ([thread-count (or (current-thread-count) 1)]) + (make-min-conflcts-thread prob thread-count max-steps))) + (solver + (generator () + (let loop () + (yield (thread-receive)) + (loop))) + (λ () (for-each kill-thread threads) ))) (define/contract (optimal-stop-min proc xs) (procedure? (listof any/c) . -> . any/c) @@ -660,18 +669,20 @@ (extract-subcsp prob nodeset)) (list prob))) -(define (make-solution-generator prob) +(define (make-solution-generator prob max-solutions) (generator () (define subprobs (decompose-prob prob)) (define solgens (map (current-solver) subprobs)) (define solstreams (for/list ([solgen (in-list solgens)]) (for/stream ([sol (in-producer solgen (void))]) sol))) - (for ([solution-pieces (in-cartesian solstreams)]) - (yield (combine-csps solution-pieces))))) + (for ([solution-pieces (in-cartesian solstreams)] + [count (in-range max-solutions)]) + (yield (combine-csps solution-pieces))) + (for-each solver-kill solgens))) -(define-syntax-rule (in-solutions PROB) - (in-producer (make-solution-generator PROB) (void))) +(define-syntax-rule (in-solutions PROB MAX-SOLUTIONS) + (in-producer (make-solution-generator PROB MAX-SOLUTIONS) (void))) (define/contract (solve* prob [max-solutions +inf.0] #:finish-proc [finish-proc (λ (p) (csp->assocs p (map var-name (vars prob))))] @@ -680,8 +691,7 @@ (when-debug (reset-nassns!) (reset-nfchecks!) (reset-nchecks!)) (parameterize ([current-solver (or solver (current-solver) backtracking-solver)]) - (for/list ([sol (in-solutions prob)] - [idx (in-range max-solutions)]) + (for/list ([sol (in-solutions prob max-solutions)]) (finish-proc sol)))) (define/contract (solve prob From 3a2f3474ac2ea7f3fdc65c40f6e1759c04c268e5 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Mon, 28 Dec 2020 14:02:25 -0800 Subject: [PATCH 234/246] more seteqs --- csp/csp/hacs.rkt | 28 +++++++++++++++++----------- 1 file changed, 17 insertions(+), 11 deletions(-) diff --git a/csp/csp/hacs.rkt b/csp/csp/hacs.rkt index b7d9141a..0267510e 100644 --- a/csp/csp/hacs.rkt +++ b/csp/csp/hacs.rkt @@ -75,11 +75,17 @@ (() ((listof var?) (listof constraint?)) . ->* . csp?) (csp vars consts)) +(define (varvals->set vals) + (match vals + [(list (or (? fixnum?) (? symbol?)) ...) (list->seteq vals)] + [_ (list->set vals)])) + (define/contract (make-var name [vals null]) ((name?) ((listof any/c)) . ->* . var?) - (var name (match vals - [(list (or (? fixnum?) (? symbol?)) ...) (list->seteq vals)] - [_ (list->set vals)]))) + (var name (varvals->set vals))) + +(define (make-checked-var name vals history) + (checked-variable name (varvals->set vals) history)) (define/contract (make-var-names prefix vals [suffix ""]) ((string? (listof any/c)) ((string?)) . ->* . (listof name?)) @@ -407,13 +413,13 @@ [constraints (define ref-val (first (find-domain prob ref-name))) (define new-vals - (for/set ([val (in-set vals)] - #:when (for/and ([const (in-list constraints)]) - (match const - [(constraint (list (== name eq?) _) proc) (proc val ref-val)] - [(constraint _ proc) (proc ref-val val)]))) - val)) - (checked-variable name new-vals (cons (cons ref-name ref-val) (match vr + (for/list ([val (in-set vals)] + #:when (for/and ([const (in-list constraints)]) + (match const + [(constraint (list (== name eq?) _) proc) (proc val ref-val)] + [(constraint _ proc) (proc ref-val val)]))) + val)) + (make-checked-var name new-vals (cons (cons ref-name ref-val) (match vr [(checked-variable _ _ history) history] [_ null])))])])) @@ -500,7 +506,7 @@ (for/list ([vr (in-vars prob)]) (match-define (var name vals) vr) (define name-constraints (filter (λ (const) (constraint-relates? const name)) unary-constraints)) - (make-var name (for/set ([val (in-set vals)] + (make-var name (for/list ([val (in-set vals)] #:when (for/and ([const (in-list name-constraints)]) ((constraint-proc const) val))) val))) From f6f2c943d8bb1630e1656c043ccd5248941bf0b6 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Mon, 28 Dec 2020 14:02:40 -0800 Subject: [PATCH 235/246] AC-3 tests --- csp/csp/hacs-test.rkt | 108 +++++++++++++++++++++++------------------- 1 file changed, 60 insertions(+), 48 deletions(-) diff --git a/csp/csp/hacs-test.rkt b/csp/csp/hacs-test.rkt index 24c335f2..cede9a7f 100644 --- a/csp/csp/hacs-test.rkt +++ b/csp/csp/hacs-test.rkt @@ -4,8 +4,7 @@ (current-inference forward-check) (current-select-variable mrv-degree-hybrid) (current-order-values shuffle) -(current-random #true) -(current-node-consistency #f) +(current-node-consistency #t) (current-arity-reduction #t) (check-equal? (first-unassigned-variable (csp (list (var 'a (range 3)) (var 'b (range 3))) null)) @@ -21,47 +20,62 @@ (check-equal? (csp-vars (forward-check (forward-check (csp (list (avar 'a '(1)) (avar 'b '(0)) (var 'c '(0 1 2))) - (list (constraint '(a c) (negate =)) - (constraint '(b c) (negate =)))) 'a) 'b)) - (list (avar 'a '(1)) (avar 'b '(0)) (cvar 'c (set 2) '((b . 0) (a . 1))))) + (list (constraint '(a c) (negate =)) + (constraint '(b c) (negate =)))) 'a) 'b)) + (list (avar 'a '(1)) (avar 'b '(0)) (cvar 'c (seteq 2) '((b . 0) (a . 1))))) (check-equal? - ;; no inconsistency: b≠c not checked when fc is relative to a + ;; no inconsistency: b≠c not checked when fc is relative to a, so assignment succeeds (csp-vars (forward-check (csp (list (avar 'a '(1)) (var 'b (range 2)) (var 'c '(0))) - (list (constraint '(a b) (negate =)) - (constraint '(b c) (negate =)))) 'a)) - (list (avar 'a '(1)) (cvar 'b (set 0) '((a . 1))) (var 'c '(0)))) + (list (constraint '(a b) (negate =)) + (constraint '(b c) (negate =)))) 'a)) + (list (avar 'a '(1)) (cvar 'b (seteq 0) '((a . 1))) (var 'c '(0)))) + +;; inconsistency: b≠c is checked by AC-3, thus assignment fails +(check-exn backtrack? + (λ () + (csp-vars (ac-3 (csp (list (avar 'a '(1)) (var 'b (range 2)) (var 'c '(0))) + (list (constraint '(a b) (negate =)) + (constraint '(b c) (negate =)))) 'a)))) (check-equal? ;; no inconsistency: a≠b not checked when fc ignores a, which is already assigned (csp-vars (forward-check (csp (list (avar 'a '(1)) (avar 'b '(1)) (var 'c (range 2))) - (list (constraint '(a b) (negate =)) - (constraint '(b c) (negate =)))) 'b)) - (list (avar 'a '(1)) (avar 'b '(1)) (cvar 'c (set 0) '((b . 1))))) + (list (constraint '(a b) (negate =)) + (constraint '(b c) (negate =)))) 'b)) + (list (avar 'a '(1)) (avar 'b '(1)) (cvar 'c (seteq 0) '((b . 1))))) + +(check-equal? + ;; no inconsistency: a≠b is not checked by AC-3, because it's already assigned + ;; todo: is this the right result? + (csp-vars (ac-3 (csp (list (avar 'a '(1)) (avar 'b '(1)) (var 'c (range 2))) + (list (constraint '(a b) (negate =)) + (constraint '(b c) (negate =)))) 'b)) + (list (avar 'a '(1)) (avar 'b '(1)) (var 'c (seteq 0)))) (check-exn backtrack? (λ () (csp-vars (forward-check (csp (list (avar 'a '(1)) - (var 'b '(1))) - (list (constraint '(a b) (negate =)))) 'a)))) + (var 'b '(1))) + (list (constraint '(a b) (negate =)))) 'a)))) (check-equal? (csp-vars (forward-check (csp (list (var 'a '(0)) - (var 'b (range 3))) - (list (constraint '(a b) <))) 'a)) - (list (var 'a '(0)) (cvar 'b (set 1 2) '((a . 0))))) + (var 'b (range 3))) + (list (constraint '(a b) <))) 'a)) + (list (var 'a '(0)) (cvar 'b (seteq 1 2) '((a . 0))))) (check-equal? (parameterize ([current-inference forward-check]) (length (solve* (csp (list (var 'x (range 3)) - (var 'y (range 3)) - (var 'z (range 3))) - (list (constraint '(x y) <>) - (constraint '(x z) <>) - (constraint '(y z) <>)))))) 6) + (var 'y (range 3)) + (var 'z (range 3))) + (list (constraint '(x y) <>) + (constraint '(x z) <>) + (constraint '(y z) <>)))))) 6) (parameterize ([current-inference forward-check]) (define vds (for/list ([k '(wa nt nsw q t v sa)]) - (var k '(red green blue)))) + (var k '(red green blue)))) (define cs (list (constraint '(wa nt) neq?) (constraint '(wa sa) neq?) @@ -122,7 +136,7 @@ (define (word-value . xs) (for/sum ([(x idx) (in-indexed (reverse xs))]) - (* x (expt 10 idx)))) + (* x (expt 10 idx)))) (define smm (make-csp)) (add-vars! smm '(s e n d m o r y) (λ () (range 10))) @@ -150,14 +164,14 @@ (add-vars! queens qs rows) (define (q-col q) (string->number (string-trim (symbol->string q) "q"))) (for* ([qs (in-combinations qs 2)]) - (match-define (list qa qb) qs) - (match-define (list qa-col qb-col) (map q-col qs)) - (add-constraint! queens - (λ (qa-row qb-row) - (and - (not (= (abs (- qa-row qb-row)) (abs (- qa-col qb-col)))) ; same diagonal? - (not (= qa-row qb-row)))) ; same row? - (list qa qb))) + (match-define (list qa qb) qs) + (match-define (list qa-col qb-col) (map q-col qs)) + (add-constraint! queens + (λ (qa-row qb-row) + (and + (not (= (abs (- qa-row qb-row)) (abs (- qa-col qb-col)))) ; same diagonal? + (not (= qa-row qb-row)))) ; same row? + (list qa qb))) (check-equal? 92 (length (time-named (solve* queens)))) (print-debug-info) @@ -208,7 +222,7 @@ (add-vars! zebra ps '(dogs snails foxes horses zebra)) (for ([vars (list ns cs ds ss ps)]) - (add-pairwise-constraint! zebra neq? vars)) + (add-pairwise-constraint! zebra neq? vars)) (define (xnor lcond rcond) (or (and lcond rcond) (and (not lcond) (not rcond)))) @@ -217,7 +231,7 @@ (define (paired-with* lval lefts rval rights) (for ([left lefts][right rights]) - (paired-with lval left rval right))) + (paired-with lval left rval right))) ;# 1. The englishman lives in a red house. ('englishman ns . paired-with* . 'red cs) @@ -252,13 +266,13 @@ (for ([righta (drop-right rights 2)] [left (cdr lefts)] [rightb (drop rights 2)]) - (add-constraint! zebra (λ (left righta rightb) - (or (not (eq? left lval)) (eq? righta rval) (eq? rval rightb))) - (list left righta rightb))) + (add-constraint! zebra (λ (left righta rightb) + (or (not (eq? left lval)) (eq? righta rval) (eq? rval rightb))) + (list left righta rightb))) (for ([left (list (first lefts) (last lefts))] [right (list (second rights) (fourth rights))]) - (add-constraint! zebra (λ (left right) (xnor (eq? left lval) (eq? rval right))) - (list left right)))) + (add-constraint! zebra (λ (left right) (xnor (eq? left lval) (eq? rval right))) + (list left right)))) ;# 10. The man who smokes chesterfields lives next to the one who keeps foxes. ('chesterfields ss . next-to . 'foxes ps) @@ -281,8 +295,7 @@ (define (finish x) (apply map list (slice-at x 5))) -(check-equal? (parameterize ([current-select-variable mrv] - [current-random #f]) +(check-equal? (parameterize ([current-select-variable mrv]) (finish (time-named (solve zebra)))) '(((nationality-0 . norwegian) (color-0 . yellow) (drink-0 . water) (smoke-0 . kools) (pet-0 . foxes)) ((nationality-1 . ukrainian) (color-1 . blue) (drink-1 . tea) (smoke-1 . chesterfields) (pet-1 . horses)) @@ -293,10 +306,9 @@ (module+ main (begin - (define-syntax n (λ (stx) #'10)) - (time-avg n (void (solve quarters))) - (time-avg n (void (solve* xsum))) - (time-avg n (void (solve smm))) - (time-avg n (void (solve* queens))) - (time-avg n (void (solve zebra))))) - \ No newline at end of file + (define-syntax n (λ (stx) #'10)) + (time-avg n (void (solve quarters))) + (time-avg n (void (solve* xsum))) + (time-avg n (void (solve smm))) + (time-avg n (void (solve* queens))) + (time-avg n (void (solve zebra))))) From 7f69bbdd56ee50aa4551c0f366441ad053cd91da Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Mon, 28 Dec 2020 14:41:06 -0800 Subject: [PATCH 236/246] add-transitive-constraint! and other nits --- csp/csp/hacs-test-queens.rkt | 11 +++--- csp/csp/hacs-test-workbench.rkt | 1 - csp/csp/hacs-test.rkt | 15 ++++---- csp/csp/hacs.rkt | 61 +++++++++++++++++-------------- csp/csp/scribblings/csp.scrbl | 64 ++++++++++++++++++++++++++++----- 5 files changed, 102 insertions(+), 50 deletions(-) diff --git a/csp/csp/hacs-test-queens.rkt b/csp/csp/hacs-test-queens.rkt index da040551..da5e473e 100644 --- a/csp/csp/hacs-test-queens.rkt +++ b/csp/csp/hacs-test-queens.rkt @@ -4,12 +4,11 @@ (current-inference forward-check) (current-select-variable mrv) (current-order-values shuffle) -(current-random #true) ;; queens problem ;; place queens on chessboard so they do not intersect -(define board-size 8) +(define board-size 10) (define queens (make-csp)) (define qs (range board-size)) @@ -25,12 +24,12 @@ (define (sol->string sol) (define assocs (csp->assocs sol)) - (string-join (for/list ([q (in-list (sort assocs < #:key car))]) + (displayln (string-join (for/list ([q (in-list (sort assocs < #:key car))]) (apply string (add-between (for/list ([idx (in-range board-size)]) (if (= idx (cdr q)) #\@ #\·)) #\space))) "\n")) + assocs) (current-thread-count 4) -(displayln (solve queens #:finish-proc sol->string)) -(parameterize (#;[current-solver min-conflicts-solver]) - (time (solve queens))) +(parameterize ([current-solver min-conflicts-solver]) + (time (solve queens #:finish-proc sol->string))) diff --git a/csp/csp/hacs-test-workbench.rkt b/csp/csp/hacs-test-workbench.rkt index 5061afa9..4e267223 100644 --- a/csp/csp/hacs-test-workbench.rkt +++ b/csp/csp/hacs-test-workbench.rkt @@ -4,7 +4,6 @@ (current-inference forward-check) (current-select-variable mrv) (current-order-values shuffle) -(current-random #true) (define (word-value . xs) (for/sum ([(x idx) (in-indexed (reverse xs))]) diff --git a/csp/csp/hacs-test.rkt b/csp/csp/hacs-test.rkt index cede9a7f..b69c7f31 100644 --- a/csp/csp/hacs-test.rkt +++ b/csp/csp/hacs-test.rkt @@ -112,12 +112,11 @@ # |# (define xsum (make-csp)) -(add-vars! xsum '(l1 l2 l3 l4 r1 r2 r3 r4 x) (range 1 10)) -(add-pairwise-constraint! xsum < '(l1 l2 l3 l4)) -(add-pairwise-constraint! xsum < '(r1 r2 r3 r4)) -(add-constraint! xsum (λ (l1 l2 l3 l4 x) (= 27 (+ l1 l2 l3 l4 x))) '(l1 l2 l3 l4 x)) -(add-constraint! xsum (λ (r1 r2 r3 r4 x) (= 27 (+ r1 r2 r3 r4 x))) '(r1 r2 r3 r4 x)) -(add-pairwise-constraint! xsum alldiff= '(l1 l2 l3 l4 r1 r2 r3 r4 x)) +(add-vars! xsum '(1 2 3 4 5 6 7 8 9) '(1 2 3 4 5 6 7 8 9)) +(add-transitive-constraint! xsum < '(1 2 4 5)) +(add-transitive-constraint! xsum < '(6 7 8 9)) +(add-constraints! xsum (λ xs (= 27 (apply + xs))) '((1 2 3 4 5) (6 7 3 8 9))) +(add-all-diff-constraint! xsum) (check-equal? (length (time-named (solve* xsum))) 8) (print-debug-info) @@ -151,7 +150,7 @@ (add-constraint! smm (λ (s e n d m o r y) (= (+ (word-value s e n d) (word-value m o r e)) (word-value m o n e y))) '(s e n d m o r y)) -(add-pairwise-constraint! smm alldiff= '(s e n d m o r y)) +(add-all-diff-constraint! smm) (check-equal? (parameterize ([current-select-variable mrv-degree-hybrid]) ; todo: why is plain mrv so bad on this problem? (time-named (solve smm))) '((s . 9) (e . 5) (n . 6) (d . 7) (m . 1) (o . 0) (r . 8) (y . 2))) (print-debug-info) @@ -222,7 +221,7 @@ (add-vars! zebra ps '(dogs snails foxes horses zebra)) (for ([vars (list ns cs ds ss ps)]) - (add-pairwise-constraint! zebra neq? vars)) + (add-all-diff-constraint! zebra vars #:proc eq?)) (define (xnor lcond rcond) (or (and lcond rcond) (and (not lcond) (not rcond)))) diff --git a/csp/csp/hacs.rkt b/csp/csp/hacs.rkt index 0267510e..45a23a4c 100644 --- a/csp/csp/hacs.rkt +++ b/csp/csp/hacs.rkt @@ -129,6 +129,14 @@ (raise-argument-error 'add-pairwise-constraint! "list of names" names)) (add-constraints! prob proc (combinations names 2) proc-name #:caller 'add-pairwise-constraint!)) +(define/contract (add-transitive-constraint! prob proc names [proc-name #false]) + ((csp? procedure? (listof name?)) (name?) . ->* . void?) + (unless (and (list? names) (>= (length names) 2)) + (raise-argument-error 'add-transitive-constraint! "list of two or more names" names)) + (add-constraints! prob proc (for/list ([name (in-list names)] + [next (in-list (cdr names))]) + (list name next)) proc-name #:caller 'add-transitive-constraint!)) + (define/contract (add-constraint! prob proc names [proc-name #false]) ((csp? procedure? (listof name?)) (name?) . ->* . void?) (unless (list? names) @@ -141,23 +149,13 @@ (define alldiff= alldiff) (define (add-all-diff-constraint! prob [names (map var-name (csp-vars prob))] - #:proc [equal-proc equal?]) + #:same [equal-proc equal?]) (add-pairwise-constraint! prob (λ (x y) (not (equal-proc x y))) names (string->symbol (format "all-diff-~a" (object-name equal-proc))))) (struct backtrack (histories) #:transparent) (define (backtrack! [names null]) (raise (backtrack names))) -(define current-select-variable (make-parameter #f)) -(define current-order-values (make-parameter #f)) -(define current-inference (make-parameter #f)) -(define current-solver (make-parameter #f)) -(define current-decompose (make-parameter #t)) -(define current-thread-count (make-parameter 4)) -(define current-node-consistency (make-parameter #f)) -(define current-arity-reduction (make-parameter #t)) -(define current-learning (make-parameter #f)) - (define/contract (check-name-in-csp! caller prob name) (symbol? csp? name? . -> . void?) (define names (map var-name (vars prob))) @@ -413,12 +411,12 @@ [constraints (define ref-val (first (find-domain prob ref-name))) (define new-vals - (for/list ([val (in-set vals)] - #:when (for/and ([const (in-list constraints)]) - (match const - [(constraint (list (== name eq?) _) proc) (proc val ref-val)] - [(constraint _ proc) (proc ref-val val)]))) - val)) + (for/list ([val (in-set vals)] + #:when (for/and ([const (in-list constraints)]) + (match const + [(constraint (list (== name eq?) _) proc) (proc val ref-val)] + [(constraint _ proc) (proc ref-val val)]))) + val)) (make-checked-var name new-vals (cons (cons ref-name ref-val) (match vr [(checked-variable _ _ history) history] [_ null])))])])) @@ -507,8 +505,8 @@ (match-define (var name vals) vr) (define name-constraints (filter (λ (const) (constraint-relates? const name)) unary-constraints)) (make-var name (for/list ([val (in-set vals)] - #:when (for/and ([const (in-list name-constraints)]) - ((constraint-proc const) val))) + #:when (for/and ([const (in-list name-constraints)]) + ((constraint-proc const) val))) val))) other-constraints))) @@ -526,7 +524,7 @@ #:select-variable [select-unassigned-variable (or (current-select-variable) first-unassigned-variable)] #:order-values [order-domain-values (or (current-order-values) first-domain-value)] - #:inference [inference (or (current-inference) forward-check)]) + #:inference [inference (or (current-inference) no-inference)]) ((csp?) (#:select-variable procedure? #:order-values procedure? #:inference procedure?) . ->* . solver?) (solver (generator () @@ -675,7 +673,7 @@ (extract-subcsp prob nodeset)) (list prob))) -(define (make-solution-generator prob max-solutions) +(define (make-solution-generator prob [max-solutions #false]) (generator () (define subprobs (decompose-prob prob)) (define solgens (map (current-solver) subprobs)) @@ -683,20 +681,22 @@ (for/stream ([sol (in-producer solgen (void))]) sol))) (for ([solution-pieces (in-cartesian solstreams)] - [count (in-range max-solutions)]) + [count (in-range (or max-solutions +inf.0))]) (yield (combine-csps solution-pieces))) (for-each solver-kill solgens))) -(define-syntax-rule (in-solutions PROB MAX-SOLUTIONS) - (in-producer (make-solution-generator PROB MAX-SOLUTIONS) (void))) +(define-syntax (in-solutions stx) + (syntax-case stx () + [(_ PROB) #'(in-solutions PROB #false)] + [(_ PROB MAX-SOLUTIONS) #'(in-producer (make-solution-generator PROB MAX-SOLUTIONS) (void))])) -(define/contract (solve* prob [max-solutions +inf.0] +(define/contract (solve* prob [max-solutions #false] #:finish-proc [finish-proc (λ (p) (csp->assocs p (map var-name (vars prob))))] #:solver [solver #f]) ((csp?) (natural? #:finish-proc procedure? #:solver procedure?) . ->* . (listof any/c)) (when-debug (reset-nassns!) (reset-nfchecks!) (reset-nchecks!)) - (parameterize ([current-solver (or solver (current-solver) backtracking-solver)]) + (parameterize ([current-solver (or solver (current-solver))]) (for/list ([sol (in-solutions prob max-solutions)]) (finish-proc sol)))) @@ -712,3 +712,12 @@ (define (<> a b) (not (= a b))) (define (neq? a b) (not (eq? a b))) +(define current-select-variable (make-parameter #f)) +(define current-order-values (make-parameter #f)) +(define current-inference (make-parameter forward-check)) +(define current-solver (make-parameter backtracking-solver)) +(define current-decompose (make-parameter #t)) +(define current-thread-count (make-parameter 4)) +(define current-node-consistency (make-parameter #f)) +(define current-arity-reduction (make-parameter #t)) +(define current-learning (make-parameter #f)) \ No newline at end of file diff --git a/csp/csp/scribblings/csp.scrbl b/csp/csp/scribblings/csp.scrbl index ab2d595c..b00758d0 100644 --- a/csp/csp/scribblings/csp.scrbl +++ b/csp/csp/scribblings/csp.scrbl @@ -324,9 +324,9 @@ Imperatively add a new constraint. The constraint applies the function @racket[_ @defproc[(add-all-diff-constraint! [prob csp?] [names (listof var-name?) (map var-name (csp-vars prob))] -[#:proc equal-proc equal?]) +[#:same equal-proc equal?]) void?]{ -Imperatively add an ``all diff'' constraint, which is a pairwise @racket[(compose1 not equal?)] constraint. A equality function other than @racket[equal?] can be passed via the @racket[#:proc] argument. There is nothing special about using this function vs. applying the constraint manually. +Imperatively add an ``all diff'' constraint, which is a pairwise @racket[(compose1 not equal?)] constraint. A equality function other than @racket[equal?] can be passed via the @racket[#:same] argument. There is nothing special about using this function vs. applying the constraint manually. } @@ -383,6 +383,52 @@ Which would become: This is better, but also overkill, because if @racket[(< a b)] and @racket[(< b c)], then by transitivity, @racket[(< a c)] is necessarily true. So this is a case where pairwise expands into more constraints than we actually need. This will not produce any wrong solutions, but especially on larger lists of variables, it creates unnecessary work that my slow down the solution search. } + +@defproc[(add-transitive-constraint! +[prob csp?] +[func procedure?] +[names (listof var-name?)] +[func-name (or/c #false var-name?) #f]) +void?]{ +Similar to @racket[add-pairwise-constraint!], but adds the constraint between every @italic{sequential} pair of names in @racket[_names] (not every @italic{possible} pair). + +For instance, consider this use of @racket[add-pairwise-constraint!]: + +@racketblock[ +(add-pairwise-constraint! my-csp < '(a b c d)) +] + +This applies the constraint between every possible pair, so the result is equivalent to: + +@racketblock[ +(add-constraint! my-csp < '(a b)) +(add-constraint! my-csp < '(a c)) +(add-constraint! my-csp < '(a d)) +(add-constraint! my-csp < '(b c)) +(add-constraint! my-csp < '(b d)) +(add-constraint! my-csp < '(c d)) +] + +This isn't wrong, but as any seventh grader could tell you, it's overkill. @racket[<] is a transitive relation, therefore if it's true that @racket[(< a b)] and @racket[(< b c)], it's necessarily also true that @racket[(< a c)]. So there's no need to apply a separate constraint for that. + +This is the behavior we get from @racket[add-transitive-constraint!]. For instance if we instead write this: + +@racketblock[ +(add-transitive-constraint! my-csp < '(a b c d)) +] + +The constraint is applied between every sequential pair, so the result is equivalent to: + +@racketblock[ +(add-constraint! my-csp < '(a b)) +(add-constraint! my-csp < '(b c)) +(add-constraint! my-csp < '(c d)) +] + +Same truth in half the constraints. +} + + @defproc[(make-var-names [prefix string?] [vals (listof any/c)] @@ -394,9 +440,9 @@ Helper function to generate mass quantities of variable names. The @racket[_pref (make-var-names "foo" (range 6) "bar") (make-var-names "col" (range 10)) ] - } + @defproc[(solve [prob csp?] ) (or/c #false (listof (cons/c symbol? any/c)))]{ @@ -410,8 +456,8 @@ Return a solution for the CSP, or @racket[#false] if no solution exists. Return all the solutions for the CSP. If there are none, returns @racket[null]. The optional @racket[_count] argument returns a certain number of solutions (or fewer, if not that many solutions exist) } -@defform[(in-solutions prob)]{ -Iterator form for use with @racket[for] loops that incrementally returns solutions to @racket[_prob]. +@defform[(in-solutions prob count)]{ +Iterator form for use with @racket[for] loops that incrementally returns solutions to @racket[_prob], up to a maximum of @racket[_count]. } @@ -445,12 +491,12 @@ Next variable that the CSP solver will attempt to assign a value to. If @racket[ Procedure that orders the remaining values in a domain. Default is @racket[#false], which means that the domain values are tried in their original order. If bad values are likely to be clustered together, it can be worth trying @racket[shuffle] for this parameter, which randomizes which value gets chosen next. Shuffling is also helpful in CSPs where all the variable values must be different (because otherwise, the values for every variable are tried in the same order, which means that the search space is front-loaded with failure). } -@defparam[current-inference val (or/c #false procedure?) #:value #f]{ -Current inference rule used by the solver. If @racket[#false], solver uses @racket[forward-check]. +@defparam[current-inference val (or/c #false procedure?) #:value forward-check]{ +Current inference rule used by the solver. If @racket[#false], solver uses @racket[no-inference]. Default is @racket[forward-check]. } -@defparam[current-solver val (or/c #false procedure?) #:value #f]{ -Current solver algorithm used to solve the CSP. If @racket[#false], CSP will use @racket[backtracking-solver]. +@defparam[current-solver val procedure? #:value backtracking-solver]{ +Current solver algorithm used to solve the CSP. Default is @racket[backtracking-solver]. } @defparam[current-decompose val (or/c #false procedure?) #:value #t]{ From 2c94de76a39f9fbe91d01dcce2145419dbbd8e21 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Mon, 28 Dec 2020 14:42:08 -0800 Subject: [PATCH 237/246] kw nit --- csp/csp/hacs-test.rkt | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/csp/csp/hacs-test.rkt b/csp/csp/hacs-test.rkt index b69c7f31..ac2e86dd 100644 --- a/csp/csp/hacs-test.rkt +++ b/csp/csp/hacs-test.rkt @@ -221,7 +221,7 @@ (add-vars! zebra ps '(dogs snails foxes horses zebra)) (for ([vars (list ns cs ds ss ps)]) - (add-all-diff-constraint! zebra vars #:proc eq?)) + (add-all-diff-constraint! zebra vars #:same eq?)) (define (xnor lcond rcond) (or (and lcond rcond) (and (not lcond) (not rcond)))) From 97456867a6d8d2df4b6fb8f31de45efce660f35d Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Mon, 28 Dec 2020 14:48:35 -0800 Subject: [PATCH 238/246] doc nit --- csp/csp/scribblings/csp.scrbl | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/csp/csp/scribblings/csp.scrbl b/csp/csp/scribblings/csp.scrbl index b00758d0..b29f623d 100644 --- a/csp/csp/scribblings/csp.scrbl +++ b/csp/csp/scribblings/csp.scrbl @@ -380,7 +380,7 @@ Which would become: (add-constraint! my-csp < '(a c)) ] -This is better, but also overkill, because if @racket[(< a b)] and @racket[(< b c)], then by transitivity, @racket[(< a c)] is necessarily true. So this is a case where pairwise expands into more constraints than we actually need. This will not produce any wrong solutions, but especially on larger lists of variables, it creates unnecessary work that my slow down the solution search. +This isn't wrong, but if @racket[(< a b)] and @racket[(< b c)], then by transitivity, @racket[(< a c)] is necessarily true. So pairwise expansion results in more constraints than we need, which in turn can make the search slower than it could be. In these situations, @racket[add-transitive-constraint!] is the better choice. } From a11dd08221396593d920e6db21136d2d1fd519b8 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Mon, 28 Dec 2020 15:26:01 -0800 Subject: [PATCH 239/246] constraint tips --- csp/csp/scribblings/csp.scrbl | 26 ++++++++++++++++++++++++++ 1 file changed, 26 insertions(+) diff --git a/csp/csp/scribblings/csp.scrbl b/csp/csp/scribblings/csp.scrbl index b29f623d..066d9b28 100644 --- a/csp/csp/scribblings/csp.scrbl +++ b/csp/csp/scribblings/csp.scrbl @@ -277,6 +277,32 @@ By contrast, when we use a CSP, @italic{all we need are the rules}. The CSP solv @section{Making & solving CSPs} +The variables in a CSP, and the possible values (aka the @italic{domains}) of each, are usually determined by the problem itself. So when we create a CSP, there are really only two areas of artistry and finesse: the choice of constraints and the choice of solver (and related solver settings). It's usually pretty easy to try different solvers & settings on a trial-and-error basis. So ultimately, most of the programming effort in CSPs comes down to designing constraints. + +What makes a good list of constraints? In general, our goal is to use constraints to tell the solver things that are true about our CSP so that it can converge on a solution as fast as possible. Given that most CSP search spaces are as vast and barren as the Mojave, our constraints are often not just the difference between a fast solution and a slow one, but whether the solver can finish in a non-boring amount of time. + +As it traverses the search space, the solver is constantly trying out partial assignments and learning about which avenues are likely to be fruitful. To that end, it wants to be able to avoid descending into parts of the search space that will be dead ends. For that reason, the most powerful tools for the CSP auteur are @bold{constraints relating two variables} (aka @italic{two-arity constraints}). Two-arity constraints can be checked early in the search process, and help the solver eliminate useless parts of the search space quickly. Two-arity constraints also work with inference functions like @racket[forward-check] and @racket[ac-3]. Once one of the variables is assigned, a two-arity constraint can be reduced to a one-arity constraint, which cooperates with node consistency (see @racket[current-node-consistency]). + +Say it with me again: two-arity constraints! OK, you got it. + +Some other tips: + +@itemlist[#:style 'ordered + +@item{The golden rule is to use as many two-arity constraints as necessary. If you can express your CSP using nothing but two-arity constraints, so much the better.} + +@item{Constraints with @italic{fewer} variables are generally preferable to those with @italic{more} variables. In programming we call this idea @italic{arity}; in CSP solving it's known as @italic{degree}.} + +@item{@italic{More} constraints are better than @italic{fewer} if the extra constraints use fewer variables. That is, lower-degree constraints are enough of a win that even if the lower-degree constraint overlaps with a higher-degree constraint, it's still better to include it. Why? Because it lets the solver eliminate fruitless parts of the search tree by considering fewer variables.} + +@item{Corollary: if a higher-degree constraint can be completely expressed in terms of lower-degree constraints, then do that, and get rid of the higher-degree constraint altogether. For an example, see @racket[add-pairwise-constraint!].} + +@item{In cases where the constraints have the same degree, and they completely overlap in terms of what they prove, use the @italic{fewest possible} consrtaints. For an example, see @racket[add-transitive-constraint!].} + +] + +By the way, in terms of the program itself, it doesn't matter what order you add the constraints. The CSP solver will visit them in whatever way it needs to. + @defproc[(make-csp [vars (listof var?) null] [constraints (listof constraint?) empty]) From 6824007df5f9c6269aef796e5bbd2d993ad1770d Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Sun, 10 Jan 2021 09:19:34 -0800 Subject: [PATCH 240/246] update docs example --- csp/csp/scribblings/csp.scrbl | 27 ++++++++++++++------------- 1 file changed, 14 insertions(+), 13 deletions(-) diff --git a/csp/csp/scribblings/csp.scrbl b/csp/csp/scribblings/csp.scrbl index 066d9b28..2ac66cf6 100644 --- a/csp/csp/scribblings/csp.scrbl +++ b/csp/csp/scribblings/csp.scrbl @@ -48,11 +48,12 @@ But there's still some finesse and artistry involved in setting up the CSP, espe @section{First example} -Suppose we wanted to find @link["http://www.friesian.com/pythag.htm"]{Pythagorean triples} with sides between 10 and 49, inclusive. +Suppose we wanted to find @link["http://www.friesian.com/pythag.htm"]{Pythagorean triples} with sides between 1 and 29, inclusive. First we create a new CSP called @racket[triples], using @racket[make-csp]: @examples[#:label #f #:eval my-eval +(require csp) (define triples (make-csp)) ] @@ -60,9 +61,9 @@ First we create a new CSP called @racket[triples], using @racket[make-csp]: We use CSP variables to represent the values in the triple. We insert each one with @racket[add-var!], where each variable has a @tech{symbol} for its name and a list of values for its domain: @examples[#:label #f #:eval my-eval -(add-var! triples 'a (range 10 50)) -(add-var! triples 'b (range 10 50)) -(add-var! triples 'c (range 10 50)) +(add-var! triples 'a (range 1 30)) +(add-var! triples 'b (range 1 30)) +(add-var! triples 'c (range 1 30)) ] Then we need our constraint. We make a function called @racket[valid-triple?] that tests three values to see if they qualify as a Pythagorean triple. Then we insert this function as a constraint using @racket[add-constraint!], passing as arguments 1) the function we want to use for the constraint, and 2) a list of variable names that the constraint applies to. @@ -82,7 +83,7 @@ Finally we call @racket[solve], which finds a solution (if it exists): (solve triples) ] -``But that's just the 5--12--13 triple, doubled.'' True. Suppose we want to ensure that the values in our solution have no common factors. We add a new @racket[coprime?] constraint: +``But that's just the 3--4--5 triangle, tripled.'' True. Suppose we want to ensure that the values in our solution have no common factors. We add a new @racket[coprime?] constraint: @examples[#:label #f #:eval my-eval (require math/number-theory) @@ -95,13 +96,13 @@ We @racket[solve] again to see the new result: (solve triples) ] -Perhaps we're curious to see how many of these triples exist. We use @racket[solve*] to find all four solutions: +Perhaps we're curious to see how many of these triples exist. We use @racket[solve*] to find all 10 solutions: @examples[#:label #f #:eval my-eval (solve* triples) ] -``But really there's only two solutions — the values for @racket[a] and @racket[b] are swapped in the other two.'' Fair enough. We might say that this problem is @deftech{symmetric} relative to variables @racket[a] and @racket[b], because they have the same domains and are constrained the same way. We can break the symmetry by adding a constraint that forces @racket[a] to be less than or equal to @racket[b]: +``But really there's only five solutions — the values for @racket[a] and @racket[b] are swapped in the other two.'' Fair enough. We might say that this problem is @deftech{symmetric} relative to variables @racket[a] and @racket[b], because they have the same domains and are constrained the same way. We can break the symmetry by adding a constraint that forces @racket[a] to be less than or equal to @racket[b]: @examples[#:label #f #:eval my-eval (add-constraint! triples <= '(a b)) @@ -153,9 +154,9 @@ The whole example in one block: (define triples (make-csp)) -(add-var! triples 'a (range 10 50)) -(add-var! triples 'b (range 10 50)) -(add-var! triples 'c (range 10 50)) +(add-var! triples 'a (range 1 30)) +(add-var! triples 'b (range 1 30)) +(add-var! triples 'c (range 1 30)) (define (valid-triple? x y z) (= (expt z 2) (+ (expt x 2) (expt y 2)))) @@ -174,10 +175,10 @@ The whole example in one block: ``Dude, are you kidding me? I can write a much shorter loop to do the same thing—" @my-examples[ -(for*/list ([a (in-range 10 50)] - [b (in-range 10 50)] +(for*/list ([a (in-range 1 30)] + [b (in-range 1 30)] #:when (<= a b) - [c (in-range 10 50)] + [c (in-range 1 30)] #:when (and (coprime? a b c) (valid-triple? a b c))) (map cons '(a b c) (list a b c))) ] From e6eb316bd80f7c2ba7d96dd7a0e548268a7a3e7b Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Wed, 13 Jan 2021 13:16:31 -0800 Subject: [PATCH 241/246] update docs example further --- csp/csp/scribblings/csp.scrbl | 21 +++++++++++---------- 1 file changed, 11 insertions(+), 10 deletions(-) diff --git a/csp/csp/scribblings/csp.scrbl b/csp/csp/scribblings/csp.scrbl index 2ac66cf6..aa50f6b6 100644 --- a/csp/csp/scribblings/csp.scrbl +++ b/csp/csp/scribblings/csp.scrbl @@ -58,7 +58,7 @@ First we create a new CSP called @racket[triples], using @racket[make-csp]: ] -We use CSP variables to represent the values in the triple. We insert each one with @racket[add-var!], where each variable has a @tech{symbol} for its name and a list of values for its domain: +We use CSP variables to represent the values in the triple. We insert each one with @racket[add-var!], where each variable has a symbol for its name and a list of values for its domain: @examples[#:label #f #:eval my-eval (add-var! triples 'a (range 1 30)) @@ -83,26 +83,27 @@ Finally we call @racket[solve], which finds a solution (if it exists): (solve triples) ] -``But that's just the 3--4--5 triangle, tripled.'' True. Suppose we want to ensure that the values in our solution have no common factors. We add a new @racket[coprime?] constraint: +Perhaps we're curious to see how many of these triples exist. We use @racket[solve*] to find all 200 solutions: @examples[#:label #f #:eval my-eval -(require math/number-theory) -(add-constraint! triples coprime? '(a b c)) +(solve* triples) ] -We @racket[solve] again to see the new result: +``But some of those solutions are just multiples of others, like 3--4--5 and 6--8--10.'' True. Suppose we want to ensure that the values in each solution have no common factors. We add a new @racket[coprime?] constraint: @examples[#:label #f #:eval my-eval -(solve triples) +(require math/number-theory) +(add-constraint! triples coprime? '(a b c)) ] -Perhaps we're curious to see how many of these triples exist. We use @racket[solve*] to find all 10 solutions: +We @racket[solve*] again to see the 10 results: @examples[#:label #f #:eval my-eval (solve* triples) ] -``But really there's only five solutions — the values for @racket[a] and @racket[b] are swapped in the other two.'' Fair enough. We might say that this problem is @deftech{symmetric} relative to variables @racket[a] and @racket[b], because they have the same domains and are constrained the same way. We can break the symmetry by adding a constraint that forces @racket[a] to be less than or equal to @racket[b]: + +``But really there's only five unique solutions — the values for @racket[a] and @racket[b] are swapped in the other two.'' Fair enough. We might say that this problem is @deftech{symmetric} relative to variables @racket[a] and @racket[b], because they have the same domains and are constrained the same way. We can break the symmetry by adding a constraint that forces @racket[a] to be less than or equal to @racket[b]: @examples[#:label #f #:eval my-eval (add-constraint! triples <= '(a b)) @@ -122,7 +123,7 @@ By the way, what if we had accidentally included @racket[c] in the last constrai Nothing changes. Why not? Because of the existing @racket[valid-triple?] constraint, @racket[c] is necessarily going to be larger than @racket[a] and @racket[b]. So it always meets this constraint too. It's good practice to not duplicate constraints between the same sets of variables — the ``belt and suspenders'' approach just adds work for no benefit. -We should use @racket[solve*] with care. It can't finish until the CSP solver examines every possible assignment of values in the problem, which can be a big number. Specifically, it's the product of the domain sizes of each variable, which in this case is 40 × 40 × 40 = 64,000. This realm of possible assignments is also known as the CSP's @deftech{state space}. We can also get this number from @racket[state-count]: +We should use @racket[solve*] with care. It can't finish until the CSP solver examines every possible assignment of values in the problem, which can be a big number. Specifically, it's the product of the domain sizes of each variable, which in this case is 29 × 29 × 29 = 24,389. This realm of possible assignments is also known as the CSP's @deftech{state space}. We can also get this number from @racket[state-count]: @examples[#:label #f #:eval my-eval (state-count triples) @@ -167,7 +168,7 @@ The whole example in one block: (add-constraint! triples <= '(a b)) -(solve* triples 2) +(solve* triples) ] @section{Interlude} From c05a32f1fd9493f85afbe77c3186d575f57e625c Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Thu, 14 Jan 2021 08:11:09 -0800 Subject: [PATCH 242/246] doc typos --- csp/csp/scribblings/csp.scrbl | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/csp/csp/scribblings/csp.scrbl b/csp/csp/scribblings/csp.scrbl index aa50f6b6..5f733c2d 100644 --- a/csp/csp/scribblings/csp.scrbl +++ b/csp/csp/scribblings/csp.scrbl @@ -83,7 +83,7 @@ Finally we call @racket[solve], which finds a solution (if it exists): (solve triples) ] -Perhaps we're curious to see how many of these triples exist. We use @racket[solve*] to find all 200 solutions: +Perhaps we're curious to see how many of these triples exist. We use @racket[solve*] to find all 20 solutions: @examples[#:label #f #:eval my-eval (solve* triples) @@ -96,14 +96,14 @@ Perhaps we're curious to see how many of these triples exist. We use @racket[sol (add-constraint! triples coprime? '(a b c)) ] -We @racket[solve*] again to see the 10 results: +We @racket[solve*] again to see the reduced set of 10 results: @examples[#:label #f #:eval my-eval (solve* triples) ] -``But really there's only five unique solutions — the values for @racket[a] and @racket[b] are swapped in the other two.'' Fair enough. We might say that this problem is @deftech{symmetric} relative to variables @racket[a] and @racket[b], because they have the same domains and are constrained the same way. We can break the symmetry by adding a constraint that forces @racket[a] to be less than or equal to @racket[b]: +``But really there's only five unique solutions — the values for @racket[a] and @racket[b] are swapped in the other five.'' Fair enough. We might say that this problem is @deftech{symmetric} relative to variables @racket[a] and @racket[b], because they have the same domains and are constrained the same way. We can break the symmetry by adding a constraint that forces @racket[a] to be less than or equal to @racket[b]: @examples[#:label #f #:eval my-eval (add-constraint! triples <= '(a b)) From 9aff9565e8df4677914bc11e6f3ab99a599e49ad Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Fri, 29 Jan 2021 16:22:56 -0800 Subject: [PATCH 243/246] typo --- csp/csp/scribblings/csp.scrbl | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/csp/csp/scribblings/csp.scrbl b/csp/csp/scribblings/csp.scrbl index 5f733c2d..faafcf06 100644 --- a/csp/csp/scribblings/csp.scrbl +++ b/csp/csp/scribblings/csp.scrbl @@ -657,7 +657,7 @@ Represents a variable in a CSP. @defstruct[constraint ([names (listof var-name?)] [proc procedure?]) #:transparent]{ -Represents a constraing in a CSP. +Represents a constraint in a CSP. } @defproc[(var-name? From 302af47c5abcaec9c12f5efb321db5815e76552e Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Mon, 8 Mar 2021 08:24:42 -0800 Subject: [PATCH 244/246] doc typo --- csp/csp/scribblings/csp.scrbl | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/csp/csp/scribblings/csp.scrbl b/csp/csp/scribblings/csp.scrbl index faafcf06..440f9a95 100644 --- a/csp/csp/scribblings/csp.scrbl +++ b/csp/csp/scribblings/csp.scrbl @@ -184,7 +184,7 @@ The whole example in one block: (map cons '(a b c) (list a b c))) ] -Yes, I agree that in this toy example, the CSP approach is overkill. The variables are few enough, the domains small enough, and the constraints simple enough, that a loop is more concise. Also, with only 64,000 possibilities in the state space, this sort of brute-force approach is cheap & cheerful. +Yes, I agree that in this toy example, the CSP approach is overkill. The variables are few enough, the domains small enough, and the constraints simple enough, that a loop is more concise. Also, with only 24,389 possibilities in the state space, this sort of brute-force approach is cheap & cheerful. @section{Second example} From c641419b65d0d4fcc71c460383cef74ad4784569 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Mon, 8 Mar 2021 08:27:37 -0800 Subject: [PATCH 245/246] typo --- csp/csp/scribblings/csp.scrbl | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/csp/csp/scribblings/csp.scrbl b/csp/csp/scribblings/csp.scrbl index 440f9a95..a2f8b81b 100644 --- a/csp/csp/scribblings/csp.scrbl +++ b/csp/csp/scribblings/csp.scrbl @@ -622,7 +622,7 @@ Applies the AC-3 arc-consistency algorithm. Similar to forward checking, but che Specifically: following a new variable assignment, AC-3 examines all constraints that link exactly two unassigned variables. It checks that each variable has at least one value in its domain that can be paired with the other to satisfy the constraint (this pair comprises the eponymous @italic{arc}). If no such pair exists, then the constraint can never be satisfied, so the new variable assignment must fail. -``So AC-3 is a superset of @racket[forward-check]?" Yes. Both techniques examine two-arity constraints after variable @racket[_name] has been assigned a value. Forward checking, however, only examines two-arity functions that include variable @racket[_name] in the constraint. Whereas AC-3 checks @italic{all} two-arity functions (even those that don't include @racket[_name]). +``So AC-3 is a superset of @racket[forward-check]?'' Yes. Both techniques examine two-arity constraints after variable @racket[_name] has been assigned a value. Forward checking, however, only examines two-arity functions that include variable @racket[_name] in the constraint. Whereas AC-3 checks @italic{all} two-arity functions (even those that don't include @racket[_name]). In this way, AC-3 can detect inconsistencies that forward checking would miss. For instance, consider a CSP with three variables @italic{a} @italic{b} and @italic{c}, and three constraints @italic{ab}, @italic{ac}, and @italic{ab}. We assign a value to @italic{a}. Forward checking would then check constraints @italic{ab} and @italic{ac}, perhaps removing values from the domains of @italic{b} and @italic{c} to be consistent with the new value of @italic{a}. These domain reductions, however, might be inconsistent with constraint @italic{bc}. Forward checking won't notice this, because it never tests @italic{bc}. But AC-3 does test @italic{bc}, so it would notice the inconsistency. From 993005dc20ac75701dbdeeae120d98ddd516dba6 Mon Sep 17 00:00:00 2001 From: Matthew Butterick Date: Tue, 18 May 2021 09:13:52 -0700 Subject: [PATCH 246/246] Update README.md --- csp/README.md | 13 +++++++++++-- 1 file changed, 11 insertions(+), 2 deletions(-) diff --git a/csp/README.md b/csp/README.md index 334f8bd6..e7d30c5b 100644 --- a/csp/README.md +++ b/csp/README.md @@ -1,4 +1,13 @@ -csp -=== +## csp `raco pkg install csp` + + +## Docs + +https://docs.racket-lang.org/csp/ + + +## Project status + +Unclear. The code works well, but I built this library thinking it would be useful for a certain project and then it turned out I didn’t need it. I haven’t abandoned it. But I also haven’t gotten it to a 1.0 release. And I don’t want to, unless I’m developing it in service of a larger project, because that tends to be the best way to reveal bugs and misbegotten thinking.