diff --git a/ChangeLog.md b/ChangeLog.md
new file mode 100644
--- /dev/null
+++ b/ChangeLog.md
@@ -0,0 +1,5 @@
+# Revision history for hgraph
+
+## 1.0.0.0 -- 2019-06-07
+
+* First version.
diff --git a/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,674 @@
+ GNU GENERAL PUBLIC LICENSE
+ Version 3, 29 June 2007
+
+ Copyright (C) 2007 Free Software Foundation, Inc.
+ Everyone is permitted to copy and distribute verbatim copies
+ of this license document, but changing it is not allowed.
+
+ Preamble
+
+ The GNU General Public License is a free, copyleft license for
+software and other kinds of works.
+
+ The licenses for most software and other practical works are designed
+to take away your freedom to share and change the works. By contrast,
+the GNU General Public License is intended to guarantee your freedom to
+share and change all versions of a program--to make sure it remains free
+software for all its users. We, the Free Software Foundation, use the
+GNU General Public License for most of our software; it applies also to
+any other work released this way by its authors. You can apply it to
+your programs, too.
+
+ When we speak of free software, we are referring to freedom, not
+price. Our General Public Licenses are designed to make sure that you
+have the freedom to distribute copies of free software (and charge for
+them if you wish), that you receive source code or can get it if you
+want it, that you can change the software or use pieces of it in new
+free programs, and that you know you can do these things.
+
+ To protect your rights, we need to prevent others from denying you
+these rights or asking you to surrender the rights. Therefore, you have
+certain responsibilities if you distribute copies of the software, or if
+you modify it: responsibilities to respect the freedom of others.
+
+ For example, if you distribute copies of such a program, whether
+gratis or for a fee, you must pass on to the recipients the same
+freedoms that you received. You must make sure that they, too, receive
+or can get the source code. And you must show them these terms so they
+know their rights.
+
+ Developers that use the GNU GPL protect your rights with two steps:
+(1) assert copyright on the software, and (2) offer you this License
+giving you legal permission to copy, distribute and/or modify it.
+
+ For the developers' and authors' protection, the GPL clearly explains
+that there is no warranty for this free software. For both users' and
+authors' sake, the GPL requires that modified versions be marked as
+changed, so that their problems will not be attributed erroneously to
+authors of previous versions.
+
+ Some devices are designed to deny users access to install or run
+modified versions of the software inside them, although the manufacturer
+can do so. This is fundamentally incompatible with the aim of
+protecting users' freedom to change the software. The systematic
+pattern of such abuse occurs in the area of products for individuals to
+use, which is precisely where it is most unacceptable. Therefore, we
+have designed this version of the GPL to prohibit the practice for those
+products. If such problems arise substantially in other domains, we
+stand ready to extend this provision to those domains in future versions
+of the GPL, as needed to protect the freedom of users.
+
+ Finally, every program is threatened constantly by software patents.
+States should not allow patents to restrict development and use of
+software on general-purpose computers, but in those that do, we wish to
+avoid the special danger that patents applied to a free program could
+make it effectively proprietary. To prevent this, the GPL assures that
+patents cannot be used to render the program non-free.
+
+ The precise terms and conditions for copying, distribution and
+modification follow.
+
+ TERMS AND CONDITIONS
+
+ 0. Definitions.
+
+ "This License" refers to version 3 of the GNU General Public License.
+
+ "Copyright" also means copyright-like laws that apply to other kinds of
+works, such as semiconductor masks.
+
+ "The Program" refers to any copyrightable work licensed under this
+License. Each licensee is addressed as "you". "Licensees" and
+"recipients" may be individuals or organizations.
+
+ To "modify" a work means to copy from or adapt all or part of the work
+in a fashion requiring copyright permission, other than the making of an
+exact copy. The resulting work is called a "modified version" of the
+earlier work or a work "based on" the earlier work.
+
+ A "covered work" means either the unmodified Program or a work based
+on the Program.
+
+ To "propagate" a work means to do anything with it that, without
+permission, would make you directly or secondarily liable for
+infringement under applicable copyright law, except executing it on a
+computer or modifying a private copy. Propagation includes copying,
+distribution (with or without modification), making available to the
+public, and in some countries other activities as well.
+
+ To "convey" a work means any kind of propagation that enables other
+parties to make or receive copies. Mere interaction with a user through
+a computer network, with no transfer of a copy, is not conveying.
+
+ An interactive user interface displays "Appropriate Legal Notices"
+to the extent that it includes a convenient and prominently visible
+feature that (1) displays an appropriate copyright notice, and (2)
+tells the user that there is no warranty for the work (except to the
+extent that warranties are provided), that licensees may convey the
+work under this License, and how to view a copy of this License. If
+the interface presents a list of user commands or options, such as a
+menu, a prominent item in the list meets this criterion.
+
+ 1. Source Code.
+
+ The "source code" for a work means the preferred form of the work
+for making modifications to it. "Object code" means any non-source
+form of a work.
+
+ A "Standard Interface" means an interface that either is an official
+standard defined by a recognized standards body, or, in the case of
+interfaces specified for a particular programming language, one that
+is widely used among developers working in that language.
+
+ The "System Libraries" of an executable work include anything, other
+than the work as a whole, that (a) is included in the normal form of
+packaging a Major Component, but which is not part of that Major
+Component, and (b) serves only to enable use of the work with that
+Major Component, or to implement a Standard Interface for which an
+implementation is available to the public in source code form. A
+"Major Component", in this context, means a major essential component
+(kernel, window system, and so on) of the specific operating system
+(if any) on which the executable work runs, or a compiler used to
+produce the work, or an object code interpreter used to run it.
+
+ The "Corresponding Source" for a work in object code form means all
+the source code needed to generate, install, and (for an executable
+work) run the object code and to modify the work, including scripts to
+control those activities. However, it does not include the work's
+System Libraries, or general-purpose tools or generally available free
+programs which are used unmodified in performing those activities but
+which are not part of the work. For example, Corresponding Source
+includes interface definition files associated with source files for
+the work, and the source code for shared libraries and dynamically
+linked subprograms that the work is specifically designed to require,
+such as by intimate data communication or control flow between those
+subprograms and other parts of the work.
+
+ The Corresponding Source need not include anything that users
+can regenerate automatically from other parts of the Corresponding
+Source.
+
+ The Corresponding Source for a work in source code form is that
+same work.
+
+ 2. Basic Permissions.
+
+ All rights granted under this License are granted for the term of
+copyright on the Program, and are irrevocable provided the stated
+conditions are met. This License explicitly affirms your unlimited
+permission to run the unmodified Program. The output from running a
+covered work is covered by this License only if the output, given its
+content, constitutes a covered work. This License acknowledges your
+rights of fair use or other equivalent, as provided by copyright law.
+
+ You may make, run and propagate covered works that you do not
+convey, without conditions so long as your license otherwise remains
+in force. You may convey covered works to others for the sole purpose
+of having them make modifications exclusively for you, or provide you
+with facilities for running those works, provided that you comply with
+the terms of this License in conveying all material for which you do
+not control copyright. Those thus making or running the covered works
+for you must do so exclusively on your behalf, under your direction
+and control, on terms that prohibit them from making any copies of
+your copyrighted material outside their relationship with you.
+
+ Conveying under any other circumstances is permitted solely under
+the conditions stated below. Sublicensing is not allowed; section 10
+makes it unnecessary.
+
+ 3. Protecting Users' Legal Rights From Anti-Circumvention Law.
+
+ No covered work shall be deemed part of an effective technological
+measure under any applicable law fulfilling obligations under article
+11 of the WIPO copyright treaty adopted on 20 December 1996, or
+similar laws prohibiting or restricting circumvention of such
+measures.
+
+ When you convey a covered work, you waive any legal power to forbid
+circumvention of technological measures to the extent such circumvention
+is effected by exercising rights under this License with respect to
+the covered work, and you disclaim any intention to limit operation or
+modification of the work as a means of enforcing, against the work's
+users, your or third parties' legal rights to forbid circumvention of
+technological measures.
+
+ 4. Conveying Verbatim Copies.
+
+ You may convey verbatim copies of the Program's source code as you
+receive it, in any medium, provided that you conspicuously and
+appropriately publish on each copy an appropriate copyright notice;
+keep intact all notices stating that this License and any
+non-permissive terms added in accord with section 7 apply to the code;
+keep intact all notices of the absence of any warranty; and give all
+recipients a copy of this License along with the Program.
+
+ You may charge any price or no price for each copy that you convey,
+and you may offer support or warranty protection for a fee.
+
+ 5. Conveying Modified Source Versions.
+
+ You may convey a work based on the Program, or the modifications to
+produce it from the Program, in the form of source code under the
+terms of section 4, provided that you also meet all of these conditions:
+
+ a) The work must carry prominent notices stating that you modified
+ it, and giving a relevant date.
+
+ b) The work must carry prominent notices stating that it is
+ released under this License and any conditions added under section
+ 7. This requirement modifies the requirement in section 4 to
+ "keep intact all notices".
+
+ c) You must license the entire work, as a whole, under this
+ License to anyone who comes into possession of a copy. This
+ License will therefore apply, along with any applicable section 7
+ additional terms, to the whole of the work, and all its parts,
+ regardless of how they are packaged. This License gives no
+ permission to license the work in any other way, but it does not
+ invalidate such permission if you have separately received it.
+
+ d) If the work has interactive user interfaces, each must display
+ Appropriate Legal Notices; however, if the Program has interactive
+ interfaces that do not display Appropriate Legal Notices, your
+ work need not make them do so.
+
+ A compilation of a covered work with other separate and independent
+works, which are not by their nature extensions of the covered work,
+and which are not combined with it such as to form a larger program,
+in or on a volume of a storage or distribution medium, is called an
+"aggregate" if the compilation and its resulting copyright are not
+used to limit the access or legal rights of the compilation's users
+beyond what the individual works permit. Inclusion of a covered work
+in an aggregate does not cause this License to apply to the other
+parts of the aggregate.
+
+ 6. Conveying Non-Source Forms.
+
+ You may convey a covered work in object code form under the terms
+of sections 4 and 5, provided that you also convey the
+machine-readable Corresponding Source under the terms of this License,
+in one of these ways:
+
+ a) Convey the object code in, or embodied in, a physical product
+ (including a physical distribution medium), accompanied by the
+ Corresponding Source fixed on a durable physical medium
+ customarily used for software interchange.
+
+ b) Convey the object code in, or embodied in, a physical product
+ (including a physical distribution medium), accompanied by a
+ written offer, valid for at least three years and valid for as
+ long as you offer spare parts or customer support for that product
+ model, to give anyone who possesses the object code either (1) a
+ copy of the Corresponding Source for all the software in the
+ product that is covered by this License, on a durable physical
+ medium customarily used for software interchange, for a price no
+ more than your reasonable cost of physically performing this
+ conveying of source, or (2) access to copy the
+ Corresponding Source from a network server at no charge.
+
+ c) Convey individual copies of the object code with a copy of the
+ written offer to provide the Corresponding Source. This
+ alternative is allowed only occasionally and noncommercially, and
+ only if you received the object code with such an offer, in accord
+ with subsection 6b.
+
+ d) Convey the object code by offering access from a designated
+ place (gratis or for a charge), and offer equivalent access to the
+ Corresponding Source in the same way through the same place at no
+ further charge. You need not require recipients to copy the
+ Corresponding Source along with the object code. If the place to
+ copy the object code is a network server, the Corresponding Source
+ may be on a different server (operated by you or a third party)
+ that supports equivalent copying facilities, provided you maintain
+ clear directions next to the object code saying where to find the
+ Corresponding Source. Regardless of what server hosts the
+ Corresponding Source, you remain obligated to ensure that it is
+ available for as long as needed to satisfy these requirements.
+
+ e) Convey the object code using peer-to-peer transmission, provided
+ you inform other peers where the object code and Corresponding
+ Source of the work are being offered to the general public at no
+ charge under subsection 6d.
+
+ A separable portion of the object code, whose source code is excluded
+from the Corresponding Source as a System Library, need not be
+included in conveying the object code work.
+
+ A "User Product" is either (1) a "consumer product", which means any
+tangible personal property which is normally used for personal, family,
+or household purposes, or (2) anything designed or sold for incorporation
+into a dwelling. In determining whether a product is a consumer product,
+doubtful cases shall be resolved in favor of coverage. For a particular
+product received by a particular user, "normally used" refers to a
+typical or common use of that class of product, regardless of the status
+of the particular user or of the way in which the particular user
+actually uses, or expects or is expected to use, the product. A product
+is a consumer product regardless of whether the product has substantial
+commercial, industrial or non-consumer uses, unless such uses represent
+the only significant mode of use of the product.
+
+ "Installation Information" for a User Product means any methods,
+procedures, authorization keys, or other information required to install
+and execute modified versions of a covered work in that User Product from
+a modified version of its Corresponding Source. The information must
+suffice to ensure that the continued functioning of the modified object
+code is in no case prevented or interfered with solely because
+modification has been made.
+
+ If you convey an object code work under this section in, or with, or
+specifically for use in, a User Product, and the conveying occurs as
+part of a transaction in which the right of possession and use of the
+User Product is transferred to the recipient in perpetuity or for a
+fixed term (regardless of how the transaction is characterized), the
+Corresponding Source conveyed under this section must be accompanied
+by the Installation Information. But this requirement does not apply
+if neither you nor any third party retains the ability to install
+modified object code on the User Product (for example, the work has
+been installed in ROM).
+
+ The requirement to provide Installation Information does not include a
+requirement to continue to provide support service, warranty, or updates
+for a work that has been modified or installed by the recipient, or for
+the User Product in which it has been modified or installed. Access to a
+network may be denied when the modification itself materially and
+adversely affects the operation of the network or violates the rules and
+protocols for communication across the network.
+
+ Corresponding Source conveyed, and Installation Information provided,
+in accord with this section must be in a format that is publicly
+documented (and with an implementation available to the public in
+source code form), and must require no special password or key for
+unpacking, reading or copying.
+
+ 7. Additional Terms.
+
+ "Additional permissions" are terms that supplement the terms of this
+License by making exceptions from one or more of its conditions.
+Additional permissions that are applicable to the entire Program shall
+be treated as though they were included in this License, to the extent
+that they are valid under applicable law. If additional permissions
+apply only to part of the Program, that part may be used separately
+under those permissions, but the entire Program remains governed by
+this License without regard to the additional permissions.
+
+ When you convey a copy of a covered work, you may at your option
+remove any additional permissions from that copy, or from any part of
+it. (Additional permissions may be written to require their own
+removal in certain cases when you modify the work.) You may place
+additional permissions on material, added by you to a covered work,
+for which you have or can give appropriate copyright permission.
+
+ Notwithstanding any other provision of this License, for material you
+add to a covered work, you may (if authorized by the copyright holders of
+that material) supplement the terms of this License with terms:
+
+ a) Disclaiming warranty or limiting liability differently from the
+ terms of sections 15 and 16 of this License; or
+
+ b) Requiring preservation of specified reasonable legal notices or
+ author attributions in that material or in the Appropriate Legal
+ Notices displayed by works containing it; or
+
+ c) Prohibiting misrepresentation of the origin of that material, or
+ requiring that modified versions of such material be marked in
+ reasonable ways as different from the original version; or
+
+ d) Limiting the use for publicity purposes of names of licensors or
+ authors of the material; or
+
+ e) Declining to grant rights under trademark law for use of some
+ trade names, trademarks, or service marks; or
+
+ f) Requiring indemnification of licensors and authors of that
+ material by anyone who conveys the material (or modified versions of
+ it) with contractual assumptions of liability to the recipient, for
+ any liability that these contractual assumptions directly impose on
+ those licensors and authors.
+
+ All other non-permissive additional terms are considered "further
+restrictions" within the meaning of section 10. If the Program as you
+received it, or any part of it, contains a notice stating that it is
+governed by this License along with a term that is a further
+restriction, you may remove that term. If a license document contains
+a further restriction but permits relicensing or conveying under this
+License, you may add to a covered work material governed by the terms
+of that license document, provided that the further restriction does
+not survive such relicensing or conveying.
+
+ If you add terms to a covered work in accord with this section, you
+must place, in the relevant source files, a statement of the
+additional terms that apply to those files, or a notice indicating
+where to find the applicable terms.
+
+ Additional terms, permissive or non-permissive, may be stated in the
+form of a separately written license, or stated as exceptions;
+the above requirements apply either way.
+
+ 8. Termination.
+
+ You may not propagate or modify a covered work except as expressly
+provided under this License. Any attempt otherwise to propagate or
+modify it is void, and will automatically terminate your rights under
+this License (including any patent licenses granted under the third
+paragraph of section 11).
+
+ However, if you cease all violation of this License, then your
+license from a particular copyright holder is reinstated (a)
+provisionally, unless and until the copyright holder explicitly and
+finally terminates your license, and (b) permanently, if the copyright
+holder fails to notify you of the violation by some reasonable means
+prior to 60 days after the cessation.
+
+ Moreover, your license from a particular copyright holder is
+reinstated permanently if the copyright holder notifies you of the
+violation by some reasonable means, this is the first time you have
+received notice of violation of this License (for any work) from that
+copyright holder, and you cure the violation prior to 30 days after
+your receipt of the notice.
+
+ Termination of your rights under this section does not terminate the
+licenses of parties who have received copies or rights from you under
+this License. If your rights have been terminated and not permanently
+reinstated, you do not qualify to receive new licenses for the same
+material under section 10.
+
+ 9. Acceptance Not Required for Having Copies.
+
+ You are not required to accept this License in order to receive or
+run a copy of the Program. Ancillary propagation of a covered work
+occurring solely as a consequence of using peer-to-peer transmission
+to receive a copy likewise does not require acceptance. However,
+nothing other than this License grants you permission to propagate or
+modify any covered work. These actions infringe copyright if you do
+not accept this License. Therefore, by modifying or propagating a
+covered work, you indicate your acceptance of this License to do so.
+
+ 10. Automatic Licensing of Downstream Recipients.
+
+ Each time you convey a covered work, the recipient automatically
+receives a license from the original licensors, to run, modify and
+propagate that work, subject to this License. You are not responsible
+for enforcing compliance by third parties with this License.
+
+ An "entity transaction" is a transaction transferring control of an
+organization, or substantially all assets of one, or subdividing an
+organization, or merging organizations. If propagation of a covered
+work results from an entity transaction, each party to that
+transaction who receives a copy of the work also receives whatever
+licenses to the work the party's predecessor in interest had or could
+give under the previous paragraph, plus a right to possession of the
+Corresponding Source of the work from the predecessor in interest, if
+the predecessor has it or can get it with reasonable efforts.
+
+ You may not impose any further restrictions on the exercise of the
+rights granted or affirmed under this License. For example, you may
+not impose a license fee, royalty, or other charge for exercise of
+rights granted under this License, and you may not initiate litigation
+(including a cross-claim or counterclaim in a lawsuit) alleging that
+any patent claim is infringed by making, using, selling, offering for
+sale, or importing the Program or any portion of it.
+
+ 11. Patents.
+
+ A "contributor" is a copyright holder who authorizes use under this
+License of the Program or a work on which the Program is based. The
+work thus licensed is called the contributor's "contributor version".
+
+ A contributor's "essential patent claims" are all patent claims
+owned or controlled by the contributor, whether already acquired or
+hereafter acquired, that would be infringed by some manner, permitted
+by this License, of making, using, or selling its contributor version,
+but do not include claims that would be infringed only as a
+consequence of further modification of the contributor version. For
+purposes of this definition, "control" includes the right to grant
+patent sublicenses in a manner consistent with the requirements of
+this License.
+
+ Each contributor grants you a non-exclusive, worldwide, royalty-free
+patent license under the contributor's essential patent claims, to
+make, use, sell, offer for sale, import and otherwise run, modify and
+propagate the contents of its contributor version.
+
+ In the following three paragraphs, a "patent license" is any express
+agreement or commitment, however denominated, not to enforce a patent
+(such as an express permission to practice a patent or covenant not to
+sue for patent infringement). To "grant" such a patent license to a
+party means to make such an agreement or commitment not to enforce a
+patent against the party.
+
+ If you convey a covered work, knowingly relying on a patent license,
+and the Corresponding Source of the work is not available for anyone
+to copy, free of charge and under the terms of this License, through a
+publicly available network server or other readily accessible means,
+then you must either (1) cause the Corresponding Source to be so
+available, or (2) arrange to deprive yourself of the benefit of the
+patent license for this particular work, or (3) arrange, in a manner
+consistent with the requirements of this License, to extend the patent
+license to downstream recipients. "Knowingly relying" means you have
+actual knowledge that, but for the patent license, your conveying the
+covered work in a country, or your recipient's use of the covered work
+in a country, would infringe one or more identifiable patents in that
+country that you have reason to believe are valid.
+
+ If, pursuant to or in connection with a single transaction or
+arrangement, you convey, or propagate by procuring conveyance of, a
+covered work, and grant a patent license to some of the parties
+receiving the covered work authorizing them to use, propagate, modify
+or convey a specific copy of the covered work, then the patent license
+you grant is automatically extended to all recipients of the covered
+work and works based on it.
+
+ A patent license is "discriminatory" if it does not include within
+the scope of its coverage, prohibits the exercise of, or is
+conditioned on the non-exercise of one or more of the rights that are
+specifically granted under this License. You may not convey a covered
+work if you are a party to an arrangement with a third party that is
+in the business of distributing software, under which you make payment
+to the third party based on the extent of your activity of conveying
+the work, and under which the third party grants, to any of the
+parties who would receive the covered work from you, a discriminatory
+patent license (a) in connection with copies of the covered work
+conveyed by you (or copies made from those copies), or (b) primarily
+for and in connection with specific products or compilations that
+contain the covered work, unless you entered into that arrangement,
+or that patent license was granted, prior to 28 March 2007.
+
+ Nothing in this License shall be construed as excluding or limiting
+any implied license or other defenses to infringement that may
+otherwise be available to you under applicable patent law.
+
+ 12. No Surrender of Others' Freedom.
+
+ If conditions are imposed on you (whether by court order, agreement or
+otherwise) that contradict the conditions of this License, they do not
+excuse you from the conditions of this License. If you cannot convey a
+covered work so as to satisfy simultaneously your obligations under this
+License and any other pertinent obligations, then as a consequence you may
+not convey it at all. For example, if you agree to terms that obligate you
+to collect a royalty for further conveying from those to whom you convey
+the Program, the only way you could satisfy both those terms and this
+License would be to refrain entirely from conveying the Program.
+
+ 13. Use with the GNU Affero General Public License.
+
+ Notwithstanding any other provision of this License, you have
+permission to link or combine any covered work with a work licensed
+under version 3 of the GNU Affero General Public License into a single
+combined work, and to convey the resulting work. The terms of this
+License will continue to apply to the part which is the covered work,
+but the special requirements of the GNU Affero General Public License,
+section 13, concerning interaction through a network will apply to the
+combination as such.
+
+ 14. Revised Versions of this License.
+
+ The Free Software Foundation may publish revised and/or new versions of
+the GNU General Public License from time to time. Such new versions will
+be similar in spirit to the present version, but may differ in detail to
+address new problems or concerns.
+
+ Each version is given a distinguishing version number. If the
+Program specifies that a certain numbered version of the GNU General
+Public License "or any later version" applies to it, you have the
+option of following the terms and conditions either of that numbered
+version or of any later version published by the Free Software
+Foundation. If the Program does not specify a version number of the
+GNU General Public License, you may choose any version ever published
+by the Free Software Foundation.
+
+ If the Program specifies that a proxy can decide which future
+versions of the GNU General Public License can be used, that proxy's
+public statement of acceptance of a version permanently authorizes you
+to choose that version for the Program.
+
+ Later license versions may give you additional or different
+permissions. However, no additional obligations are imposed on any
+author or copyright holder as a result of your choosing to follow a
+later version.
+
+ 15. Disclaimer of Warranty.
+
+ THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY
+APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT
+HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY
+OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO,
+THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
+PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM
+IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF
+ALL NECESSARY SERVICING, REPAIR OR CORRECTION.
+
+ 16. Limitation of Liability.
+
+ IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
+WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR CONVEYS
+THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY
+GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE
+USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF
+DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD
+PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS),
+EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF
+SUCH DAMAGES.
+
+ 17. Interpretation of Sections 15 and 16.
+
+ If the disclaimer of warranty and limitation of liability provided
+above cannot be given local legal effect according to their terms,
+reviewing courts shall apply local law that most closely approximates
+an absolute waiver of all civil liability in connection with the
+Program, unless a warranty or assumption of liability accompanies a
+copy of the Program in return for a fee.
+
+ END OF TERMS AND CONDITIONS
+
+ How to Apply These Terms to Your New Programs
+
+ If you develop a new program, and you want it to be of the greatest
+possible use to the public, the best way to achieve this is to make it
+free software which everyone can redistribute and change under these terms.
+
+ To do so, attach the following notices to the program. It is safest
+to attach them to the start of each source file to most effectively
+state the exclusion of warranty; and each file should have at least
+the "copyright" line and a pointer to where the full notice is found.
+
+
+ Copyright (C)
+
+ This program is free software: you can redistribute it and/or modify
+ it under the terms of the GNU General Public License as published by
+ the Free Software Foundation, either version 3 of the License, or
+ (at your option) any later version.
+
+ This program is distributed in the hope that it will be useful,
+ but WITHOUT ANY WARRANTY; without even the implied warranty of
+ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ GNU General Public License for more details.
+
+ You should have received a copy of the GNU General Public License
+ along with this program. If not, see .
+
+Also add information on how to contact you by electronic and paper mail.
+
+ If the program does terminal interaction, make it output a short
+notice like this when it starts in an interactive mode:
+
+ Copyright (C)
+ This program comes with ABSOLUTELY NO WARRANTY; for details type `show w'.
+ This is free software, and you are welcome to redistribute it
+ under certain conditions; type `show c' for details.
+
+The hypothetical commands `show w' and `show c' should show the appropriate
+parts of the General Public License. Of course, your program's commands
+might be different; for a GUI interface, you would use an "about box".
+
+ You should also get your employer (if you work as a programmer) or school,
+if any, to sign a "copyright disclaimer" for the program, if necessary.
+For more information on this, and how to apply and follow the GNU GPL, see
+.
+
+ The GNU General Public License does not permit incorporating your program
+into proprietary programs. If your program is a subroutine library, you
+may consider it more useful to permit linking proprietary applications with
+the library. If this is what you want to do, use the GNU Lesser General
+Public License instead of this License. But first, please read
+.
diff --git a/benchmarks/VertexCover.hs b/benchmarks/VertexCover.hs
new file mode 100644
--- /dev/null
+++ b/benchmarks/VertexCover.hs
@@ -0,0 +1,35 @@
+{-# LANGUAGE BangPatterns #-}
+module Main where
+
+import HGraph.Undirected.Generator
+import HGraph.Undirected.AdjacencyMap
+import HGraph.Undirected.Solvers.VertexCover
+import Data.List
+
+import System.Clock
+
+runBench !(g,name) = do
+ start <- getTime ProcessCPUTime
+ let vc = minimumVertexCover g
+ !nVerts = numVertices g
+ !nEdges = numEdges g
+ !vcSize = length vc
+ end <- getTime ProcessCPUTime
+ let delta = (toNanoSecs $ diffTimeSpec end start) `div` 10^6
+ return $ ( intercalate ","
+ [ show name
+ , show nVerts
+ , show nEdges
+ , show delta
+ , show vcSize
+ ] ,
+ delta)
+
+instances =
+ [ (grid emptyGraph w h, "grid-" ++ show w ++ "x" ++ show h) | w <- [1..8], h <- [w..8] ]
+
+main = do
+ results <- mapM runBench instances
+ let times = map snd results
+ let totalTime = sum times
+ putStrLn $ intercalate "\n" $ "instance, vertices, edges, time (ms), solution" : map fst results
diff --git a/hgraph.cabal b/hgraph.cabal
new file mode 100644
--- /dev/null
+++ b/hgraph.cabal
@@ -0,0 +1,123 @@
+-- Initial hgraph.cabal generated by cabal init. For further
+-- documentation, see http://haskell.org/cabal/users-guide/
+
+name: hgraph
+version: 1.2.0.0
+synopsis: Tools for working on (di)graphs.
+-- description:
+license: GPL-3
+license-file: LICENSE
+author: Marcelo Garlet Milani
+maintainer: marcelogmillani@gmail.com
+-- copyright:
+category: Data
+build-type: Simple
+extra-source-files: ChangeLog.md
+cabal-version: >=1.10
+
+library
+ exposed-modules: HGraph.Directed, HGraph.Directed.AdjacencyMap HGraph.Directed.Connectivity
+ HGraph.Directed.Load
+ HGraph.Directed.Output
+ HGraph.Directed.PathAnonymity
+ HGraph.Directed.Subgraph
+ HGraph.Undirected, HGraph.Undirected.AdjacencyMap
+ HGraph.Undirected.Solvers.VertexCover
+ HGraph.Undirected.Solvers.Treedepth
+ HGraph.Undirected.Solvers.IndependentSet
+ HGraph.Undirected.Generator
+ HGraph.Undirected.Expanders
+ HGraph.Undirected.Load
+ HGraph.Undirected.Layout.SpringModel
+ HGraph.Undirected.Output
+ other-modules: HGraph.Utils
+ default-extensions: TypeSynonymInstances, DoAndIfThenElse, GADTs
+ build-depends: base >=4.11 && <5, containers >= 0.5, happy-dot >= 0.1, transformers >= 0.5, mtl, random, linear >= 1.21, array >= 0.5
+ hs-source-dirs: src
+ default-language: Haskell2010
+
+source-repository head
+ type: git
+ location: git@gitlab.com:mgmillani/hgraph.git
+
+--library hgraph-lib
+-- exposed-modules: HGraph.Directed, HGraph.Directed.AdjacencyMap, HGraph.Directed.Connectivity
+-- HGraph.Directed.Load
+-- HGraph.Output
+-- HGraph.Undirected, HGraph.Undirected.AdjacencyMap
+-- HGraph.Undirected.Solvers.VertexCover
+-- HGraph.Undirected.Solvers.Treedepth
+-- HGraph.Undirected.Generator
+-- HGraph.Undirected.Expanders
+-- HGraph.Undirected.Load
+-- HGraph.Undirected.Layout.SpringModel
+-- -- other-modules:
+-- default-extensions: TypeSynonymInstances, DoAndIfThenElse, GADTs
+-- build-depends: base >=4.11 && <5, containers >= 0.5, happy-dot >= 0.1, transformers >= 0.5, mtl, random, linear >= 1.21, array >= 0.5
+-- hs-source-dirs: src
+-- default-language: Haskell2010
+
+
+--executable hgraph-viewer
+-- main-is: Main.hs
+-- other-modules: HGraph.Simulation HGraph.Geometry
+-- -- other-extensions:
+-- build-depends: base >=4.8 && <5, transformers >= 0.5, containers >= 0.5.9, directory >= 1.3, hgraph-lib, OpenGL >= 3.0, linear >= 1.21, bytestring >= 0.10, vector >= 0.11, sdl2 >= 2.1
+-- hs-source-dirs: viewer
+-- default-language: Haskell2010
+
+test-suite test-adjacency-map
+ main-is: AdjacencyMap.hs
+ hs-source-dirs: tests/Graph
+ type: exitcode-stdio-1.0
+ build-depends: base >=4.11 && <5, transformers >= 0.5, containers >= 0.5.9, HUnit >= 1.6, hgraph
+ default-language: Haskell2010
+
+test-suite test-vertex-cover
+ main-is: TestVertexCover.hs
+ hs-source-dirs: tests/Graph
+ type: exitcode-stdio-1.0
+ build-depends: base >=4.11 && <5, transformers >= 0.5, containers >= 0.5.9, HUnit >= 1.6, hgraph
+ default-language: Haskell2010
+
+Benchmark bench-vertex-cover
+ main-is: VertexCover.hs
+ hs-source-dirs: benchmarks
+ type: exitcode-stdio-1.0
+ build-depends: base >=4.11 && <5, containers >= 0.5, transformers >= 0.5, clock >= 0.7, hgraph, random
+ default-language: Haskell2010
+
+test-suite test-treedepth
+ main-is: Treedepth.hs
+ hs-source-dirs: tests/Graph
+ type: exitcode-stdio-1.0
+ build-depends: base >=4.11 && <5, transformers >= 0.5, containers >= 0.5.9, HUnit >= 1.6, hgraph
+ default-language: Haskell2010
+
+test-suite test-connectivity
+ main-is: Connectivity.hs
+ hs-source-dirs: tests/Digraph
+ type: exitcode-stdio-1.0
+ build-depends: base >=4.11 && <5, transformers >= 0.5, containers >= 0.5.9, HUnit >= 1.6, hgraph
+ default-language: Haskell2010
+
+test-suite test-path-anonymity
+ main-is: PathAnonymity.hs
+ hs-source-dirs: tests/Digraph
+ type: exitcode-stdio-1.0
+ build-depends: base >=4.11 && <5, transformers >= 0.5, containers >= 0.5.9, HUnit >= 1.6, hgraph
+ default-language: Haskell2010
+
+test-suite test-subgraph
+ main-is: Subgraph.hs
+ hs-source-dirs: tests/Digraph
+ type: exitcode-stdio-1.0
+ build-depends: base >=4.11 && <5, transformers >= 0.5, containers >= 0.5.9, HUnit >= 1.6, hgraph
+ default-language: Haskell2010
+
+test-suite test-load
+ main-is: Load.hs
+ hs-source-dirs: tests/Digraph
+ type: exitcode-stdio-1.0
+ build-depends: base >=4.11 && <5, transformers >= 0.5, containers >= 0.5.9, HUnit >= 1.6, hgraph
+ default-language: Haskell2010
diff --git a/src/HGraph/Directed.hs b/src/HGraph/Directed.hs
new file mode 100644
--- /dev/null
+++ b/src/HGraph/Directed.hs
@@ -0,0 +1,52 @@
+{-# LANGUAGE GADTs #-}
+
+module HGraph.Directed
+ ( DirectedGraph(..)
+ , Adjacency(..)
+ , Mutable(..)
+ )
+where
+
+import qualified Data.Map as M
+import qualified Data.Set as S
+
+class DirectedGraph t where
+ empty :: t a -> t a
+ vertices :: t a -> [a]
+ numVertices :: Integral b => t a -> b
+ numVertices d = fromIntegral $ length $ vertices d
+ arcs :: t a -> [(a,a)]
+ numArcs :: Integral b => t a -> b
+ numArcs d = fromIntegral $ length $ arcs d
+ linearizeVertices :: t a -> (t Int, [(Int, a)])
+ isVertex :: t a -> a -> Bool
+
+class Adjacency t where
+ outneighbors :: t a -> a -> [a]
+ inneighbors :: t a -> a -> [a]
+ outdegree :: Integral b => t a -> a -> b
+ outdegree d v = fromIntegral $ length $ outneighbors d v
+ indegree :: Integral b => t a -> a -> b
+ indegree d v = fromIntegral $ length $ inneighbors d v
+ arcExists :: t a -> (a,a) -> Bool
+ metaBfs :: Ord a => t a -> a -> ([a] -> [a]) -> ([a] -> [a]) -> [a]
+ metaBfs d v inFilter outFilter =
+ metaBfs' S.empty (S.fromList $ (inFilter $ inneighbors d v) ++ (outFilter $ outneighbors d v))
+ where
+ metaBfs' visited toVisit =
+ let vs = S.toList toVisit
+ newToVisit =
+ (S.unions $ map
+ (S.fromList .
+ (\v -> (inFilter $ inneighbors d v) ++ (outFilter $ outneighbors d v)))
+ vs
+ )
+ `S.difference` visited
+ in if S.null newToVisit then vs else vs ++ metaBfs' (S.union (S.fromList vs) visited) newToVisit
+
+class Mutable t where
+ addVertex :: a -> t a -> t a
+ removeVertex :: a -> t a -> t a
+ addArc :: (a,a) -> t a -> t a
+ removeArc :: (a,a) -> t a -> t a
+
diff --git a/src/HGraph/Directed/AdjacencyMap.hs b/src/HGraph/Directed/AdjacencyMap.hs
new file mode 100644
--- /dev/null
+++ b/src/HGraph/Directed/AdjacencyMap.hs
@@ -0,0 +1,51 @@
+module HGraph.Directed.AdjacencyMap
+ ( Digraph
+ , emptyDigraph
+ , module HGraph.Directed
+ )
+where
+
+import HGraph.Directed
+import qualified Data.Map as M
+import qualified Data.Set as S
+
+type DirectedNeighborhood a = (S.Set a, S.Set a)
+data Digraph a where
+ Digraph :: Ord a => M.Map a (DirectedNeighborhood a) -> Digraph a
+
+emptyDigraph :: Ord a => Digraph a
+emptyDigraph = Digraph M.empty
+
+instance DirectedGraph Digraph where
+ empty (Digraph d) = Digraph M.empty
+ numVertices (Digraph d) = fromIntegral $ M.size d
+ vertices (Digraph d) = M.keys d
+ arcs (Digraph d) = concatMap (\(v, (_,o)) -> [(v,u) | u <- S.toList o]) $ M.assocs d
+ isVertex (Digraph d) v = v `M.member` d
+ linearizeVertices g@(Digraph adj) = (g', assocs)
+ where
+ assocs = zip [0..] (M.keys adj)
+ ltoi = M.fromList $ zip (M.keys adj) [0..]
+ g' = foldr addArc (foldr addVertex emptyDigraph (map fst assocs)) $
+ [ (ltoi M.! u, ltoi M.! v) | (u,v) <- arcs g ]
+
+instance Adjacency Digraph where
+ outneighbors (Digraph d) v = S.toList $ snd $ d M.! v
+ inneighbors (Digraph d) v = S.toList $ fst $ d M.! v
+ arcExists (Digraph d) (v,u) = u `S.member` (snd $ d M.! v)
+
+instance Mutable Digraph where
+ addVertex v (Digraph d) =
+ Digraph (M.insertWith (\_ o -> o) v (S.empty, S.empty) d)
+ removeVertex v g@(Digraph d) =
+ let Digraph d' = foldr removeArc g
+ ( (map (\u -> (v,u)) $ outneighbors g v)
+ ++ (map (\u -> (u,v)) $ inneighbors g v))
+ in Digraph $ M.delete v d'
+
+ addArc (v,u) (Digraph d) =
+ Digraph ( M.adjust (\(i,o) -> (i, S.insert u o)) v
+ $ M.adjust (\(i,o) -> (S.insert v i, o)) u d)
+ removeArc (v,u) (Digraph d) =
+ Digraph ( M.adjust (\(i,o) -> (i, S.delete u o)) v
+ $ M.adjust (\(i,o) -> (S.delete v i, o)) u d)
diff --git a/src/HGraph/Directed/Connectivity.hs b/src/HGraph/Directed/Connectivity.hs
new file mode 100644
--- /dev/null
+++ b/src/HGraph/Directed/Connectivity.hs
@@ -0,0 +1,138 @@
+module HGraph.Directed.Connectivity
+ ( reachable
+ , allPaths
+ , allLinkages
+ , allMaximalPaths
+ , extendLinkage
+ , LinkageInstance(..)
+ , module F
+ , module IL
+ )
+where
+
+import Data.List
+import HGraph.Directed
+import HGraph.Directed.Connectivity.Flow as F
+import HGraph.Directed.Connectivity.IntegralLinkage as IL
+import qualified Data.Map as M
+import qualified Data.Set as S
+import Control.Monad
+
+--data LinkageInstance a =
+-- LinkageInstance
+-- { liTerminalPairs :: M.Map Int (a,a)
+-- , liCapacities :: M.Map a Int
+-- , liLinkage :: M.Map a (S.Set Int)
+-- }
+
+--extendLinkage d inst =
+-- case extendLinkage' $ M.keys $ liTerminalPairs inst of
+-- Nothing -> Nothing
+-- Just [] -> Just inst
+-- Just ext ->
+-- let link' = M.union (foldr (\(v,i) ->
+-- M.insertWith S.union v (S.singleton i))
+-- M.empty ext)
+-- (liLinkage inst)
+-- st' = M.union (M.fromList $ [ (i, (v, t))
+-- | (v,i) <- ext
+-- , let (s,t) = (liTerminalPairs inst) M.! i
+-- , v `elem` (outneighbors d s)
+-- ] ++
+-- [ (i, (s, v))
+-- | (v,i) <- ext
+-- , let (s,t) = (liTerminalPairs inst) M.! i
+-- , v `elem` (inneighbors d t)
+-- ]
+-- )
+-- (liTerminalPairs inst)
+-- in extendLinkage d inst{liTerminalPairs = st', liLinkage = link'}
+-- where
+-- extendLinkage' [] = Just []
+-- extendLinkage' (i:is)
+-- | s == t = extendLinkage' is
+-- | null cut = Nothing
+-- | not $ null $ drop 1 cut = extendLinkage' is
+-- | not $ i `S.member` ((liLinkage inst) M.! cv) = Just [(cv,i)]
+-- where
+-- (s,t) = (liTerminalPairs inst) M.! i
+-- d' = foldr removeVertex d
+-- [ v
+-- | (v,w) <- M.assocs $ liCapacities inst
+-- , (not $ i `elem` (liLinkage inst) M.! v) && w == (S.size $ (liLinkage inst) M.! v)
+-- ]
+-- cut = minCutI d' s t
+-- cv = head cut
+
+reachable d s t = t `elem` (metaBfs d s (\_ -> []) id)
+
+allPaths d s t = allPaths' S.empty s
+ where
+ allPaths' visited s
+ | s == t = [[t]]
+ | otherwise = do
+ v <- filter (\u -> not $ u `S.member` visited) $ outneighbors d s
+ fmap (s:) $ allPaths' (S.insert v visited) v
+
+allLinkages
+ :: (DirectedGraph t1, Adjacency t1, Eq b, Eq t2, Num t2)
+ => t1 b -> t2 -> b -> b -> [[[b]]]
+allLinkages d k s t = do
+ s0 <- choose k (outneighbors di si)
+ fmap (map ((s :) . map (iToV M.!))) $ allLinkages' s0 (S.fromList $ si : s0)
+ where
+ (di, itova) = linearizeVertices d
+ Just si = fmap fst $ find ((==s) . snd) itova
+ Just ti = fmap fst $ find ((==t) . snd) itova
+ iToV = M.fromList itova
+ allLinkages' si visited
+ | all (==ti) si = return $ map (:[]) si
+ | otherwise = do
+ (step, visited') <- linkageSteps di visited si ti
+ fmap (zipWith (:) si) $ allLinkages' step visited'
+
+linkageSteps d visited [] t = return ([], visited)
+linkageSteps d visited (v:vs) t = do
+ u <- if v == t then return v else filter (\u -> not $ S.member u visited) $ outneighbors d v
+ fmap (\(ws, visited') -> (u:ws, visited')) $ linkageSteps d (if u /= t then S.insert u visited else visited) vs t
+
+-- | All maximal paths on a digraph, represented as a list of vertices.
+-- | Cycles are also considered as maximal paths and their corresponding lists contain the initial vertex twice.
+allMaximalPaths d = map (map (iToV M.!)) $ allMaximalPaths' (vertices di) S.empty
+ where
+ (di, itova) = linearizeVertices d
+ iToV = M.fromList itova
+ allMaximalPaths' [] _ = []
+ allMaximalPaths' (v:vs) blocked = vPaths ++ allMaximalPaths' vs (S.insert v blocked)
+ where
+ vPaths = concatMap inExtensions $ uniPaths True outneighbors blocked v
+ uniPaths canClose neighborF visited u
+ | null nu && (null $ filter (`S.member` blocked) $ neighborF di u) = [[u]]
+ | null nu && null vCycle = []
+ | null nu = [[u, v]]
+ | otherwise = map (u:) $ vCycle ++ concatMap (uniPaths canClose neighborF (S.insert u visited)) nu
+ where
+ nu = filter (not . (`S.member` visited)) $ neighborF di u
+ vCycle
+ | not canClose = []
+ | v `elem` (neighborF di u) = [[v]]
+ | otherwise = []
+ inExtensions p
+ | p0 == pn && (not $ null $ drop 1 p) = [p] -- p is already a cycle
+ | otherwise = map combine $ uniPaths canClose inneighbors (foldr S.insert blocked p) v
+ where
+ canClose = null $ drop 1 p -- allow closing backwards cycles
+ combine q
+ | null q = []
+ | arcExists di (pn, q0) = pn : q' ++ p
+ | null q' = p
+ | otherwise = q' ++ p
+ where
+ q' = reverse $ tail q
+ q0 = last q
+ pn = last p
+ p0 = head p
+
+choose 0 _ = [[]]
+choose k [] = []
+choose k (x:xs) = map (x:) (choose (k - 1) xs) ++ choose k xs
diff --git a/src/HGraph/Directed/Load.hs b/src/HGraph/Directed/Load.hs
new file mode 100644
--- /dev/null
+++ b/src/HGraph/Directed/Load.hs
@@ -0,0 +1,54 @@
+module HGraph.Directed.Load
+ ( loadDot
+ , loadEdgeList
+ )
+where
+
+import HGraph.Directed
+import HGraph.Utils
+import qualified Language.Dot.Parser as D
+import qualified Language.Dot.Utils as D
+import qualified Language.Dot.Graph as D
+import qualified Data.Map as M
+import qualified Data.Set as S
+import Data.Maybe
+import Text.Read
+
+loadDot emptyD dotStr = do
+ dot <- D.parse dotStr
+ return $
+ let (ns, es) = D.adjacency dot
+ names = (S.toList $ S.fromList $ map getNodeName ns)
+ nid = M.fromList $ zip names ([0..] :: [Int])
+ idToStr = M.fromList $ zip ([0..] :: [Int]) names
+ addEdge (D.Edge v u _) d = addArc (nid M.! v, nid M.! u) d
+ getNodeName (D.Node name _) = name
+ nodeAttrMap = M.fromList [ (v, attrs) | D.Node v attrs <- ns]
+ edgeAttrMap = M.fromList [ ((v,u), attrs) | D.Edge v u attrs <- es]
+ in (foldr addEdge (foldr addVertex emptyD $ M.keys idToStr) es, nid, idToStr, nodeAttrMap, edgeAttrMap)
+
+loadEdgeList emptyD dStr
+ | null terms = return emptyD
+ | otherwise = do
+ nv <- fromMaybe (Left "Invalid number of vertices.") $ do
+ t0 <- mhead terms
+ n <- readMaybe t0
+ if n < 1 then Nothing else return $ Right n
+ ne <- fromMaybe (Left "Invalid number of edges.") $ do
+ t0 <- mhead $ drop 1 terms
+ e <- readMaybe t0
+ if e < 0 then Nothing else return $ Right e
+ es <- readEdges nv $ drop 2 terms
+ if ne /= (length es) then
+ Left $ "Expected " ++ (show ne) ++ " many edges, found " ++ (show $ length es) ++ "."
+ else
+ return $ foldr addArc (foldr addVertex emptyD [0..nv - 1]) es
+ where
+ terms = words dStr
+ readEdges _ [] = return []
+ readEdges _ [_] = Left "Missing tail of last edge."
+ readEdges nv (vStr:uStr:vs) = do
+ v <- fromMaybe (Left $ "Invalid vertex: " ++ vStr) $ fmap Right $ readMaybe vStr
+ u <- fromMaybe (Left $ "Invalid vertex: " ++ uStr) $ fmap Right $ readMaybe uStr
+ fmap ((v `mod` nv, u `mod` nv) : ) (readEdges nv vs)
+
diff --git a/src/HGraph/Directed/Output.hs b/src/HGraph/Directed/Output.hs
new file mode 100644
--- /dev/null
+++ b/src/HGraph/Directed/Output.hs
@@ -0,0 +1,43 @@
+module HGraph.Directed.Output
+ ( toDot
+ , DotStyle(..)
+ , defaultDotStyle
+ )
+where
+
+import HGraph.Directed
+import Data.List
+import qualified Data.Map as M
+
+data DotStyle a =
+ DotStyle
+ { graphName :: String
+ , everyNode :: [(String, String)]
+ , everyEdge :: [(String, String)]
+ , nodeAttributes :: M.Map a [(String, String)]
+ , edgeAttributes :: M.Map (a, a) [(String, String)]
+ }
+
+defaultDotStyle = DotStyle
+ { graphName = ""
+ , everyNode = []
+ , everyEdge = []
+ , nodeAttributes = M.empty
+ , edgeAttributes = M.empty
+ }
+
+toDot d style = concat
+ [ "digraph ", (graphName style), "{\n "
+ , if null $ everyNode style then "" else "node [" ++ attStr (everyNode style) ++ "];\n "
+ , if null $ everyEdge style then "" else "edge [" ++ attStr (everyEdge style) ++ "];\n "
+ , intercalate ";\n " (map showV $ vertices d), ";\n "
+ , intercalate ";\n " (map showA $ arcs d) , ";\n}"
+ ]
+ where
+ attStr xs = intercalate "," $ map (\(var,val) -> var ++ "=\"" ++ val ++ "\"") xs
+ showV v
+ | v `M.member` (nodeAttributes style) = show v ++ " [" ++ attStr ((nodeAttributes style) M.! v) ++ "]"
+ | otherwise = show v
+ showA (v,u)
+ | (v,u) `M.member` (edgeAttributes style) = show v ++ " -> " ++ show u ++ " [" ++ attStr ((edgeAttributes style) M.! (v,u)) ++ "]"
+ | otherwise = show v ++ " -> " ++ show u
diff --git a/src/HGraph/Directed/PathAnonymity.hs b/src/HGraph/Directed/PathAnonymity.hs
new file mode 100644
--- /dev/null
+++ b/src/HGraph/Directed/PathAnonymity.hs
@@ -0,0 +1,78 @@
+module HGraph.Directed.PathAnonymity
+ ( pathAnonymity
+ , pathAnonymityCertificate
+ , pathPathAnonymityI
+ )
+where
+
+import HGraph.Directed
+import HGraph.Directed.Connectivity
+import qualified Data.Map as M
+import qualified Data.Set as S
+import Data.List
+
+pathAnonymity d = snd $ pathAnonymityCertificate d
+
+-- | Path anonymity of a digraph together with a path witnessing
+-- | that the anonymity is at least the returned value.
+pathAnonymityCertificate d = (map (iToV M.!) p, k)
+ where
+ (p,k) = pathAnonymityCertificateI di
+ (di, itova) = linearizeVertices d
+ iToV = M.fromList itova
+
+pathAnonymityCertificateI di =
+ maximumBy (\(_,k1) (_,k2) -> compare k1 k2) $
+ map (\p -> (p, pathPathAnonymityI di p)) $
+ allMaximalPaths di
+
+-- | Path anonymity of a maximal path.
+-- | The path provided is assumed to be maximal.
+pathPathAnonymityI di p
+ | null $ drop 1 p = 0
+ | otherwise = numCriticalPaths p
+ where
+ ps = S.fromList p
+ pI = foldr (\(k,i) -> M.insertWith (\o _ -> o) k i) M.empty $ zip p [0..]
+ pr = reverse p
+ isCycle = take 1 p == take 1 pr
+ f0 = head p
+ mn
+ | isCycle = head $ drop 1 pr
+ | otherwise = head pr
+ m0 = take 1 $ dropWhile (\v -> null $ filter (not . (`S.member` ps)) (inneighbors di v)) p
+ fn = take 1 $ dropWhile (\v -> null $ filter (not . (`S.member` ps)) (outneighbors di v)) $
+ (if isCycle then tail else id) $ pr
+ vF
+ | isCycle && ((not $ null fn) || (not $ null m0)) =
+ S.fromList $ fn ++ (mn : f0 : map fst shortcutPairs)
+ | otherwise = S.fromList $ fn ++ (f0 : map fst shortcutPairs)
+ vM
+ | isCycle && ((not $ null m0) || (not $ null fn)) =
+ S.fromList $ m0 ++ (f0 : mn : map snd shortcutPairs)
+ | otherwise = S.fromList $ m0 ++ (mn : map snd shortcutPairs)
+ shortcuts v = filter (\(u,w) -> pI M.! u < pI M.! w) $ shortcuts' di ps v
+ shortcutPairs = concatMap (\v -> shortcuts v ++ directShortcuts v) p
+ directShortcuts v = filter (\(u,w) -> pI M.! u + 1 < pI M.! w) $ directShortcuts' di ps v
+ numCriticalPaths = numCriticalPaths' vF vM
+
+numCriticalPaths' _ _ [] = 0
+numCriticalPaths' vF vM (_:vs)
+ | null vm = 0
+ | otherwise = 1 + numCriticalPaths' vF vM vs'
+ where
+ vm = dropWhile (not . (`S.member` vM)) vs
+ vs' = dropWhile (not . (`S.member` vF)) vm
+
+shortcuts' di blocked v =
+ [ (v,w)
+ | u <- us
+ , w <- filter (`S.member` blocked) $ outneighbors di u
+ ]
+ where
+ us = metaBfs di v (\_ -> []) (filter (not . (`S.member` blocked)))
+
+directShortcuts' di blocked v = [ (v,w)
+ | w <- outneighbors di v
+ , w `S.member` blocked
+ ]
diff --git a/src/HGraph/Directed/Subgraph.hs b/src/HGraph/Directed/Subgraph.hs
new file mode 100644
--- /dev/null
+++ b/src/HGraph/Directed/Subgraph.hs
@@ -0,0 +1,74 @@
+module HGraph.Directed.Subgraph
+ ( contains
+ , isSubgraphOf
+ , subgraphIsomorphism
+ , subgraphIsomorphismI
+ , isSubgraphIsomorphism
+ )
+where
+
+import HGraph.Directed
+import HGraph.Utils
+import qualified Data.Map as M
+import qualified Data.Set as S
+import Data.Maybe
+
+-- | Whether `d` contains `h` as a subgraph (the identity is used for the isomorphism).
+contains d h = null $
+ [ v
+ | v <- vertices h
+ , u <- outneighbors h v
+ , not $ arcExists d (v,u)
+ ] ++
+ filter (not . isVertex d) (vertices h)
+
+
+-- | Whether `h` is isomorphic to some subgraph of `d`.
+isSubgraphOf h d = isJust $ subgraphIsomorphism d h
+
+-- | Find an isomorphism from `h` to some subgraph of `d`, if it exists.
+subgraphIsomorphism d h = fmap (M.mapKeys (iToV M.!)) $ subgraphIsomorphismI d hi
+ where
+ (hi, itova) = linearizeVertices h
+ iToV = M.fromList itova
+
+subgraphIsomorphismI d hi = findIso (vertices hi) M.empty candidates0
+ where
+ candidates0 = M.fromList
+ [ (v, S.fromList us)
+ | v <- vertices hi
+ , let ov = outdegree hi v
+ , let iv = indegree hi v
+ , let us = filter (\u -> outdegree d u >= ov && indegree d u >= iv) $ vertices d
+ ]
+ findIso [] phi _ = Just phi
+ findIso (v:vs) phi candidates = mhead $ map fromJust $ filter isJust $ do
+ u <- S.toList $ candidates M.! v
+ let phi' = M.insert v u phi
+ let candidates' = M.map (S.delete u) $ M.delete v $
+ foldr (uncurry $ M.insertWith (\n o -> S.intersection n o) )
+ candidates $
+ [ (w, S.fromList $ outneighbors d u)
+ | w <- outneighbors hi v
+ ] ++
+ [ (w, S.fromList $ inneighbors d u)
+ | w <- inneighbors hi v
+ ]
+ if null $ M.filter S.null candidates' then
+ return $ findIso vs phi' candidates'
+ else
+ []
+
+-- | Whether `phi` is a subgraph isomorphism from `h` to some subgraph of `d`.
+isSubgraphIsomorphism d h phi = null
+ [ v
+ | v <- vertices h
+ , u <- outneighbors h v
+ , isNothing $ do
+ dv <- M.lookup v phi
+ du <- M.lookup u phi
+ if arcExists d (dv,du) then
+ return ()
+ else
+ Nothing
+ ]
diff --git a/src/HGraph/Undirected.hs b/src/HGraph/Undirected.hs
new file mode 100644
--- /dev/null
+++ b/src/HGraph/Undirected.hs
@@ -0,0 +1,55 @@
+{-# LANGUAGE GADTs #-}
+
+module HGraph.Undirected
+ ( UndirectedGraph(..)
+ , Adjacency(..)
+ , Mutable(..)
+ )
+where
+
+import qualified Data.Set as S
+
+class UndirectedGraph t where
+ empty :: t a -> t a
+ vertices :: t a -> [a]
+ numVertices :: Integral b => t a -> b
+ numVertices d = fromIntegral $ length $ vertices d
+ edges :: t a -> [(a,a)]
+ numEdges :: Integral b => t a -> b
+ numEdges d = fromIntegral $ length $ edges d
+ linearizeVertices :: t a -> (t Int, [(Int, a)])
+
+class UndirectedGraph t => Adjacency t where
+ neighbors :: t a -> a -> [a]
+ degree :: Integral b => t a -> a -> b
+ edgeExists :: t a -> (a,a) -> Bool
+ inducedSubgraph :: t a -> [a] -> t a
+ metaBfs :: Ord a => t a -> a -> ([a] -> [a]) -> [a]
+ metaBfs d v nFilter =
+ v : metaBfs' (S.singleton v) (S.fromList $ (nFilter $ neighbors d v))
+ where
+ metaBfs' visited toVisit =
+ let vs = S.toList toVisit
+ newToVisit =
+ (S.unions $ map
+ (S.fromList .
+ (\v -> (nFilter $ neighbors d v)))
+ vs
+ )
+ `S.difference` visited
+ in if S.null newToVisit then vs else vs ++ metaBfs' (S.union (S.fromList vs) visited) newToVisit
+ connectedComponents :: Ord a => t a -> [[a]]
+ connectedComponents g = cc (vertices g) S.empty
+ where
+ cc [] _ = []
+ cc (v:vs) visited
+ | v `S.member` visited = cc vs visited
+ | otherwise = component : cc vs (S.union visited $ S.fromList component)
+ where
+ component = metaBfs g v id
+
+class Mutable t where
+ addVertex :: t a -> a -> t a
+ removeVertex :: t a -> a -> t a
+ addEdge :: t a -> (a,a) -> t a
+ removeEdge :: t a -> (a,a) -> t a
diff --git a/src/HGraph/Undirected/AdjacencyMap.hs b/src/HGraph/Undirected/AdjacencyMap.hs
new file mode 100644
--- /dev/null
+++ b/src/HGraph/Undirected/AdjacencyMap.hs
@@ -0,0 +1,58 @@
+{-# LANGUAGE GADTs #-}
+
+module HGraph.Undirected.AdjacencyMap
+ ( Graph
+ , emptyGraph
+ , module HGraph.Undirected
+ )
+where
+
+import HGraph.Undirected
+import qualified Data.Map as M
+import qualified Data.Set as S
+
+data Graph a where
+ Graph :: Ord a => M.Map a (S.Set a) -> Int -> Graph a
+
+emptyGraph :: Ord a => Graph a
+emptyGraph = Graph M.empty 0
+
+instance UndirectedGraph Graph where
+ empty (Graph _ _) = Graph M.empty 0
+ vertices (Graph adj _) = M.keys adj
+ numVertices (Graph adj _) = fromIntegral $ M.size adj
+ edges (Graph adj _) = [(v,u) | (v, nv) <- M.assocs adj, u <- S.toList nv, u >= v]
+ numEdges (Graph _ numE) = fromIntegral $ numE
+ linearizeVertices g@(Graph adj _) = (g', assocs)
+ where
+ assocs = zip [0..] (M.keys adj)
+ ltoi = M.fromList $ zip (M.keys adj) [0..]
+ g' = foldr (flip addEdge) (foldr (flip addVertex) emptyGraph (map fst assocs)) $
+ [ (ltoi M.! u, ltoi M.! v) | (u,v) <- edges g ]
+
+
+instance Adjacency Graph where
+ neighbors (Graph adj _) v = S.toList $ adj M.! v
+ degree (Graph adj _) v = fromIntegral $ S.size $ adj M.! v
+ edgeExists (Graph adj _) (v,u) = u `S.member` (adj M.! v)
+ inducedSubgraph (Graph adj numE) vs = Graph adj' $ (M.foldl' (\s n -> s + S.size n) 0 adj') `div` 2
+ where
+ adj' = M.map (\n -> S.intersection n svs) $ M.restrictKeys adj svs
+ svs = S.fromList vs
+
+instance Mutable Graph where
+ addVertex (Graph adj nE) v = Graph (M.insert v S.empty adj) nE
+ removeVertex g@(Graph adj nE) v =
+ Graph (M.delete v $ foldr (M.adjust (S.delete v)) adj nv) (nE - (degree g v))
+ where
+ nv = neighbors g v
+ addEdge g@(Graph adj nE) (v,u)
+ | edgeExists g (v,u) = g
+ | otherwise = Graph adj' (nE + 1)
+ where
+ adj' = M.insertWith S.union v (S.singleton u) $ M.insertWith S.union u (S.singleton v) adj
+ removeEdge g@(Graph adj nE) (v,u)
+ | not $ edgeExists g (v,u) = g
+ | otherwise = Graph adj' (nE - 1)
+ where
+ adj' = M.adjust (S.delete u) v $ M.adjust (S.delete v) u adj
diff --git a/src/HGraph/Undirected/Expanders.hs b/src/HGraph/Undirected/Expanders.hs
new file mode 100644
--- /dev/null
+++ b/src/HGraph/Undirected/Expanders.hs
@@ -0,0 +1,31 @@
+module HGraph.Undirected.Expanders
+ ( edgeExpansion
+ , vertexExpansion
+ )
+where
+
+import HGraph.Undirected
+import qualified Data.Map as M
+
+edgeExpansion :: (UndirectedGraph g, Adjacency g) => g a -> (Double, [a])
+-- | Edge expansion of a graph, together with a set of verticies certifying that the expansion is not greater.
+edgeExpansion g = (expansion, cert)
+ where
+ (expansion, cert') = edgeExpansion' (numVertices gi `div` 2) (vertices gi) []
+ cert = map (idT M.!) cert'
+ (gi, itol) = linearizeVertices g
+ idT = M.fromList itol
+ edgeExpansion' budget [] [] = (fromIntegral $ numVertices gi, [])
+ edgeExpansion' budget [] as = (fromIntegral e / (fromIntegral $ length as), as)
+ where
+ e = sum [degree gi v | v <- as]
+ edgeExpansion' 0 _ as = edgeExpansion' 0 [] as
+ edgeExpansion' budget (v:vs) as = (e, c)
+ where
+ (e0,c0) = edgeExpansion' (budget - 1) vs (v : as)
+ (e1,c1) = edgeExpansion' budget vs as
+ (e,c) = if e0 < e1 then (e0,c0) else (e1,c1)
+
+vertexExpansion :: (Adjacency g) => g a -> (Double, [a])
+-- | Vertex expansion of a graph, together with a set of verticies certifying that the expansion is not greater.
+vertexExpansion g = (0,[])
diff --git a/src/HGraph/Undirected/Generator.hs b/src/HGraph/Undirected/Generator.hs
new file mode 100644
--- /dev/null
+++ b/src/HGraph/Undirected/Generator.hs
@@ -0,0 +1,67 @@
+module HGraph.Undirected.Generator
+ ( grid
+ , cycleGraph
+ , completeTree
+ , completeGraph
+ , randomGraph
+ )
+where
+
+import HGraph.Undirected
+import Data.List
+import Control.Monad.State
+import System.Random
+
+cycleGraph g0 n = foldr (flip addEdge) (foldr (flip addVertex) g0 [0..n-1]) [(x, (x + 1) `mod` n) | x <- [0..n-1]]
+
+grid g0 w h = foldr (flip addEdge) (foldr (flip addVertex) g0 vs) es
+ where
+ vs = [(x,y) | x <- [1..w], y <- [1..h]]
+ es = concat [[(v,(x+1,y)), (v, (x,y+1))] | x <- [1..w-1], y <- [1..h-1], let v = (x,y)]
+ ++ [((x, h), (x+1, h)) | x <- [1..w-1]]
+ ++ [((w, y), (w, y+1)) | y <- [1..h-1]]
+
+completeTree g0 depth arity = completeTree' (addVertex (empty g0) 0) 0 1
+ where
+ completeTree' g root d
+ | d > depth = g
+ | otherwise = head $ drop arity $
+ iterate' (\h -> let r1 = numVertices h
+ in addEdge (completeTree' (addVertex h r1) r1 (d+1) ) (root,r1)) g
+
+completeGraph g0 k = foldr (flip addEdge) (foldr (flip addVertex) (empty g0) [0..k-1]) [(u,v) | u <- [0..k-1], v <- [u+1..k-1] ]
+
+randomGraph g0 n m
+ | m > (n * (n - 1)) `div` 4 = do -- dense graph
+ let g1 = foldr (flip addEdge) (foldr (flip addVertex) (empty g0) [1..n]) [(v,u) | v <- [1..n], u <- [v+1..n]]
+ removeRandomEdges g1 m
+ | otherwise = do -- spare graph
+ let g1 = foldr (flip addVertex) (empty g0) [0..n-1]
+ addRandomEdges g1 m
+
+addRandomEdges g m
+ | numEdges g == m = return g
+ | otherwise = do
+ v <- randomN 0 (numVertices g - 1)
+ u <- randomN 0 (numVertices g - 1)
+ if u /= v then
+ addRandomEdges (addEdge g (v,u)) m
+ else
+ addRandomEdges g m
+
+removeRandomEdges g m
+ | numEdges g == m = return g
+ | otherwise = do
+ v <- randomN 0 (numVertices g - 1)
+ u <- randomN 0 (numVertices g - 1)
+ if u /= v && edgeExists g (v,u) then
+ removeRandomEdges (removeEdge g (v,u)) m
+ else
+ removeRandomEdges g m
+
+randomN :: (Random a, RandomGen g) => a -> a -> State g a
+randomN n0 n1 = do
+ gen <- get
+ let (r,gen') = randomR (n0,n1) gen
+ put gen'
+ return r
diff --git a/src/HGraph/Undirected/Layout/SpringModel.hs b/src/HGraph/Undirected/Layout/SpringModel.hs
new file mode 100644
--- /dev/null
+++ b/src/HGraph/Undirected/Layout/SpringModel.hs
@@ -0,0 +1,75 @@
+module HGraph.Undirected.Layout.SpringModel
+ (setup, step, positions)
+where
+
+import HGraph.Undirected
+import qualified Data.Array.Unboxed as U
+import qualified Data.Map as M
+import Data.Foldable
+import Linear
+
+data SpringModel g a =
+ SpringModel
+ { smGraph :: g Int
+ , smPoints :: U.Array Int (V2 Double)
+ , smVelocities :: U.Array Int (V2 Double)
+ , smSpringStrength :: Double
+ , smRepulsionStrength :: Double
+ , smFriction :: Double
+ , smCenterAttractionStrength :: Double
+ , smIndexToLabel :: M.Map Int a
+ }
+
+setup centerAttraction springStrength repulsiveStrength friction gr =
+ let (gi, itol) = linearizeVertices gr
+ n = numVertices gi - 1
+ in SpringModel
+ { smGraph = gi
+ , smPoints = U.array (0, n) $ zip [0..n] (repeat 0)
+ , smVelocities = U.array (0, n) $ zip [0..n] (repeat 0)
+ , smSpringStrength = springStrength
+ , smRepulsionStrength = repulsiveStrength
+ , smFriction = friction
+ , smCenterAttractionStrength = centerAttraction
+ , smIndexToLabel = M.fromList itol
+ }
+
+step dt layout = layout{smPoints = points', smVelocities = velocities'}
+ where
+ points = smPoints layout
+ velocities = smVelocities layout
+ points' = U.array (U.bounds points)
+ [ (i, (points U.! i) + (velocities U.! i))
+ | i <- U.indices points
+ ]
+ velocities' = U.array (U.bounds points)
+ [ (i, ((smFriction layout) ** dt) *^ (velocities U.! i) + (accelerate layout i))
+ | i <- U.indices $ points]
+
+accelerate layout v = springV ^+^ centerV ^+^ pushV
+ where
+ positions = smPoints layout
+ pv = positions U.! v
+ springV = sum
+ [ du ^* (smSpringStrength layout)
+ | u <- neighbors (smGraph layout) v
+ , let pu = positions U.! u
+ , let du = pu ^-^ pv
+ ]
+ centerV = (negated pv) ^* (smCenterAttractionStrength layout)
+ pushV = sum
+ [ if d2 < 0.0001 then
+ (100 * smRepulsionStrength layout) *^ (angle $ 2*pi * ((fromIntegral v) / (fromIntegral $ U.rangeSize $ U.bounds positions)))
+ else
+ ((du ^/ (sqrt d2)) ^* (smRepulsionStrength layout)) ^/ d2
+ | u <- vertices $ smGraph layout
+ , let pu = positions U.! u
+ , let du = pv ^-^ pu
+ , let d2 = foldl' (\s x -> s + x*x) 0 du
+ , u /= v
+ ]
+
+positions layout =
+ [ (smIndexToLabel layout M.! i, (smPoints layout) U.! i)
+ | i <- U.indices $ smPoints layout
+ ]
diff --git a/src/HGraph/Undirected/Load.hs b/src/HGraph/Undirected/Load.hs
new file mode 100644
--- /dev/null
+++ b/src/HGraph/Undirected/Load.hs
@@ -0,0 +1,20 @@
+module HGraph.Undirected.Load
+ ( loadDot
+ )
+where
+
+import HGraph.Undirected
+import Language.Dot.Parser as D
+import Language.Dot.Utils as D
+import Language.Dot.Graph as D
+import qualified Data.Map as M
+import qualified Data.Set as S
+
+loadDot gr dotStr = do
+ dot <- D.parse dotStr
+ return $
+ let (ns, es) = D.adjacency dot
+ names = (S.toList $ S.fromList $ map getNodeName ns)
+ addE (D.Edge v u _) d = addEdge d (v, u)
+ getNodeName (D.Node name _) = name
+ in foldr addE (foldr (flip addVertex) gr names) es
diff --git a/src/HGraph/Undirected/Output.hs b/src/HGraph/Undirected/Output.hs
new file mode 100644
--- /dev/null
+++ b/src/HGraph/Undirected/Output.hs
@@ -0,0 +1,11 @@
+module HGraph.Undirected.Output
+ ( toDot
+ )
+where
+
+import HGraph.Undirected
+import Data.List
+
+toDot g = "graph {\n "
+ ++ intercalate ";\n " (map show $ vertices g) ++ ";\n"
+ ++ intercalate ";\n " (map (\(v,u) -> show v ++ " -- " ++ show u) $ edges g) ++ ";\n}"
diff --git a/src/HGraph/Undirected/Solvers/IndependentSet.hs b/src/HGraph/Undirected/Solvers/IndependentSet.hs
new file mode 100644
--- /dev/null
+++ b/src/HGraph/Undirected/Solvers/IndependentSet.hs
@@ -0,0 +1,46 @@
+module HGraph.Undirected.Solvers.IndependentSet
+ ( maximize
+ , atLeast
+ , reduce
+ )
+where
+
+import Data.Maybe
+import HGraph.Undirected
+import HGraph.Utils
+
+-- | Find a maximum independet set in `g`
+maximize g = last [fromJust x | k <- [1..numVertices g], let x = atLeast g k, isJust x]
+
+-- | Search for an independent set of size at least `k` in `g`
+atLeast g k
+ | k <= 0 = Just []
+ | numVertices g == 0 = Nothing
+ | otherwise =
+ let (g', xs, k') = reduce g k
+ in
+ if k' >= k then
+ Just xs
+ else
+ fmap (xs ++) $
+ mhead [ u : fromJust ys
+ | u <- vertices g'
+ , let ys = atLeast (foldr (flip removeVertex) g' $ u : neighbors g' u) (k - 1 - k')
+ , isJust ys]
+
+reduce g k
+ | k <= 0 = (g, [], 0)
+ | k > (numVertices g) || (k == (numVertices g) && numEdges g > 0) = (empty g, [], 0)
+ | otherwise =
+ let xs0 = filter (\v -> degree g v == 0) $ vertices g
+ xsn = filter (\v -> degree g v >= (numVertices g) - k + 1) $ vertices g
+ g' = foldr (flip removeVertex) g (xsn ++ xs0)
+ x1 = take 1 $ filter (\v -> degree g' v == 1) $ vertices g'
+ in case x1 of
+ [v] ->
+ let k0 = length xs0
+ g'' = foldr (flip removeVertex) g' $ v : neighbors g' v
+ (g''', xs', k') = reduce g'' (k - k0 - 1)
+ in (g''', v:xs0 ++ xs', 1 + k0 + k')
+ [] -> (g', xs0, length xs0)
+
diff --git a/src/HGraph/Undirected/Solvers/Treedepth.hs b/src/HGraph/Undirected/Solvers/Treedepth.hs
new file mode 100644
--- /dev/null
+++ b/src/HGraph/Undirected/Solvers/Treedepth.hs
@@ -0,0 +1,88 @@
+module HGraph.Undirected.Solvers.Treedepth
+ ( optimalDecomposition
+ , treedepthAtMost
+ , isDecomposition
+ , Decomposition(..)
+ )
+where
+
+import HGraph.Undirected
+import qualified Data.Map as M
+import qualified Data.Set as S
+import Data.Maybe
+import Data.List
+import Control.Monad
+
+data Decomposition a =
+ Decomposition
+ { ancestor :: M.Map a a
+ , children :: M.Map a (S.Set a)
+ , depth :: Int
+ , roots :: [a]
+ }
+ deriving (Eq)
+
+
+
+optimalDecomposition g = fromJust $ foldr mplus Nothing $ map (treedepthAtMost g) [1..]
+
+treedepthAtMost _ 0 = Nothing
+treedepthAtMost g k
+ | any isNothing ts = Nothing
+ | otherwise = Just $ foldl' (\t0 t1 ->
+ Decomposition{ ancestor = M.union (ancestor t0) (ancestor t1)
+ , children = M.union (children t0) (children t1)
+ , depth = max (depth t0) (depth t1)
+ , roots = (roots t1) ++ (roots t0)
+ }) emptyDecomposition
+ $ map fromJust ts
+ where
+ gs = map (inducedSubgraph g) $ connectedComponents g
+ ts = map (\g -> treedepthAtMost' g k) gs
+
+treedepthAtMost' g 0 = Nothing
+treedepthAtMost' g 1
+ | numVertices g == 1 = Just $ emptyDecomposition { depth = 1, roots = vertices g }
+ | otherwise = Nothing
+treedepthAtMost' g k = foldr mplus Nothing $ map guess $ vertices g
+ where
+ guess v = fmap (addRoot v) td
+ where
+ td = treedepthAtMost (removeVertex g v) (k - 1)
+
+isDecomposition g td =
+ all (\(v,u) -> v `S.member` (ancestors M.! u) || u `S.member` (ancestors M.! v)) $
+ edges g
+ where
+ ancestors = M.fromList [ (v, S.fromList $ ancestry v) | v <- vertices g]
+ ancestry v
+ | isNothing mu = []
+ | otherwise = u : ancestry u
+ where
+ mu = v `M.lookup` (ancestor td)
+ Just u = mu
+
+emptyDecomposition = Decomposition { ancestor = M.empty, children = M.empty, roots = [], depth = 0 }
+
+addRoot r td = Decomposition{ ancestor = a' `M.union` ancestor td
+ , children = c' `M.union` children td
+ , depth = 1 + depth td
+ , roots = [r]
+ }
+ where
+ a' = M.fromList $ zip (roots td) (repeat r)
+ c' = M.singleton r (S.fromList $ roots td)
+
+showTd td = concatMap (showTd' "") (roots td)
+ where
+ showTd' indent v = indent ++ show v ++ "\n" ++ rs
+ where
+ mcs = M.lookup v (children td)
+ Just cs = mcs
+ rs
+ | isNothing mcs = ""
+ | otherwise = concatMap (showTd' ('-':indent)) (S.toList cs)
+
+instance (Ord a, Show a) => Show (Decomposition a) where
+ show = showTd
+
diff --git a/src/HGraph/Undirected/Solvers/VertexCover.hs b/src/HGraph/Undirected/Solvers/VertexCover.hs
new file mode 100644
--- /dev/null
+++ b/src/HGraph/Undirected/Solvers/VertexCover.hs
@@ -0,0 +1,56 @@
+module HGraph.Undirected.Solvers.VertexCover
+ ( minimumVertexCover
+ , vertexCoverAtMost
+ )
+where
+
+import HGraph.Undirected
+import Control.Monad
+import Data.Maybe
+import qualified Data.Map as M
+import qualified Data.Set as S
+
+minimumVertexCover :: (Mutable t, UndirectedGraph t, Adjacency t) => t a -> [a]
+minimumVertexCover g = map (itol M.!) $ fromJust $ foldr mplus Nothing $ map (vertexCoverAtMost' gi) [1..]
+ where
+ (gi, assocs) = linearizeVertices g
+ itol = M.fromList assocs
+
+vertexCoverAtMost :: (Mutable t, UndirectedGraph t, Adjacency t) => t a -> Int -> Maybe [a]
+vertexCoverAtMost g k = fmap (map (itol M.!)) $ vertexCoverAtMost' gi k
+ where
+ (gi, assocs) = linearizeVertices g
+ itol = M.fromList assocs
+
+vertexCoverAtMost' :: (Mutable t, UndirectedGraph t, Adjacency t) => t Int -> Int -> Maybe [Int]
+vertexCoverAtMost' g k
+ | k < 0 = Nothing
+ | k' < 0 = Nothing
+ | numEdges g' == 0 = Just sol'
+ | numEdges g' > k * k = Nothing
+ | otherwise =
+ (fmap (v:) $ vertexCoverAtMost' (removeVertex g' v) (k'-1)) `mplus`
+ (fmap (nv++) $ vertexCoverAtMost' (foldr (flip removeVertex) g' (v:nv)) (k' - (degree g' v)))
+ where
+ (g', sol', k') = reduce g k
+ e' = edges g'
+ (v,_) = head e'
+ nv = neighbors g' v
+
+reduce g k = reduce' g k [] (vertices g) S.empty
+
+reduce' g k sol [] _ = (g,sol,k)
+reduce' g k sol (v:vs) visited
+ | v `S.member` visited = reduce' g k sol vs visited
+ | d == 1 = reduce' (removeVertex (removeVertex g v) u) (k-1) (u:sol) (un ++ vs)
+ ( (S.insert v $ S.insert u visited) `S.difference`
+ (S.delete v $ S.fromList un))
+ | d == 0 = reduce' (removeVertex g v) k sol vs (S.insert v visited)
+ | d > k = reduce' (removeVertex g v) (k - 1) (v:sol) (vn ++ vs)
+ ((S.insert v visited) `S.difference` (S.fromList vn))
+ | otherwise = reduce' g k sol vs (S.insert v visited)
+ where
+ d = degree g v
+ u = head $ neighbors g v
+ un = neighbors g u
+ vn = neighbors g v
diff --git a/src/HGraph/Utils.hs b/src/HGraph/Utils.hs
new file mode 100644
--- /dev/null
+++ b/src/HGraph/Utils.hs
@@ -0,0 +1,4 @@
+module HGraph.Utils where
+
+mhead [] = Nothing
+mhead (x:_) = Just x
diff --git a/tests/Digraph/Connectivity.hs b/tests/Digraph/Connectivity.hs
new file mode 100644
--- /dev/null
+++ b/tests/Digraph/Connectivity.hs
@@ -0,0 +1,96 @@
+module Main where
+
+import HGraph.Directed
+import HGraph.Directed.Connectivity
+import qualified HGraph.Directed.AdjacencyMap as AM
+import qualified Data.Set as S
+
+import Test.HUnit hiding (Node)
+import System.Exit (exitFailure, exitSuccess)
+
+v1 = 1 :: Int
+
+tests = TestList
+ [ TestLabel "Maximal paths 1" $ TestCase
+ ( do
+ let d = addVertex v1 AM.emptyDigraph
+ ps = allMaximalPaths d
+ assertEqual "Paths"
+ [[1]]
+ ps
+ )
+ , TestLabel "Maximal paths 2" $ TestCase
+ ( do
+ let d = foldr addArc (foldr addVertex AM.emptyDigraph [v1,2]) [(1,2)]
+ ps = allMaximalPaths d
+ assertEqual "Paths"
+ [[1,2]]
+ ps
+ )
+ , TestLabel "Maximal paths 3" $ TestCase
+ ( do
+ let d = foldr addArc (foldr addVertex AM.emptyDigraph [v1,2,3,4,5]) [(1,2), (2,3), (3,4), (4,5)]
+ ps = allMaximalPaths d
+ assertEqual "Paths"
+ [[1,2,3,4,5]]
+ ps
+ )
+ , TestLabel "Maximal paths 4" $ TestCase
+ ( do
+ let d = foldr addArc (foldr addVertex AM.emptyDigraph [v1,2,3,4]) $ zip [1,2,3,4] [2,3,4,1]
+ ps = allMaximalPaths d
+ assertEqual "Paths"
+ (S.fromList $ [ arcSet [1,2,3,4,1]])
+ (S.fromList $ map arcSet ps)
+ )
+ , TestLabel "Maximal paths 5" $ TestCase
+ ( do
+ let d = foldr addArc (foldr addVertex AM.emptyDigraph [v1,2,3,4,5]) $ zip [1,2,5,5] [5,5,3,4]
+ ps = allMaximalPaths d
+ assertEqual "Paths"
+ (S.fromList [[1,5,3], [2,5,3], [1,5,4], [2,5,4]])
+ (S.fromList ps)
+ )
+ , TestLabel "Maximal paths 6" $ TestCase
+ ( do
+ let d = foldr addArc (foldr addVertex AM.emptyDigraph [v1,2,3]) $
+ [ (v,u)
+ | v <- [1..3]
+ , u <- [1..3]
+ , u /= v
+ ]
+ ps = allMaximalPaths d
+ assertEqual "Paths"
+ (S.fromList $ map arcSet
+ [ [1,2,1], [1,3,1]
+ , [1,2,3,1], [1,3,2,1]
+ , [2,3,2]
+ ]
+ )
+ (S.fromList $ map arcSet ps)
+ )
+ , TestLabel "Maximal paths 7" $ TestCase
+ ( do
+ let d = foldr addArc (foldr addVertex AM.emptyDigraph [0,1,2,3,4]) $
+ [ (0,1), (0,2), (0,4)
+ , (1,0), (2,1), (2,4)
+ , (3,1), (3,2), (3,4)
+ , (4,0)
+ ]
+ ps = allMaximalPaths d
+ assertEqual "Paths"
+ (S.fromList $ map arcSet
+ [ [3,2,4,0,1], [3,4,0,1]
+ , [3,4,0,2,1], [3,1,0,2,4]
+ , [3,2,1,0,4], [3,1,0,4]
+ ]
+ )
+ (S.fromList $ map arcSet ps)
+ )
+ ]
+
+arcSet p = S.fromList $ zip p $ tail p
+
+main = do
+ count <- runTestTT tests
+ if errors count + failures count > 0 then exitFailure else exitSuccess
diff --git a/tests/Digraph/Load.hs b/tests/Digraph/Load.hs
new file mode 100644
--- /dev/null
+++ b/tests/Digraph/Load.hs
@@ -0,0 +1,56 @@
+module Main where
+
+import HGraph.Directed
+import HGraph.Directed.Load
+import qualified HGraph.Directed.AdjacencyMap as AM
+import qualified Data.Set as S
+import Data.Either
+
+import Test.HUnit hiding (Node)
+import System.Exit (exitFailure, exitSuccess)
+
+tests = TestList
+ [ TestLabel "Digraph 0" $ TestCase
+ ( do
+ let ed = loadEdgeList AM.emptyDigraph "1 0"
+ Right d = ed
+ assertBool "Is right"
+ (isRight ed)
+ assertEqual "Vertices"
+ [0]
+ (vertices d)
+ assertEqual "Arcs"
+ []
+ (arcs d)
+ )
+ , TestLabel "Digraph 1" $ TestCase
+ ( do
+ let ed = loadEdgeList AM.emptyDigraph "2 1 0 1"
+ Right d = ed
+ assertBool "Is right"
+ (isRight ed)
+ assertEqual "Vertices"
+ [0,1]
+ (vertices d)
+ assertEqual "Arcs"
+ [(0,1)]
+ (arcs d)
+ )
+ , TestLabel "Digraph 2" $ TestCase
+ ( do
+ let ed = loadEdgeList AM.emptyDigraph "4 2 0 1 1 0"
+ Right d = ed
+ assertBool "Is right"
+ (isRight ed)
+ assertEqual "Vertices"
+ [0,1,2,3]
+ (vertices d)
+ assertEqual "Arcs"
+ (S.fromList [(0,1), (1,0)])
+ (S.fromList $ arcs d)
+ )
+ ]
+
+main = do
+ count <- runTestTT tests
+ if errors count + failures count > 0 then exitFailure else exitSuccess
diff --git a/tests/Digraph/PathAnonymity.hs b/tests/Digraph/PathAnonymity.hs
new file mode 100644
--- /dev/null
+++ b/tests/Digraph/PathAnonymity.hs
@@ -0,0 +1,91 @@
+module Main where
+
+import HGraph.Directed
+import HGraph.Directed.PathAnonymity
+import qualified HGraph.Directed.AdjacencyMap as AM
+import qualified Data.Set as S
+
+import Test.HUnit hiding (Node)
+import System.Exit (exitFailure, exitSuccess)
+
+v1 = 1 :: Int
+
+tests = TestList
+ [ TestLabel "Path anonymity 0" $ TestCase
+ ( do
+ let d = addVertex v1 AM.emptyDigraph
+ k = pathAnonymity d
+ assertEqual "Anonymity"
+ 0
+ k
+ )
+ , TestLabel "Path anonymity 1-0" $ TestCase
+ ( do
+ let d = foldr addArc (foldr addVertex AM.emptyDigraph [v1,2]) $ zip [1] [2]
+ k = pathAnonymity d
+ assertEqual "Anonymity"
+ 1
+ k
+ )
+ , TestLabel "Path anonymity 1-1" $ TestCase
+ ( do
+ let d = foldr addArc (foldr addVertex AM.emptyDigraph [0,1,2,3,4]) $ zip [0,1,2,4] [4,4,4,3]
+ k = pathAnonymity d
+ assertEqual "path anonymity"
+ 1
+ (pathPathAnonymityI d [0,4,3])
+ assertEqual "digraph anonymity"
+ 1
+ k
+ )
+ , TestLabel "Path anonymity 2-0" $ TestCase
+ ( do
+ let d = foldr addArc (foldr addVertex AM.emptyDigraph [v1,2,3,4,5]) $ zip [1,2,3,3] [3,3,4,5]
+ k = pathAnonymity d
+ assertEqual "Anonymity"
+ 2
+ k
+ )
+ , TestLabel "Path anonymity 2-1" $ TestCase
+ ( do
+ let d = foldr addArc (foldr addVertex AM.emptyDigraph [0,1,2]) $ zip [0,0,1,1] [1,2,0,2]
+ k = pathAnonymity d
+ assertEqual "path anonymity"
+ 2
+ (pathPathAnonymityI d [0,1,0])
+ assertEqual "digraph anonymity"
+ 2
+ k
+ )
+ , TestLabel "Path anonymity 4-1" $ TestCase
+ ( do
+ let d = foldr addArc (foldr addVertex AM.emptyDigraph [v1,2,3,4,5]) $ [(v,u) | v <- [1..5], u <- [1..5], v /= u]
+ k = pathAnonymity d
+ assertEqual "path anonymity"
+ 2
+ (pathPathAnonymityI d [1,2,1])
+ assertEqual "path anonymity"
+ 3
+ (pathPathAnonymityI d [1,2,3,1])
+ assertEqual "digraph anonymity"
+ 4
+ k
+ )
+ , TestLabel "Path anonymity 5-0" $ TestCase
+ ( do
+ let d = foldr addArc (foldr addVertex AM.emptyDigraph [v1,2,3,4,5,6]) $ [(v,u) | v <- [1..6], u <- [1..6], v /= u]
+ k = pathAnonymity d
+ assertEqual "path anonymity"
+ 5
+ (pathPathAnonymityI d [1,2,3,4,5,1])
+ assertEqual "digraph anonymity"
+ 5
+ k
+ )
+ ]
+
+arcSet p = S.fromList $ zip p $ tail p
+
+main = do
+ count <- runTestTT tests
+ if errors count + failures count > 0 then exitFailure else exitSuccess
diff --git a/tests/Digraph/Subgraph.hs b/tests/Digraph/Subgraph.hs
new file mode 100644
--- /dev/null
+++ b/tests/Digraph/Subgraph.hs
@@ -0,0 +1,70 @@
+module Main where
+
+import HGraph.Directed
+import HGraph.Directed.Subgraph
+import qualified HGraph.Directed.AdjacencyMap as AM
+import qualified Data.Map as M
+import qualified Data.Set as S
+
+import Test.HUnit hiding (Node)
+import System.Exit (exitFailure, exitSuccess)
+
+tests = TestList
+ [ TestLabel "Subgraph 0" $ TestCase
+ ( do
+ let d = addVertex 1 AM.emptyDigraph
+ assertBool "Subgraph"
+ (d `contains` d)
+ )
+ , TestLabel "Subgraph 1" $ TestCase
+ ( do
+ let d = foldr addVertex AM.emptyDigraph [0,1]
+ h1 = foldr addVertex AM.emptyDigraph [1]
+ h2 = foldr addVertex AM.emptyDigraph [2]
+ assertBool "Subgraph h1"
+ (d `contains` h1)
+ assertBool "Subgraph h2"
+ (not $ d `contains` h2)
+ assertBool "Iso h2"
+ (isSubgraphIsomorphism d h2 (M.singleton 2 1))
+ assertBool "Subgraph Iso h2"
+ (h2 `isSubgraphOf` d)
+ )
+ , TestLabel "Subgraph 2" $ TestCase
+ ( do
+ let d = foldr addArc (foldr addVertex AM.emptyDigraph [0,1,2,3]) $ zip [0,1,2] [1,2,3]
+ h = foldr addArc (foldr addVertex AM.emptyDigraph [0,1]) $ zip [0] [1]
+ assertBool "Subgraph h"
+ (d `contains` h)
+ assertBool "Iso h"
+ (isSubgraphIsomorphism d h (M.fromList [(0,0), (1,1)]))
+ assertBool "Subgraph Iso h"
+ (h `isSubgraphOf` d)
+ )
+ , TestLabel "Subgraph 3" $ TestCase
+ ( do
+ let d = foldr addArc (foldr addVertex AM.emptyDigraph [0,1,2,3]) $ zip [0,0,0,1] [1,2,3,0]
+ h1 = foldr addArc (foldr addVertex AM.emptyDigraph [0,1,2,3,4]) $ []
+ h2 = foldr addArc (foldr addVertex AM.emptyDigraph [0,1,2]) $ zip [0,0,1] [1,2,0]
+ assertBool "not subgraph h"
+ (not $ h1 `isSubgraphOf` d)
+ assertBool "Subgraph Iso h"
+ (h2 `isSubgraphOf` d)
+ )
+ , TestLabel "Subgraph 4" $ TestCase
+ ( do
+ let d = foldr addArc (foldr addVertex AM.emptyDigraph [0,1]) $ zip [0] [1]
+ h1 = foldr addArc (foldr addVertex AM.emptyDigraph [0,1]) $ zip [0,1] [1,0]
+ h2 = foldr addArc (foldr addVertex AM.emptyDigraph [0,1,2]) $ zip [0,1] [1,2]
+ assertBool "subgraph iso h1"
+ (d `isSubgraphOf` h1)
+ assertBool "Subgraph Iso h2"
+ (d `isSubgraphOf` h2)
+ )
+ ]
+
+arcSet p = S.fromList $ zip p $ tail p
+
+main = do
+ count <- runTestTT tests
+ if errors count + failures count > 0 then exitFailure else exitSuccess
diff --git a/tests/Graph/AdjacencyMap.hs b/tests/Graph/AdjacencyMap.hs
new file mode 100644
--- /dev/null
+++ b/tests/Graph/AdjacencyMap.hs
@@ -0,0 +1,33 @@
+module Main where
+
+import HGraph.Undirected.AdjacencyMap
+import qualified Data.Map as M
+import Data.List
+
+import Test.HUnit hiding (Node)
+import System.Exit (exitFailure, exitSuccess)
+
+tests = TestList
+ [ TestLabel "No edges 1" $ TestCase
+ ( do
+ let g = addVertex emptyGraph 1
+ assertEqual "0" 0 (degree g 1)
+ assertEqual "[1]" [[1]] (connectedComponents g)
+ )
+ , TestLabel "No edges 2" $ TestCase
+ ( do
+ let g = foldr (flip addVertex) emptyGraph [1,2,3,4,5,6]
+ assertEqual "1 2 3 4 5 6" [[1], [2], [3], [4], [5], [6]] (connectedComponents g)
+ )
+ , TestLabel "Path 1" $ TestCase
+ ( do
+ let g = addEdge (foldr (flip addVertex) emptyGraph [1,2]) (1,2)
+ assertEqual "deg(1) = 1" 1 (degree g 1)
+ assertEqual "" [[1,2]] (map sort $ connectedComponents g)
+ assertEqual "" [1,2] (sort $ metaBfs g 1 id)
+ )
+ ]
+
+main = do
+ count <- runTestTT tests
+ if errors count + failures count > 0 then exitFailure else exitSuccess
diff --git a/tests/Graph/TestVertexCover.hs b/tests/Graph/TestVertexCover.hs
new file mode 100644
--- /dev/null
+++ b/tests/Graph/TestVertexCover.hs
@@ -0,0 +1,78 @@
+module Main where
+
+import HGraph.Undirected.AdjacencyMap
+import HGraph.Undirected.Solvers.VertexCover
+
+import Test.HUnit hiding (Node)
+import System.Exit (exitFailure, exitSuccess)
+
+isVc g vc = numEdges (foldr (flip removeVertex) g vc) == 0
+
+tests = TestList
+ [ TestLabel "No edges 1" $ TestCase
+ ( do
+ let g = addVertex emptyGraph 1
+ vc = minimumVertexCover g
+ assertEqual "Empty VC" [] vc
+ )
+ , TestLabel "No edges 2" $ TestCase
+ ( do
+ let g = foldr (flip addVertex) emptyGraph [1,2,3,4,5,6]
+ vc = minimumVertexCover g
+ assertEqual "Empty VC" [] vc
+ )
+ , TestLabel "VC 1" $ TestCase
+ ( do
+ let g = addEdge (foldr (flip addVertex) emptyGraph [1,2]) (1,2)
+ vc = minimumVertexCover g
+ assertEqual "VC = 1" 1 (length vc)
+ assertBool "Is VC" $ isVc g vc
+ )
+ , TestLabel "VC 2" $ TestCase
+ ( do
+ let g = foldr (flip addEdge)
+ (foldr (flip addVertex) emptyGraph [1,2,3,4])
+ [(1,2), (1,3), (1,4)]
+ vc = minimumVertexCover g
+ assertEqual "VC = 1" 1 (length vc)
+ assertBool "Is VC" $ isVc g vc
+ )
+ , TestLabel "VC 3" $ TestCase
+ ( do
+ let g = foldr (flip addEdge)
+ (foldr (flip addVertex) emptyGraph [1,2,3,4])
+ [(1,2), (1,3), (1,4), (2,3)]
+ vc = minimumVertexCover g
+ assertEqual "|VC|" 2 (length vc)
+ assertBool "Is VC" $ isVc g vc
+ )
+ , TestLabel "VC 4" $ TestCase
+ ( do
+ let g = foldr (flip addEdge)
+ (foldr (flip addVertex) emptyGraph [1,2,3,4,5,6])
+ ((1,6):(zip [1..5] [2..6]))
+ vc = minimumVertexCover g
+ assertEqual "|VC|" 3 (length vc)
+ assertBool "Is VC" $ isVc g vc
+ )
+ , TestLabel "VC grid" $ TestCase
+ ( do
+ let g = foldr (flip addEdge)
+ (foldr (flip addVertex) emptyGraph [ (x,y) | x <- [1..4], y <- [1..4]])
+ ([((4,y), (4,y+1)) | y <- [1..3]] ++
+ [((x,4), (x+1,4)) | x <- [1..3]] ++
+ concat [[ ((x,y), (x+1,y))
+ , ((x,y), (x,y+1))
+ ]
+ | x <- [1..3], y <- [1..3]
+ ]
+ )
+ vc = minimumVertexCover g
+ assertEqual "|VC|" 8 (length vc)
+ assertBool "Is VC" $ isVc g vc
+ )
+ ]
+
+main = do
+ count <- runTestTT tests
+ if errors count + failures count > 0 then exitFailure else exitSuccess
diff --git a/tests/Graph/Treedepth.hs b/tests/Graph/Treedepth.hs
new file mode 100644
--- /dev/null
+++ b/tests/Graph/Treedepth.hs
@@ -0,0 +1,61 @@
+module Main where
+
+import HGraph.Undirected.AdjacencyMap
+import HGraph.Undirected.Solvers.Treedepth
+import qualified Data.Map as M
+import Data.List
+
+import Test.HUnit hiding (Node)
+import System.Exit (exitFailure, exitSuccess)
+
+tests = TestList
+ [ TestLabel "No edges 1" $ TestCase
+ ( do
+ let g = addVertex emptyGraph 1
+ td = optimalDecomposition g
+ assertEqual "TD"
+ Decomposition{ ancestor = M.empty
+ , children = M.empty
+ , roots = [1]
+ , depth = 1
+ }
+ td
+ )
+ , TestLabel "No edges 2" $ TestCase
+ ( do
+ let g = foldr (flip addVertex) emptyGraph [1,2,3,4,5,6]
+ td = optimalDecomposition g
+ assertEqual "TD"
+ Decomposition{ ancestor = M.empty
+ , children = M.empty
+ , roots = [1,2,3,4,5,6]
+ , depth = 1
+ }
+ td{roots = sort $ roots td}
+ )
+ , TestLabel "Path 1" $ TestCase
+ ( do
+ let g = addEdge (foldr (flip addVertex) emptyGraph [1,2]) (1,2)
+ td = optimalDecomposition g
+ assertEqual (show td) 2 (depth td)
+ assertBool (show td) $ isDecomposition g td
+ )
+ , TestLabel "Path 2" $ TestCase
+ ( do
+ let g = foldr (flip addEdge) (foldr (flip addVertex) emptyGraph [1,2,3,4,5,6]) [(1,2), (2,3), (3,4), (4,5), (5,6)]
+ td = optimalDecomposition g
+ assertEqual (show td) 3 (depth td)
+ assertBool (show td) $ isDecomposition g td
+ )
+ , TestLabel "Cycle 1" $ TestCase
+ ( do
+ let g = foldr (flip addEdge) (foldr (flip addVertex) emptyGraph [1,2,3,4,5,6]) [(1,2), (2,3), (3,4), (4,5), (5,6), (6,1)]
+ td = optimalDecomposition g
+ assertEqual (show td) 4 (depth td)
+ assertBool (show td) $ isDecomposition g td
+ )
+ ]
+
+main = do
+ count <- runTestTT tests
+ if errors count + failures count > 0 then exitFailure else exitSuccess