AI-Genetic-Pro

 view release on metacpan or  search on metacpan

Changes  view on Meta::CPAN

Revision history for Perl extension AI::Genetic::Pro.

1.009 Mon, 09 Jan 2023 21:53:41 +0100
	- First release with Dist::Zilla.

1.008 Thu, 05 Jan 2023 11:16:26 +0100
	- Fix: MANIFEST

1.007 Sun, 16 Oct 2022 15:16:41 +0200
	- One more mprovement.

1.006 Sun, 16 Oct 2022 15:02:03 +0200
	- Improvements in a range of efficiency (thanks to Mario Roy :-)

1.005 Tue, 08 Dec 2020 21:32:15 +0100
	- Fixed some bugs in a documentation.

1.004 Sun, 15 Nov 2020 14:18:24 +0100
	- Added specification of required MCE version.

1.003 Sun, 15 Nov 2020 09:14:05 +0100
	- Fixed bug causing "internal error" in a case of cloning raw chromosomes.

1.002 Sat, 14 Nov 2020 21:33:38 +0100
	- Fixed bug in a documentation.

1.001 Sat, 14 Nov 2020 19:20:53 +0100
	- Fixed bug in a documentation.

1.000 Sat, 14 Nov 2020 18:03:39 +0100
	- Added support (long awaited ;) for multi-core processing, through MCE.
	- Added direct support for native arrays instead of packed scalars (for chromosomes).
	- Some bug fixes.

0.401 Fri, 19 Nov 2011 19:22:45 +0100
	- Some bug fixes.

0.341 Mon, 23 Mar 2009 17:21:52 +0100
	- Fixed bug in a documentation. Thanks to Randal L. Schwartz :-)

0.34  Tue, 17 Mar 2009 20:39:16 +0100 
	- Fixed bug in PMX strategy. Thanks to Maciej Misiak :-)

0.335 Sat, 07 Feb 2009 20:04:52 +0100
	- Little changes in a Makefile.PL (especially for Sun Solaris)

0.334 Fri, 23 Jan 2009 00:03:26 +0100
	- Module 'Digest::MD5' is loaded by default,

0.333 Fri, 22 Jan 2009 15:30:06 +0100
	- Some improvments in 'getFittest' function,
	- Added 'getFittest_as_arrayref' function,

0.332 Wed, 21 Jan 2009 00:31:01 +0100
	- Some changes in tests.

0.331 Tue, 20 Jan 2009 23:55:20 +0100
	- Added tests.
	- Some improvments in the 'inject' function.

0.33 Mon, 19 Jan 2009 00:38:06 +0100
	- Added 'strict' mode.
	- Added 'inject' function.

0.32 Sun, 18 Jan 2009 01:16:37 +0100
	- Fixes in rangevectors.

0.31 Sat, 17 Jan 2009 20:32:27 +0100
	- Fixes in mutation. Added changing of fitness for mutated chromosomes.

0.30 Fri, 16 Jan 2009 00:06:29 +0100
	- Fixes in as_string method.

0.29 Thu, 15 Jan 2009 21:13:15 +0100
	- Added full support for variable-length chromosomes.

0.28
	- Little fixes. Again :-)
	
0.27
	- Little fixes.

0.26 Sun, 11 Jan 2009 22:04:26 +0100
	- Little modifications in crossover.
	- Added supprot for variable-length chromosomes. Thanks to Leonid Zamdborg :-)

0.25 Mon, 24 Nov 2008 18:57:27 +0100
	- Little fix in a counter of generations.

0.24 Mon, 10 Nov 2008 11:34:12 +0100
	- Little speed up in main loop.

0.23 Mon, 10 Nov 2008 10:14:32 +0100
	- Little modification in main loop. Infinity loop available.

0.22 Wed, 05 Nov 2008 00:49:18 +0100
	- Added "-preserve" parameter.
	- Little speed up (Class::Accessor::Fast => Class::Accessor::Fast::XS).

0.21 Fri, 10 Oct 2008 03:41:39 +0200
	- Fixed mutation in rangevectors. Thanks to Christoph Meissner :-)

0.20 Sat, 04 Oct 2008 02:39:28 +0200
	- Again... Little bug in mutation (inversion; listvectors only) - fixed. Thanks to Alec Chen :-)

0.19 Wed, 24 Sep 2008 19:52:33 +0200
	- Little bug in mutation - fixed. Thanks to Alec Chen :-) 

0.18 Fri, 19 Sep 2008 21:41:46 +0200
	- Little fixes in documentation.

0.17 Fri, 19 Sep 2008 03:52:21 +0200
	- Added documentation :-)

0.16 Mon, 15 Sep 2008 12:12:44 +0200
	- Increased speed during chart generation.
	- More documentation.
	- Feature 'say' removed for compatibility.

0.15	Sun, 14 Sep 2008 02:14:02 +0200
	- Increased speed :-)
	- Changes way of mutation is made.
	- Added charts.
	- Added possibility to save/load GA.
	- More documentation.

0.1		Sat, 13 Sep 2008 02:04:25 +0200
	- First release.

LICENSE  view on Meta::CPAN

This software is Copyright (c) 2023 by Łukasz Strzelecki.

This is free software, licensed under:

  The GNU Lesser General Public License, Version 2.1, February 1999

The GNU Lesser General Public License (LGPL)
Version 2.1, February 1999

  (The master copy of this license lives on the GNU website.)

Copyright (C) 1991, 1999 Free Software Foundation, Inc. 59
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.

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

MANIFEST  view on Meta::CPAN

# This file was automatically generated by Dist::Zilla::Plugin::Manifest v6.017.
Changes
LICENSE
MANIFEST
META.json
META.yml
Makefile.PL
README
dist.ini
lib/AI/Genetic/Pro.pm
lib/AI/Genetic/Pro/Array/Type.pm
lib/AI/Genetic/Pro/Chromosome.pm
lib/AI/Genetic/Pro/Crossover/Distribution.pm
lib/AI/Genetic/Pro/Crossover/OX.pm
lib/AI/Genetic/Pro/Crossover/PMX.pm
lib/AI/Genetic/Pro/Crossover/Points.pm
lib/AI/Genetic/Pro/Crossover/PointsAdvanced.pm
lib/AI/Genetic/Pro/Crossover/PointsBasic.pm
lib/AI/Genetic/Pro/Crossover/PointsSimple.pm
lib/AI/Genetic/Pro/MCE.pm
lib/AI/Genetic/Pro/Mutation/Bitvector.pm
lib/AI/Genetic/Pro/Mutation/Combination.pm
lib/AI/Genetic/Pro/Mutation/Listvector.pm
lib/AI/Genetic/Pro/Mutation/Rangevector.pm
lib/AI/Genetic/Pro/Selection/Distribution.pm
lib/AI/Genetic/Pro/Selection/Roulette.pm
lib/AI/Genetic/Pro/Selection/RouletteBasic.pm
lib/AI/Genetic/Pro/Selection/RouletteDistribution.pm
t/00_load.t
t/01_inject.t
t/02_cache.t
t/03_bitvectors_constant_length.t
t/04_bitvectors_variable_length_I.t
t/05_bitvectors_variable_length_II.t
t/06_listvectors_constant_length.t
t/07_listvectors_variable_length_I.t
t/08_listvectors_variable_length_II.t
t/09_rangevectors_constant_length.t
t/10_rangevectors_variable_length_I.t
t/11_rangevectors_variable_length_II.t
t/12_combinations_constant_length.t
t/13_preserve.t
t/14_getFittest.t
t/15_bitvectors_constant_length_MCE.t
t/16_bitvectors_constant_length_-_native_arrays.t
t/17_bitvectors_constant_length_MCE_-_native_arrays.t

META.json  view on Meta::CPAN

{
   "abstract" : "Efficient genetic algorithms for professional purpose with support for multiprocessing.",
   "author" : [
      "\u0141ukasz Strzelecki <lukasz@strzeleccy.eu>"
   ],
   "dynamic_config" : 0,
   "generated_by" : "Dist::Zilla version 6.017, CPAN::Meta::Converter version 2.150010",
   "license" : [
      "lgpl_2_1"
   ],
   "meta-spec" : {
      "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec",
      "version" : 2
   },
   "name" : "AI-Genetic-Pro",
   "prereqs" : {
      "configure" : {
         "requires" : {
            "ExtUtils::MakeMaker" : "0"
         }
      },
      "runtime" : {
         "requires" : {
            "Carp" : "0",
            "Class::Accessor::Fast::XS" : "0",
            "Clone" : "0",
            "Digest::MD5" : "0",
            "Exporter::Lite" : "0",
            "GD::Graph::linespoints" : "1.54",
            "List::MoreUtils" : "0",
            "List::Util" : "0",
            "MCE" : "1.874",
            "MCE::Map" : "1.874",
            "Math::Random" : "0.72",
            "Storable" : "2.05",
            "Struct::Compare" : "0",
            "Tie::Array::Packed" : "0.13",
            "UNIVERSAL::require" : "0"
         }
      }
   },
   "release_status" : "stable",
   "resources" : {
      "homepage" : "https://github.com/d-strzelec/AI-Genetic-Pro",
      "repository" : {
         "type" : "git",
         "url" : "https://github.com/d-strzelec/AI-Genetic-Pro.git",
         "web" : "https://github.com/d-strzelec/AI-Genetic-Pro"
      }
   },
   "version" : "1.009",
   "x_Dist_Zilla" : {
      "perl" : {
         "version" : "5.032001"
      },
      "plugins" : [
         {
            "class" : "Dist::Zilla::Plugin::GatherDir",
            "config" : {
               "Dist::Zilla::Plugin::GatherDir" : {
                  "exclude_filename" : [],
                  "exclude_match" : [],
                  "follow_symlinks" : 0,
                  "include_dotfiles" : 0,
                  "prefix" : "",
                  "prune_directory" : [],
                  "root" : "."
               }
            },
            "name" : "GatherDir",
            "version" : "6.017"
         },
         {
            "class" : "Dist::Zilla::Plugin::PruneCruft",
            "name" : "PruneCruft",
            "version" : "6.017"
         },
         {
            "class" : "Dist::Zilla::Plugin::PruneFiles",
            "name" : "PruneFiles",
            "version" : "6.017"
         },
         {
            "class" : "Dist::Zilla::Plugin::ManifestSkip",
            "name" : "ManifestSkip",
            "version" : "6.017"
         },
         {
            "class" : "Dist::Zilla::Plugin::MetaYAML",
            "name" : "MetaYAML",
            "version" : "6.017"
         },
         {
            "class" : "Dist::Zilla::Plugin::MetaJSON",
            "name" : "MetaJSON",
            "version" : "6.017"
         },
         {
            "class" : "Dist::Zilla::Plugin::License",
            "name" : "License",
            "version" : "6.017"
         },
         {
            "class" : "Dist::Zilla::Plugin::MakeMaker",
            "config" : {
               "Dist::Zilla::Role::TestRunner" : {
                  "default_jobs" : 1
               }
            },
            "name" : "MakeMaker",
            "version" : "6.017"
         },
         {
            "class" : "Dist::Zilla::Plugin::Manifest",
            "name" : "Manifest",
            "version" : "6.017"
         },
         {
            "class" : "Dist::Zilla::Plugin::PkgVersion",
            "name" : "PkgVersion",
            "version" : "6.017"
         },
         {
            "class" : "Dist::Zilla::Plugin::ReadmeFromPod",
            "name" : "ReadmeFromPod",
            "version" : "0.37"
         },
         {
            "class" : "Dist::Zilla::Plugin::MetaConfig",
            "name" : "MetaConfig",
            "version" : "6.017"
         },
         {
            "class" : "Dist::Zilla::Plugin::Prereqs",
            "config" : {
               "Dist::Zilla::Plugin::Prereqs" : {
                  "phase" : "runtime",
                  "type" : "requires"
               }
            },
            "name" : "Prereqs",
            "version" : "6.017"
         },
         {
            "class" : "Dist::Zilla::Plugin::GithubMeta",
            "name" : "GithubMeta",
            "version" : "0.58"
         },
         {
            "class" : "Dist::Zilla::Plugin::Git::Commit",
            "config" : {
               "Dist::Zilla::Plugin::Git::Commit" : {
                  "add_files_in" : [],
                  "commit_msg" : "Release v%v%n%n%c",
                  "signoff" : 0
               },
               "Dist::Zilla::Role::Git::DirtyFiles" : {
                  "allow_dirty" : [
                     "Changes",
                     "dist.ini"
                  ],
                  "allow_dirty_match" : [
                     "(?^u:.*(?:\\.pm|README|\\*.t)$)"
                  ],
                  "changelog" : "Changes"
               },
               "Dist::Zilla::Role::Git::Repo" : {
                  "git_version" : "2.30.2",
                  "repo_root" : "."
               },
               "Dist::Zilla::Role::Git::StringFormatter" : {
                  "time_zone" : "local"
               }
            },
            "name" : "Git::Commit",
            "version" : "2.047"
         },
         {
            "class" : "Dist::Zilla::Plugin::Git::Push",
            "config" : {
               "Dist::Zilla::Plugin::Git::Push" : {
                  "push_to" : [
                     "d-strzelec"
                  ],
                  "remotes_must_exist" : 1
               },
               "Dist::Zilla::Role::Git::Repo" : {
                  "git_version" : "2.30.2",
                  "repo_root" : "."
               }
            },
            "name" : "Git::Push",
            "version" : "2.047"
         },
         {
            "class" : "Dist::Zilla::Plugin::TestRelease",
            "name" : "TestRelease",
            "version" : "6.017"
         },
         {
            "class" : "Dist::Zilla::Plugin::ConfirmRelease",
            "name" : "ConfirmRelease",
            "version" : "6.017"
         },
         {
            "class" : "Dist::Zilla::Plugin::UploadToCPAN",
            "name" : "UploadToCPAN",
            "version" : "6.017"
         },
         {
            "class" : "Dist::Zilla::Plugin::FinderCode",
            "name" : ":InstallModules",
            "version" : "6.017"
         },
         {
            "class" : "Dist::Zilla::Plugin::FinderCode",
            "name" : ":IncModules",
            "version" : "6.017"
         },
         {
            "class" : "Dist::Zilla::Plugin::FinderCode",
            "name" : ":TestFiles",
            "version" : "6.017"
         },
         {
            "class" : "Dist::Zilla::Plugin::FinderCode",
            "name" : ":ExtraTestFiles",
            "version" : "6.017"
         },
         {
            "class" : "Dist::Zilla::Plugin::FinderCode",
            "name" : ":ExecFiles",
            "version" : "6.017"
         },
         {
            "class" : "Dist::Zilla::Plugin::FinderCode",
            "name" : ":PerlExecFiles",
            "version" : "6.017"
         },
         {
            "class" : "Dist::Zilla::Plugin::FinderCode",
            "name" : ":ShareFiles",
            "version" : "6.017"
         },
         {
            "class" : "Dist::Zilla::Plugin::FinderCode",
            "name" : ":MainModule",
            "version" : "6.017"
         },
         {
            "class" : "Dist::Zilla::Plugin::FinderCode",
            "name" : ":AllFiles",
            "version" : "6.017"
         },
         {
            "class" : "Dist::Zilla::Plugin::FinderCode",
            "name" : ":NoFiles",
            "version" : "6.017"
         }
      ],
      "zilla" : {
         "class" : "Dist::Zilla::Dist::Builder",
         "config" : {
            "is_trial" : 0
         },
         "version" : "6.017"
      }
   },
   "x_generated_by_perl" : "v5.32.1",
   "x_serialization_backend" : "Cpanel::JSON::XS version 4.25",
   "x_spdx_expression" : "LGPL-2.1"
}

META.yml  view on Meta::CPAN

---
abstract: 'Efficient genetic algorithms for professional purpose with support for multiprocessing.'
author:
  - 'Łukasz Strzelecki <lukasz@strzeleccy.eu>'
build_requires: {}
configure_requires:
  ExtUtils::MakeMaker: '0'
dynamic_config: 0
generated_by: 'Dist::Zilla version 6.017, CPAN::Meta::Converter version 2.150010'
license: lgpl
meta-spec:
  url: http://module-build.sourceforge.net/META-spec-v1.4.html
  version: '1.4'
name: AI-Genetic-Pro
requires:
  Carp: '0'
  Class::Accessor::Fast::XS: '0'
  Clone: '0'
  Digest::MD5: '0'
  Exporter::Lite: '0'
  GD::Graph::linespoints: '1.54'
  List::MoreUtils: '0'
  List::Util: '0'
  MCE: '1.874'
  MCE::Map: '1.874'
  Math::Random: '0.72'
  Storable: '2.05'
  Struct::Compare: '0'
  Tie::Array::Packed: '0.13'
  UNIVERSAL::require: '0'
resources:
  homepage: https://github.com/d-strzelec/AI-Genetic-Pro
  repository: https://github.com/d-strzelec/AI-Genetic-Pro.git
version: '1.009'
x_Dist_Zilla:
  perl:
    version: '5.032001'
  plugins:
    -
      class: Dist::Zilla::Plugin::GatherDir
      config:
        Dist::Zilla::Plugin::GatherDir:
          exclude_filename: []
          exclude_match: []
          follow_symlinks: 0
          include_dotfiles: 0
          prefix: ''
          prune_directory: []
          root: .
      name: GatherDir
      version: '6.017'
    -
      class: Dist::Zilla::Plugin::PruneCruft
      name: PruneCruft
      version: '6.017'
    -
      class: Dist::Zilla::Plugin::PruneFiles
      name: PruneFiles
      version: '6.017'
    -
      class: Dist::Zilla::Plugin::ManifestSkip
      name: ManifestSkip
      version: '6.017'
    -
      class: Dist::Zilla::Plugin::MetaYAML
      name: MetaYAML
      version: '6.017'
    -
      class: Dist::Zilla::Plugin::MetaJSON
      name: MetaJSON
      version: '6.017'
    -
      class: Dist::Zilla::Plugin::License
      name: License
      version: '6.017'
    -
      class: Dist::Zilla::Plugin::MakeMaker
      config:
        Dist::Zilla::Role::TestRunner:
          default_jobs: 1
      name: MakeMaker
      version: '6.017'
    -
      class: Dist::Zilla::Plugin::Manifest
      name: Manifest
      version: '6.017'
    -
      class: Dist::Zilla::Plugin::PkgVersion
      name: PkgVersion
      version: '6.017'
    -
      class: Dist::Zilla::Plugin::ReadmeFromPod
      name: ReadmeFromPod
      version: '0.37'
    -
      class: Dist::Zilla::Plugin::MetaConfig
      name: MetaConfig
      version: '6.017'
    -
      class: Dist::Zilla::Plugin::Prereqs
      config:
        Dist::Zilla::Plugin::Prereqs:
          phase: runtime
          type: requires
      name: Prereqs
      version: '6.017'
    -
      class: Dist::Zilla::Plugin::GithubMeta
      name: GithubMeta
      version: '0.58'
    -
      class: Dist::Zilla::Plugin::Git::Commit
      config:
        Dist::Zilla::Plugin::Git::Commit:
          add_files_in: []
          commit_msg: 'Release v%v%n%n%c'
          signoff: 0
        Dist::Zilla::Role::Git::DirtyFiles:
          allow_dirty:
            - Changes
            - dist.ini
          allow_dirty_match:
            - (?^u:.*(?:\.pm|README|\*.t)$)
          changelog: Changes
        Dist::Zilla::Role::Git::Repo:
          git_version: 2.30.2
          repo_root: .
        Dist::Zilla::Role::Git::StringFormatter:
          time_zone: local
      name: Git::Commit
      version: '2.047'
    -
      class: Dist::Zilla::Plugin::Git::Push
      config:
        Dist::Zilla::Plugin::Git::Push:
          push_to:
            - d-strzelec
          remotes_must_exist: 1
        Dist::Zilla::Role::Git::Repo:
          git_version: 2.30.2
          repo_root: .
      name: Git::Push
      version: '2.047'
    -
      class: Dist::Zilla::Plugin::TestRelease
      name: TestRelease
      version: '6.017'
    -
      class: Dist::Zilla::Plugin::ConfirmRelease
      name: ConfirmRelease
      version: '6.017'
    -
      class: Dist::Zilla::Plugin::UploadToCPAN
      name: UploadToCPAN
      version: '6.017'
    -
      class: Dist::Zilla::Plugin::FinderCode
      name: ':InstallModules'
      version: '6.017'
    -
      class: Dist::Zilla::Plugin::FinderCode
      name: ':IncModules'
      version: '6.017'
    -
      class: Dist::Zilla::Plugin::FinderCode
      name: ':TestFiles'
      version: '6.017'
    -
      class: Dist::Zilla::Plugin::FinderCode
      name: ':ExtraTestFiles'
      version: '6.017'
    -
      class: Dist::Zilla::Plugin::FinderCode
      name: ':ExecFiles'
      version: '6.017'
    -
      class: Dist::Zilla::Plugin::FinderCode
      name: ':PerlExecFiles'
      version: '6.017'
    -
      class: Dist::Zilla::Plugin::FinderCode
      name: ':ShareFiles'
      version: '6.017'
    -
      class: Dist::Zilla::Plugin::FinderCode
      name: ':MainModule'
      version: '6.017'
    -
      class: Dist::Zilla::Plugin::FinderCode
      name: ':AllFiles'
      version: '6.017'
    -
      class: Dist::Zilla::Plugin::FinderCode
      name: ':NoFiles'
      version: '6.017'
  zilla:
    class: Dist::Zilla::Dist::Builder
    config:
      is_trial: '0'
    version: '6.017'
x_generated_by_perl: v5.32.1
x_serialization_backend: 'YAML::Tiny version 1.73'
x_spdx_expression: LGPL-2.1

Makefile.PL  view on Meta::CPAN

# This file was automatically generated by Dist::Zilla::Plugin::MakeMaker v6.017.
use strict;
use warnings;



use ExtUtils::MakeMaker;

my %WriteMakefileArgs = (
  "ABSTRACT" => "Efficient genetic algorithms for professional purpose with support for multiprocessing.",
  "AUTHOR" => "\x{141}ukasz Strzelecki <lukasz\@strzeleccy.eu>",
  "CONFIGURE_REQUIRES" => {
    "ExtUtils::MakeMaker" => 0
  },
  "DISTNAME" => "AI-Genetic-Pro",
  "LICENSE" => "lgpl",
  "NAME" => "AI::Genetic::Pro",
  "PREREQ_PM" => {
    "Carp" => 0,
    "Class::Accessor::Fast::XS" => 0,
    "Clone" => 0,
    "Digest::MD5" => 0,
    "Exporter::Lite" => 0,
    "GD::Graph::linespoints" => "1.54",
    "List::MoreUtils" => 0,
    "List::Util" => 0,
    "MCE" => "1.874",
    "MCE::Map" => "1.874",
    "Math::Random" => "0.72",
    "Storable" => "2.05",
    "Struct::Compare" => 0,
    "Tie::Array::Packed" => "0.13",
    "UNIVERSAL::require" => 0
  },
  "VERSION" => "1.009",
  "test" => {
    "TESTS" => "t/*.t"
  }
);


my %FallbackPrereqs = (
  "Carp" => 0,
  "Class::Accessor::Fast::XS" => 0,
  "Clone" => 0,
  "Digest::MD5" => 0,
  "Exporter::Lite" => 0,
  "GD::Graph::linespoints" => "1.54",
  "List::MoreUtils" => 0,
  "List::Util" => 0,
  "MCE" => "1.874",
  "MCE::Map" => "1.874",
  "Math::Random" => "0.72",
  "Storable" => "2.05",
  "Struct::Compare" => 0,
  "Tie::Array::Packed" => "0.13",
  "UNIVERSAL::require" => 0
);


unless ( eval { ExtUtils::MakeMaker->VERSION(6.63_03) } ) {
  delete $WriteMakefileArgs{TEST_REQUIRES};
  delete $WriteMakefileArgs{BUILD_REQUIRES};
  $WriteMakefileArgs{PREREQ_PM} = \%FallbackPrereqs;
}

delete $WriteMakefileArgs{CONFIGURE_REQUIRES}
  unless eval { ExtUtils::MakeMaker->VERSION(6.52) };

WriteMakefile(%WriteMakefileArgs);

README  view on Meta::CPAN

NAME

    AI::Genetic::Pro - Efficient genetic algorithms for professional
    purpose with support for multiprocessing.

SYNOPSIS

        use AI::Genetic::Pro;
        
        sub fitness {
            my ($ga, $chromosome) = @_;
            return oct('0b' . $ga->as_string($chromosome)); 
        }
        
        sub terminate {
            my ($ga) = @_;
            my $result = oct('0b' . $ga->as_string($ga->getFittest));
            return $result == 4294967295 ? 1 : 0;
        }
        
        my $ga = AI::Genetic::Pro->new(        
            -fitness         => \&fitness,        # fitness function
            -terminate       => \&terminate,      # terminate function
            -type            => 'bitvector',      # type of chromosomes
            -population      => 1000,             # population
            -crossover       => 0.9,              # probab. of crossover
            -mutation        => 0.01,             # probab. of mutation
            -parents         => 2,                # number  of parents
            -selection       => [ 'Roulette' ],   # selection strategy
            -strategy        => [ 'Points', 2 ],  # crossover strategy
            -cache           => 0,                # cache results
            -history         => 1,                # remember best results
            -preserve        => 3,                # remember the bests
            -variable_length => 1,                # turn variable length ON
            -mce             => 1,                # optional MCE support
            -workers         => 3,                # number of workers (MCE)
        );
            
        # init population of 32-bit vectors
        $ga->init(32);
            
        # evolve 10 generations
        $ga->evolve(10);
        
        # best score
        print "SCORE: ", $ga->as_value($ga->getFittest), ".\n";
        
        # save evolution path as a chart
        $ga->chart(-filename => 'evolution.png');
         
        # save state of GA
        $ga->save('genetic.sga');
        
        # load state of GA
        $ga->load('genetic.sga');

DESCRIPTION

    This module provides efficient implementation of a genetic algorithm
    for professional purpose with support for multiprocessing. It was
    designed to operate as fast as possible even on very large populations
    and big individuals/chromosomes. AI::Genetic::Pro was inspired by
    AI::Genetic, so it is in most cases compatible (there are some
    changes). Additionally AI::Genetic::Pro isn't a pure Perl solution, so
    it doesn't have limitations of its ancestor (such as slow-down in the
    case of big populations ( >10000 ) or vectors with more than 33
    fields).

    If You are looking for a pure Perl solution, consider AI::Genetic.

    Speed

      To increase speed XS code is used, however with portability in mind.
      This distribution was tested on Windows and Linux platforms (and
      should work on any other).

      Multicore support is available through Many-Core Engine (MCE). You
      can gain the most speed up for big populations or time/CPU consuming
      fitness functions, however for small populations and/or simple
      fitness function better choice will be single-process version.

      You can get even more speed up if you turn on use of native arrays
      (parameter: native) instead of packing chromosomes into single
      scalar. However you have to remember about expensive memory use in
      that case.

    Memory

      This module was designed to use as little memory as possible. A
      population of size 10000 consisting of 92-bit vectors uses only ~24MB
      (AI::Genetic would use about 78MB). However - if you use MCE - there
      will be bigger memory consumption. This is consequence of necessity
      of synchronization between many processes.

    Advanced options

      To provide more flexibility AI::Genetic::Pro supports many
      statistical distributions, such as uniform, natural, chi_square and
      others. This feature can be used in selection and/or crossover. See
      the documentation below.

METHODS

    $ga->new( %options )

      Constructor. It accepts options in hash-value style. See options and
      an example below.

      -fitness

	This defines a fitness function. It expects a reference to a
	subroutine.

      -terminate

	This defines a terminate function. It expects a reference to a
	subroutine.

      -type

	This defines the type of chromosomes. Currently, AI::Genetic::Pro
	supports four types:

	bitvector

	  Individuals/chromosomes of this type have genes that are bits.
	  Each gene can be in one of two possible states, on or off.

	listvector

	  Each gene of a "listvector" individual/chromosome can assume one
	  string value from a specified list of possible string values.

	rangevector

	  Each gene of a "rangevector" individual/chromosome can assume one
	  integer value from a range of possible integer values. Note that
	  only integers are supported. The user can always transform any
	  desired fractional values by multiplying and dividing by an
	  appropriate power of 10.

	combination

	  Each gene of a "combination" individual/chromosome can assume one
	  string value from a specified list of possible string values. All
	  genes are unique.

      -population

	This defines the size of the population, i.e. how many chromosomes
	simultaneously exist at each generation.

      -crossover

	This defines the crossover rate. The fairest results are achieved
	with crossover rate ~0.95.

      -mutation

	This defines the mutation rate. The fairest results are achieved
	with mutation rate ~0.01.

      -preserve

	This defines injection of the bests chromosomes into a next
	generation. It causes a little slow down, however (very often) much
	better results are achieved. You can specify, how many chromosomes
	will be preserved, i.e.

            -preserve => 1, # only one chromosome will be preserved
            # or
            -preserve => 9, # 9 chromosomes will be preserved
            # and so on...

	Attention! You cannot preserve more chromosomes than exist in your
	population.

      -variable_length

	This defines whether variable-length chromosomes are turned on
	(default off) and a which types of mutation are allowed. See below.

	level 0

	  Feature is inactive (default). Example:

                  -variable_length => 0
                  
              # chromosomes (i.e. bitvectors)
              0 1 0 0 1 1 0 1 1 1 0 1 0 1
              0 0 1 1 0 1 1 1 1 0 0 1 1 0
              0 1 1 1 0 1 0 0 1 1 0 1 1 1
              0 1 0 0 1 1 0 1 1 1 1 0 1 0
              # ...and so on

	level 1

	  Feature is active, but chromosomes can varies only on the right
	  side, Example:

                  -variable_length => 1
                  
              # chromosomes (i.e. bitvectors)
              0 1 0 0 1 1 0 1 1 1 
              0 0 1 1 0 1 1 1 1
              0 1 1 1 0 1 0 0 1 1 0 1 1 1
              0 1 0 0 1 1 0 1 1 1
              # ...and so on
                  

	level 2

	  Feature is active and chromosomes can varies on the left side and
	  on the right side; unwanted values/genes on the left side are
	  replaced with undef, ie.

                  -variable_length => 2
           
              # chromosomes (i.e. bitvectors)
              x x x 0 1 1 0 1 1 1 
              x x x x 0 1 1 1 1
              x 1 1 1 0 1 0 0 1 1 0 1 1 1
              0 1 0 0 1 1 0 1 1 1
              # where 'x' means 'undef'
              # ...and so on

	  In this situation returned chromosomes in an array context
	  ($ga->as_array($chromosome)) can have undef values on the left
	  side (only). In a scalar context each undefined value is replaced
	  with a single space. If You don't want to see any undef or space,
	  just use as_array_def_only and as_string_def_only instead of
	  as_array and as_string.

      -parents

	This defines how many parents should be used in a crossover.

      -selection

	This defines how individuals/chromosomes are selected to crossover.
	It expects an array reference listed below:

            -selection => [ $type, @params ]

	where type is one of:

	RouletteBasic

	  Each individual/chromosome can be selected with probability
	  proportional to its fitness.

	Roulette

	  First the best individuals/chromosomes are selected. From this
	  collection parents are selected with probability poportional to
	  their fitness.

	RouletteDistribution

	  Each individual/chromosome has a portion of roulette wheel
	  proportional to its fitness. Selection is done with the specified
	  distribution. Supported distributions and parameters are listed
	  below.

	  -selection => [ 'RouletteDistribution', 'uniform' ]

	    Standard uniform distribution. No additional parameters are
	    needed.

	  -selection => [ 'RouletteDistribution', 'normal', $av, $sd ]

	    Normal distribution, where $av is average (default: size of
	    population /2) and $$sd is standard deviation (default: size of
	    population).

	  -selection => [ 'RouletteDistribution', 'beta', $aa, $bb ]

	    Beta distribution. The density of the beta is:

                X^($aa - 1) * (1 - X)^($bb - 1) / B($aa , $bb) for 0 < X < 1.

	    $aa and $bb are set by default to number of parents.

	    Argument restrictions: Both $aa and $bb must not be less than
	    1.0E-37.

	  -selection => [ 'RouletteDistribution', 'binomial' ]

	    Binomial distribution. No additional parameters are needed.

	  -selection => [ 'RouletteDistribution', 'chi_square', $df ]

	    Chi-square distribution with $df degrees of freedom. $df by
	    default is set to size of population.

	  -selection => [ 'RouletteDistribution', 'exponential', $av ]

	    Exponential distribution, where $av is average . $av by default
	    is set to size of population.

	  -selection => [ 'RouletteDistribution', 'poisson', $mu ]

	    Poisson distribution, where $mu is mean. $mu by default is set
	    to size of population.

	Distribution

	  Chromosomes/individuals are selected with specified distribution.
	  See below.

	  -selection => [ 'Distribution', 'uniform' ]

	    Standard uniform distribution. No additional parameters are
	    needed.

	  -selection => [ 'Distribution', 'normal', $av, $sd ]

	    Normal distribution, where $av is average (default: size of
	    population /2) and $$sd is standard deviation (default: size of
	    population).

	  -selection => [ 'Distribution', 'beta', $aa, $bb ]

	    Beta distribution. The density of the beta is:

                X^($aa - 1) * (1 - X)^($bb - 1) / B($aa , $bb) for 0 < X < 1.

	    $aa and $bb are set by default to number of parents.

	    Argument restrictions: Both $aa and $bb must not be less than
	    1.0E-37.

	  -selection => [ 'Distribution', 'binomial' ]

	    Binomial distribution. No additional parameters are needed.

	  -selection => [ 'Distribution', 'chi_square', $df ]

	    Chi-square distribution with $df degrees of freedom. $df by
	    default is set to size of population.

	  -selection => [ 'Distribution', 'exponential', $av ]

	    Exponential distribution, where $av is average . $av by default
	    is set to size of population.

	  -selection => [ 'Distribution', 'poisson', $mu ]

	    Poisson distribution, where $mu is mean. $mu by default is set
	    to size of population.

      -strategy

	This defines the astrategy of crossover operation. It expects an
	array reference listed below:

            -strategy => [ $type, @params ]

	where type is one of:

	PointsSimple

	  Simple crossover in one or many points. The best
	  chromosomes/individuals are selected for the new generation. For
	  example:

              -strategy => [ 'PointsSimple', $n ]

	  where $n is the number of points for crossing.

	PointsBasic

	  Crossover in one or many points. In basic crossover selected
	  parents are crossed and one (randomly-chosen) child is moved to
	  the new generation. For example:

              -strategy => [ 'PointsBasic', $n ]

	  where $n is the number of points for crossing.

	Points

	  Crossover in one or many points. In normal crossover selected
	  parents are crossed and the best child is moved to the new
	  generation. For example:

              -strategy => [ 'Points', $n ]

	  where $n is number of points for crossing.

	PointsAdvenced

	  Crossover in one or many points. After crossover the best
	  chromosomes/individuals from all parents and chidren are selected
	  for the new generation. For example:

              -strategy => [ 'PointsAdvanced', $n ]

	  where $n is the number of points for crossing.

	Distribution

	  In distribution crossover parents are crossed in points selected
	  with the specified distribution. See below.

	  -strategy => [ 'Distribution', 'uniform' ]

	    Standard uniform distribution. No additional parameters are
	    needed.

	  -strategy => [ 'Distribution', 'normal', $av, $sd ]

	    Normal distribution, where $av is average (default: number of
	    parents/2) and $sd is standard deviation (default: number of
	    parents).

	  -strategy => [ 'Distribution', 'beta', $aa, $bb ]

	    Beta distribution. The density of the beta is:

                X^($aa - 1) * (1 - X)^($bb - 1) / B($aa , $bb) for 0 < X < 1.

	    $aa and $bb are set by default to the number of parents.

	    Argument restrictions: Both $aa and $bb must not be less than
	    1.0E-37.

	  -strategy => [ 'Distribution', 'binomial' ]

	    Binomial distribution. No additional parameters are needed.

	  -strategy => [ 'Distribution', 'chi_square', $df ]

	    Chi-squared distribution with $df degrees of freedom. $df by
	    default is set to the number of parents.

	  -strategy => [ 'Distribution', 'exponential', $av ]

	    Exponential distribution, where $av is average . $av by default
	    is set to the number of parents.

	  -strategy => [ 'Distribution', 'poisson', $mu ]

	    Poisson distribution, where $mu is mean. $mu by default is set
	    to the number of parents.

	PMX

	  PMX method defined by Goldberg and Lingle in 1985. Parameters:
	  none.

	OX

	  OX method defined by Davis (?) in 1985. Parameters: none.

      -cache

	This defines whether a cache should be used. Allowed values are 1
	or 0 (default: 0).

      -history

	This defines whether history should be collected. Allowed values
	are 1 or 0 (default: 0).

      -native

	This defines whether native arrays should be used instead of
	packing each chromosome into signle scalar. Turning this option can
	give you speed up, but much more memory will be used. Allowed
	values are 1 or 0 (default: 0).

      -mce

	This defines whether Many-Core Engine (MCE) should be used during
	processing. This can give you significant speed up on many-core/CPU
	systems, but it'll increase memory consumption. Allowed values are
	1 or 0 (default: 0).

      -workers

	This option has any meaning only if MCE is turned on. This defines
	how many process will be used during processing. Default will be
	used one proces per core (most efficient).

      -strict

	This defines if the check for modifying chromosomes in a
	user-defined fitness function is active. Directly modifying
	chromosomes is not allowed and it is a highway to big trouble. This
	mode should be used only for testing, because it is slow.

    $ga->inject($chromosomes)

      Inject new, user defined, chromosomes into the current population.
      See example below:

          # example for bitvector
          my $chromosomes = [
              [ 1, 1, 0, 1, 0, 1 ],
              [ 0, 0, 0, 1, 0, 1 ],
              [ 0, 1, 0, 1, 0, 0 ],
              ...
          ];
          
          # inject
          $ga->inject($chromosomes);

      If You want to delete some chromosomes from population, just splice
      them:

          my @remove = qw(1 2 3 9 12);
              for my $idx (sort { $b <=> $a }  @remove){
              splice @{$ga->chromosomes}, $idx, 1;
          }

    $ga->population($population)

      Set/get size of the population. This defines the size of the
      population, i.e. how many chromosomes to simultaneously exist at each
      generation.

    $ga->indType()

      Get type of individuals/chromosomes. Currently supported types are:

      bitvector

	Chromosomes will be just bitvectors. See documentation of new
	method.

      listvector

	Chromosomes will be lists of specified values. See documentation of
	new method.

      rangevector

	Chromosomes will be lists of values from specified range. See
	documentation of new method.

      combination

	Chromosomes will be unique lists of specified values. This is used
	for example in the Traveling Salesman Problem. See the
	documentation of the new method.

      In example:

          my $type = $ga->type();

    $ga->type()

      Alias for indType.

    $ga->crossProb()

      This method is used to query and set the crossover rate.

    $ga->crossover()

      Alias for crossProb.

    $ga->mutProb()

      This method is used to query and set the mutation rate.

    $ga->mutation()

      Alias for mutProb.

    $ga->parents($parents)

      Set/get number of parents in a crossover.

    $ga->init($args)

      This method initializes the population with random
      individuals/chromosomes. It MUST be called before any call to
      evolve(). It expects one argument, which depends on the type of
      individuals/chromosomes:

      bitvector

	For bitvectors, the argument is simply the length of the bitvector.

            $ga->init(10);

	This initializes a population where each individual/chromosome has
	10 genes.

      listvector

	For listvectors, the argument is an anonymous list of lists. The
	number of sub-lists is equal to the number of genes of each
	individual/chromosome. Each sub-list defines the possible string
	values that the corresponding gene can assume.

            $ga->init([
                       [qw/red blue green/],
                       [qw/big medium small/],
                       [qw/very_fat fat fit thin very_thin/],
                      ]);

	This initializes a population where each individual/chromosome has
	3 genes and each gene can assume one of the given values.

      rangevector

	For rangevectors, the argument is an anonymous list of lists. The
	number of sub-lists is equal to the number of genes of each
	individual/chromosome. Each sub-list defines the minimum and
	maximum integer values that the corresponding gene can assume.

            $ga->init([
                       [1, 5],
                       [0, 20],
                       [4, 9],
                      ]);

	This initializes a population where each individual/chromosome has
	3 genes and each gene can assume an integer within the
	corresponding range.

      combination

	For combination, the argument is an anonymous list of possible
	values of gene.

            $ga->init( [ 'a', 'b', 'c' ] );

	This initializes a population where each chromosome has 3 genes and
	each gene is a unique combination of 'a', 'b' and 'c'. For example
	genes looks something like that:

            [ 'a', 'b', 'c' ]    # gene 1
            [ 'c', 'a', 'b' ]    # gene 2
            [ 'b', 'c', 'a' ]    # gene 3
            # ...and so on...

    $ga->evolve($n)

      This method causes the GA to evolve the population for the specified
      number of generations. If its argument is 0 or undef GA will evolve
      the population to infinity unless a terminate function is specified.

    $ga->getHistory()

      Get history of the evolution. It is in a format listed below:

              [
                      # gen0   gen1   gen2   ...          # generations
                      [ max0,  max1,  max2,  ... ],       # max values
                      [ mean,  mean1, mean2, ... ],       # mean values
                      [ min0,  min1,  min2,  ... ],       # min values
              ]

    $ga->getAvgFitness()

      Get max, mean and min score of the current generation. In example:

          my ($max, $mean, $min) = $ga->getAvgFitness();

    $ga->getFittest($n, $unique)

      This function returns a list of the fittest chromosomes from the
      current population. You can specify how many chromosomes should be
      returned and if the returned chromosomes should be unique. See
      example below.

          # only one - the best
          my ($best) = $ga->getFittest;
      
          # or 5 bests chromosomes, NOT unique
          my @bests = $ga->getFittest(5);
      
          # or 7 bests and UNIQUE chromosomes
          my @bests = $ga->getFittest(7, 1);

      If you want to get a large number of chromosomes, try to use the
      getFittest_as_arrayref function instead (for efficiency).

    $ga->getFittest_as_arrayref($n, $unique)

      This function is very similar to getFittest, but it returns a
      reference to an array instead of a list.

    $ga->generation()

      Get the number of the current generation.

    $ga->people()

      Returns an anonymous list of individuals/chromosomes of the current
      population.

      IMPORTANT: the actual array reference used by the AI::Genetic::Pro
      object is returned, so any changes to it will be reflected in $ga.

    $ga->chromosomes()

      Alias for people.

    $ga->chart(%options)

      Generate a chart describing changes of min, mean, and max scores in
      your population. To satisfy your needs, you can pass the following
      options:

      -filename

	File to save a chart in (obligatory).

      -title

	Title of a chart (default: Evolution).

      -x_label

	X label (default: Generations).

      -y_label

	Y label (default: Value).

      -format

	Format of values, like sprintf (default: '%.2f').

      -legend1

	Description of min line (default: Min value).

      -legend2

	Description of min line (default: Mean value).

      -legend3

	Description of min line (default: Max value).

      -width

	Width of a chart (default: 640).

      -height

	Height of a chart (default: 480).

      -font

	Path to font (in *.ttf format) to be used (default: none).

      -logo

	Path to logo (png/jpg image) to embed in a chart (default: none).

      For example:

                $ga->chart(-width => 480, height => 320, -filename => 'chart.png');

    $ga->save($file)

      Save the current state of the genetic algorithm to the specified
      file.

    $ga->load($file)

      Load a state of the genetic algorithm from the specified file.

    $ga->as_array($chromosome)

      In list context return an array representing the specified
      chromosome. In scalar context return an reference to an array
      representing the specified chromosome. If variable_length is turned
      on and is set to level 2, an array can have some undef values. To get
      only not undef values use as_array_def_only instead of as_array.

    $ga->as_array_def_only($chromosome)

      In list context return an array representing the specified
      chromosome. In scalar context return an reference to an array
      representing the specified chromosome. If variable_length is turned
      off, this function is just an alias for as_array. If variable_length
      is turned on and is set to level 2, this function will return only
      not undef values from chromosome. See example below:

          # -variable_length => 2, -type => 'bitvector'
              
          my @chromosome = $ga->as_array($chromosome)
          # @chromosome looks something like that
          # ( undef, undef, undef, 1, 0, 1, 1, 1, 0 )
              
          @chromosome = $ga->as_array_def_only($chromosome)
          # @chromosome looks something like that
          # ( 1, 0, 1, 1, 1, 0 )

    $ga->as_string($chromosome)

      Return a string representation of the specified chromosome. See
      example below:

              # -type => 'bitvector'
              
              my $string = $ga->as_string($chromosome);
              # $string looks something like that
              # 1___0___1___1___1___0 
              
              # or 
              
              # -type => 'listvector'
              
              $string = $ga->as_string($chromosome);
              # $string looks something like that
              # element0___element1___element2___element3...

      Attention! If variable_length is turned on and is set to level 2, it
      is possible to get undef values on the left side of the vector. In
      the returned string undef values will be replaced with spaces. If you
      don't want to see any spaces, use as_string_def_only instead of
      as_string.

    $ga->as_string_def_only($chromosome)

      Return a string representation of specified chromosome. If
      variable_length is turned off, this function is just alias for
      as_string. If variable_length is turned on and is set to level 2,
      this function will return a string without undef values. See example
      below:

              # -variable_length => 2, -type => 'bitvector'
              
              my $string = $ga->as_string($chromosome);
              # $string looks something like that
              #  ___ ___ ___1___1___0 
              
              $string = $ga->as_string_def_only($chromosome);
              # $string looks something like that
              # 1___1___0 

    $ga->as_value($chromosome)

      Return the score of the specified chromosome. The value of chromosome
      is calculated by the fitness function.

SUPPORT

    AI::Genetic::Pro is still under development; however, it is used in
    many production environments.

TODO

    Examples.

    More tests.

    More warnings about incorrect parameters.

REPORTING BUGS

    When reporting bugs/problems please include as much information as
    possible. It may be difficult for me to reproduce the problem as almost
    every setup is different.

    A small script which yields the problem will probably be of help.

THANKS

    Mario Roy for suggestions about efficiency.

    Miles Gould for suggestions and some fixes (even in this documentation!
    :-).

    Alun Jones for fixing memory leaks.

    Tod Hagan for reporting a bug (rangevector values truncated to signed
    8-bit quantities) and supplying a patch.

    Randal L. Schwartz for reporting a bug in this documentation.

    Maciej Misiak for reporting problems with combination (and a bug in a
    PMX strategy).

    LEONID ZAMDBORG for recommending the addition of variable-length
    chromosomes as well as supplying relevant code samples, for testing and
    at the end reporting some bugs.

    Christoph Meissner for reporting a bug.

    Alec Chen for reporting some bugs.

AUTHOR

    Strzelecki Lukasz <lukasz@strzeleccy.eu>

SEE ALSO

    AI::Genetic Algorithm::Evolutionary

COPYRIGHT

    Copyright (c) Strzelecki Lukasz. All rights reserved. This program is
    free software; you can redistribute it and/or modify it under the same
    terms as Perl itself.

dist.ini  view on Meta::CPAN

name				= AI-Genetic-Pro
author				= Łukasz Strzelecki <lukasz@strzeleccy.eu>
license				= LGPL_2_1
copyright_holder	= Łukasz Strzelecki
copyright_year		= 2023
version				= 1.009

[GatherDir]
[PruneCruft]
[PruneFiles]
;match = ~$

[ManifestSkip]
[MetaYAML]
version = 2

[MetaJSON]
[License]
[MakeMaker]
[Manifest]
[PkgVersion]
[ReadmeFromPod]
[MetaConfig]
[Prereqs]
UNIVERSAL::require			= 0
Carp						= 0
Struct::Compare				= 0
Exporter::Lite				= 0
Tie::Array::Packed			= 0.13
List::Util					= 0
List::MoreUtils				= 0
Clone						= 0
Math::Random				= 0.72
Digest::MD5					= 0
Class::Accessor::Fast::XS	= 0
Storable					= 2.05
GD::Graph::linespoints		= 1.54
MCE							= 1.874
MCE::Map					= 1.874

[GithubMeta]
remote = d-strzelec

[Git::Commit]
changelog			= Changes
commit_msg			= Release v%v%n%n%c
allow_dirty_match	= .*(?:\.pm|README|\*.t)$

[Git::Push]
push_to		= d-strzelec

[TestRelease]
[ConfirmRelease]
[UploadToCPAN]
;[FakeRelease]


lib/AI/Genetic/Pro.pm  view on Meta::CPAN

package AI::Genetic::Pro;
$AI::Genetic::Pro::VERSION = '1.009';
#---------------

use warnings;
use strict;
use base 							qw( Class::Accessor::Fast::XS );
#-----------------------------------------------------------------------
use Carp;
use Clone 							qw( clone );
use Struct::Compare;
use Digest::MD5 					qw( md5_hex );
use List::Util 						qw( sum );
use List::MoreUtils 				qw( minmax first_index apply );
#use Data::Dumper; 					$Data::Dumper::Sortkeys = 1;
use Tie::Array::Packed;
use UNIVERSAL::require;
#-----------------------------------------------------------------------
use AI::Genetic::Pro::Array::Type 	qw( get_package_by_element_size );
use AI::Genetic::Pro::Chromosome;
#-----------------------------------------------------------------------
__PACKAGE__->mk_accessors(qw(
	mce
	type
	population
	terminate
	chromosomes 
	crossover 
	native
	parents 		_parents 
	history 		_history
	fitness 		_fitness 		_fitness_real
	cache
	mutation 		_mutator
	strategy 		_strategist
	selection 		_selector 
	_translations
	generation
	preserve		
	variable_length
	_fix_range
	_package
	_length
	strict			_strict
	workers
	size
	_init
));
#=======================================================================
# Additional modules
use constant STORABLE	=> 'Storable';
use constant GD 		=> 'GD::Graph::linespoints'; 
#=======================================================================
my $_Cache = { };
my $_temp_chromosome;
#=======================================================================
sub new {
	my ( $class, %args ) = ( shift, @_ );
	
	#-------------------------------------------------------------------
	my %opts = map { if(ref $_){$_}else{ /^-?(.*)$/o; $1 }} @_;
	my $self = bless \%opts, $class;
	
	#-------------------------------------------------------------------
	$AI::Genetic::Pro::Array::Type::Native = 1 if $self->native;
	
	#-------------------------------------------------------------------
	croak(q/Type of chromosomes cannot be "combination" if "variable length" feature is active!/)
		if $self->type eq q/combination/ and $self->variable_length;
	croak(q/You must specify a crossover strategy with -strategy!/)
		unless defined ($self->strategy);
	croak(q/Type of chromosomes cannot be "combination" if strategy is not one of: OX, PMX!/)
		if $self->type eq q/combination/ and ($self->strategy->[0] ne q/OX/ and $self->strategy->[0] ne q/PMX/);
	croak(q/Strategy cannot be "/,$self->strategy->[0],q/" if "variable length" feature is active!/ )
		if ($self->strategy->[0] eq 'PMX' or $self->strategy->[0] eq 'OX') and $self->variable_length;
	
	#-------------------------------------------------------------------
	$self->_set_strict if $self->strict;

	#-------------------------------------------------------------------
	return $self unless $self->mce;

	#-------------------------------------------------------------------
	delete $self->{ mce };
	'AI::Genetic::Pro::MCE'->use or die q[Cannot raise multicore support: ] . $@;
	
	return AI::Genetic::Pro::MCE->new( $self, \%args );
}
#=======================================================================
sub _Cache { $_Cache; }
#=======================================================================
# INIT #################################################################
#=======================================================================
sub _set_strict {
	my ($self) = @_;
	
	# fitness
	my $fitness = $self->fitness();
	my $replacement = sub {
		my @tmp = @{$_[1]};
		my $ret = $fitness->(@_);
		my @cmp = @{$_[1]};
		die qq/Chromosome was modified in a fitness function from "@tmp" to "@{$_[1]}"!\n/ unless compare(\@tmp, \@cmp);
		return $ret;
	};
	$self->fitness($replacement);
}
#=======================================================================
sub _fitness_cached {
	my ($self, $chromosome) = @_;
	
	#my $key = md5_hex(${tied(@$chromosome)});
	my $key = md5_hex( $self->_package ? md5_hex( ${ tied( @$chromosome ) } ) : join( q[:], @$chromosome ) );
	return $_Cache->{$key} if exists $_Cache->{$key};
	
	$_Cache->{$key} = $self->_fitness_real->($self, $chromosome);
	return $_Cache->{$key};
}
#=======================================================================
sub _init_cache {
	my ($self) = @_;
		
	$self->_fitness_real($self->fitness);
	$self->fitness(\&_fitness_cached);
	return;
}
#=======================================================================
sub _check_data_ref {
	my ($self, $data_org) = @_;
	my $data = clone($data_org);
	my $ars;
	for(0..$#$data){
		next if $ars->{$data->[$_]};
		$ars->{$data->[$_]} = 1;
		unshift @{$data->[$_]}, undef;
	}
	return $data;
}
#=======================================================================
# we have to find C to (in some cases) incrase value of range
# due to design model
sub _find_fix_range {
	my ($self, $data) = @_;

	for my $idx (0..$#$data){
		if($data->[$idx]->[1] < 1){ 
			my $const = 1 - $data->[$idx]->[1];
			push @{$self->_fix_range}, $const; 
			$data->[$idx]->[1] += $const;
			$data->[$idx]->[2] += $const;
		}else{ push @{$self->_fix_range}, 0; }
	}

	return $data;
}
#=======================================================================
sub init { 
	my ( $self, $data ) = @_;
	
	croak q/You have to pass some data to "init"!/ unless $data;
	#-------------------------------------------------------------------
	$self->generation(0);
	$self->_init( $data );
	$self->_fitness( { } );
	$self->_fix_range( [ ] );
	$self->_history( [  [ ], [ ], [ ] ] );
	$self->_init_cache if $self->cache;
	#-------------------------------------------------------------------
	
	if($self->type eq q/listvector/){
		croak(q/You have to pass array reference if "type" is set to "listvector"/) unless ref $data eq 'ARRAY';
		$self->_translations( $self->_check_data_ref($data) );
	}elsif($self->type eq q/bitvector/){
		croak(q/You have to pass integer if "type" is set to "bitvector"/) if $data !~ /^\d+$/o;
		$self->_translations( [ [ 0, 1 ] ] );
		$self->_translations->[$_] = $self->_translations->[0] for 1..$data-1;
	}elsif($self->type eq q/combination/){
		croak(q/You have to pass array reference if "type" is set to "combination"/) unless ref $data eq 'ARRAY';
		$self->_translations( [ clone($data) ] );
		$self->_translations->[$_] = $self->_translations->[0] for 1..$#$data;
	}elsif($self->type eq q/rangevector/){
		croak(q/You have to pass array reference if "type" is set to "rangevector"/) unless ref $data eq 'ARRAY';
		$self->_translations( $self->_find_fix_range( $self->_check_data_ref($data) ));
	}else{
		croak(q/You have to specify first "type" of vector!/);
	}
	
	my $size = 0;

	if($self->type ne q/rangevector/){ for(@{$self->_translations}){ $size = $#$_ if $#$_ > $size; } }
#	else{ for(@{$self->_translations}){ $size = $_->[1] if $_->[1] > $size; } }
	else{ for(@{$self->_translations}){ $size = $_->[2] if $_->[2] > $size; } }		# Provisional patch for rangevector values truncated to signed  8-bit quantities. Thx to Tod Hagan

	my $package = get_package_by_element_size($size);
	$self->_package($package);

	my $length = ref $data ? sub { $#$data; } : sub { $data - 1 };
	if($self->variable_length){
		$length = ref $data ? sub { 1 + int( rand( $#{ $self->_init } ) ); } : sub { 1 + int( rand( $self->_init - 1) ); };
	}

	$self->_length( $length );

	$self->chromosomes( [ ] );
	push @{$self->chromosomes}, 
		AI::Genetic::Pro::Chromosome->new($self->_translations, $self->type, $package, $length->())
			for 1..$self->population;
	
	$self->_calculate_fitness_all();
}
#=======================================================================
# SAVE / LOAD ##########################################################
#=======================================================================
sub spew {
	#+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
	STORABLE->use( qw( store retrieve freeze thaw ) ) or croak(q/You need "/.STORABLE.q/" module to save a state of "/.__PACKAGE__.q/"!/);
	$Storable::Deparse = 1;
	$Storable::Eval = 1;
	#+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
	my ( $self ) = @_;
 	
	my $clone = { 
		_selector	=> undef,
		_strategist	=> undef,
		_mutator	=> undef,
	};
	
	$clone->{ chromosomes } = [ map { ${ tied( @$_ ) } } @{ $self->chromosomes } ] 
		if $self->_package;
	
	foreach my $key(keys %$self){
		next if exists $clone->{$key};
		$clone->{$key} = $self->{$key};
	}
	
	return $clone;
}
#=======================================================================
sub slurp {
	my ( $self, $dump ) = @_;

	if( my $typ = $self->_package ){ 
		@{ $dump->{ chromosomes } } = map {
			my $arr = $typ->make_with_packed( $_ );
			bless $arr, q[AI::Genetic::Pro::Chromosome];
		} @{ $dump->{ chromosomes } };
	}
    
    %$self = %$dump;
    
	return 1;
}
#=======================================================================
sub save { 
	my ( $self, $file ) = @_;
	
	croak(q/You have to specify file!/) unless defined $file;
	
	store( $self->spew, $file );
}
#=======================================================================
sub load { 
	#+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
	STORABLE->use( qw( store retrieve freeze thaw ) ) or croak(q/You need "/.STORABLE.q/" module to load a state of "/.__PACKAGE__.q/"!/);	
	$Storable::Deparse = 1;
	$Storable::Eval = 1;
	#+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
	my ($self, $file) = @_;
	croak(q/You have to specify file!/) unless defined $file;

	my $clone = retrieve($file);
	return carp('Incorrect file!') unless $clone;
	
	return $self->slurp( $clone );
}
#=======================================================================
# CHARTS ###############################################################
#=======================================================================
sub chart { 
	GD->require or croak(q/You need "/.GD.q/" module to draw chart of evolution!/);	
	my ($self, %params) = (shift, @_);

	my $graph = GD()->new(($params{-width} || 640), ($params{-height} || 480));

	my $data = $self->getHistory;

	if(defined $params{-font}){
    	$graph->set_title_font  ($params{-font}, 12);
    	$graph->set_x_label_font($params{-font}, 10);
    	$graph->set_y_label_font($params{-font}, 10);
    	$graph->set_legend_font ($params{-font},  8);
	}
	
    $graph->set_legend(
    	$params{legend1} || q/Max value/,
    	$params{legend2} || q/Mean value/,
    	$params{legend3} || q/Min value/,
    );

    $graph->set(
        x_label_skip        => int(($data->[0]->[-1]*4)/100),
        x_labels_vertical   => 1,
        x_label_position    => .5,
        y_label_position    => .5,
        y_long_ticks        => 1,   # poziome linie
        x_ticks             => 1,   # poziome linie

        l_margin            => 10,
        b_margin            => 10,
        r_margin            => 10,
        t_margin            => 10,

        show_values         => (defined $params{-show_values} ? 1 : 0),
        values_vertical     => 1,
        values_format       => ($params{-format} || '%.2f'),

        zero_axis           => 1,
        #interlaced          => 1,
        logo_position       => 'BR',
        legend_placement    => 'RT',

        bgclr               => 'white',
        boxclr              => '#FFFFAA',
        transparent         => 0,

        title       		=> ($params{'-title'}   || q/Evolution/ ),
        x_label     		=> ($params{'-x_label'} || q/Generation/),
        y_label     		=> ($params{'-y_label'} || q/Value/     ),
        
        ( $params{-logo} && -f $params{-logo} ? ( logo => $params{-logo} ) : ( ) )
    );
	
	
    my $gd = $graph->plot( [ [ 0..$#{$data->[0]} ], @$data ] ) or croak($@);
    open(my $fh, '>', $params{-filename}) or croak($@);
    binmode $fh;
    print $fh $gd->png;
    close $fh;
    
    return 1;
}
#=======================================================================
# TRANSLATIONS #########################################################
#=======================================================================
sub as_array_def_only {
	my ($self, $chromosome) = @_;
	
	return $self->as_array($chromosome) 
		if not $self->variable_length or $self->variable_length < 2;
	
	if( $self->type eq q/bitvector/ ){
		return $self->as_array($chromosome);
	}else{
		my $ar = $self->as_array($chromosome);
		my $idx = first_index { $_ } @$ar;
		my @array = @$ar[$idx..$#$chromosome];
		return @array if wantarray;
		return \@array;
	}
}
#=======================================================================
sub as_array {
	my ($self, $chromosome) = @_;
	
	if($self->type eq q/bitvector/){
		# This could lead to internal error, bacause of underlaying Tie::Array::Packed
		#return @$chromosome if wantarray;
		#return $chromosome;
		
		my @chr = @$chromosome;
		return @chr if wantarray;
		return \@chr;
		
	}elsif($self->type eq q/rangevector/){
		my $fix_range = $self->_fix_range;
		my $c = -1;
		#my @array = map { $c++; warn "WARN: $c | ",scalar @$chromosome,"\n" if not defined $fix_range->[$c]; $_ ? $_ - $fix_range->[$c] : undef } @$chromosome;
		my @array = map { $c++; $_ ? $_ - $fix_range->[$c] : undef } @$chromosome;
		
		return @array if wantarray;
		return \@array;
	}else{
		my $cnt = 0;
		my @array = map { $self->_translations->[$cnt++]->[$_] } @$chromosome;
		return @array if wantarray;
		return \@array;
	}
}
#=======================================================================
sub as_string_def_only {	
	my ($self, $chromosome) = @_;
	
	return $self->as_string($chromosome) 
		if not $self->variable_length or $self->variable_length < 2;

	my $array = $self->as_array_def_only($chromosome);
	
	return join(q//, @$array) if $self->type eq q/bitvector/;
	return join(q/___/, @$array);
}
#=======================================================================
sub as_string {	
	return join(q//, @{$_[1]}) if $_[0]->type eq q/bitvector/;
	return 	join(q/___/, map { defined $_ ? $_ : q/ / } $_[0]->as_array($_[1]));
}
#=======================================================================
sub as_value { 
	my ($self, $chromosome) = @_;
	croak(q/You MUST call 'as_value' as method of 'AI::Genetic::Pro' object./)
		unless defined $_[0] and ref $_[0] and ( ref $_[0] eq 'AI::Genetic::Pro' or ref $_[0] eq 'AI::Genetic::Pro::MCE');
	croak(q/You MUST pass 'AI::Genetic::Pro::Chromosome' object to 'as_value' method./) 
		unless defined $_[1] and ref $_[1] and ref $_[1] eq 'AI::Genetic::Pro::Chromosome';
	return $self->fitness->($self, $chromosome);  
}
#=======================================================================
# ALGORITHM ############################################################
#=======================================================================
sub _calculate_fitness_all {
	my ($self) = @_;
	
	$self->_fitness( { } );
	$self->_fitness->{$_} = $self->fitness()->($self, $self->chromosomes->[$_]) 
		for 0..$#{$self->chromosomes};

# sorting the population is not necessary	
#	my (@chromosomes, %fitness);
#	for my $idx (sort { $self->_fitness->{$a} <=> $self->_fitness->{$b} } keys %{$self->_fitness}){
#		push @chromosomes, $self->chromosomes->[$idx];
#		$fitness{$#chromosomes} = $self->_fitness->{$idx};
#		delete $self->_fitness->{$idx};
#		delete $self->chromosomes->[$idx];
#	}
#	
#	$self->_fitness(\%fitness);
#	$self->chromosomes(\@chromosomes);

	return;
}
#=======================================================================
sub _select_parents {
	my ($self) = @_;
	unless($self->_selector){
		croak "You must specify a selection strategy!"
			unless defined $self->selection;
		my @tmp = @{$self->selection};
		my $selector = q/AI::Genetic::Pro::Selection::/ . shift @tmp;
		$selector->require or die $!;
		$self->_selector($selector->new(@tmp));
	}
	
	$self->_parents($self->_selector->run($self));
	
	return;
}
#=======================================================================
sub _crossover {
	my ($self) = @_;
	
	unless($self->_strategist){
		my @tmp = @{$self->strategy};
		my $strategist = q/AI::Genetic::Pro::Crossover::/ . shift @tmp;
		$strategist->require or die $!;
		$self->_strategist($strategist->new(@tmp));
	}

	my $a = $self->_strategist->run($self);
	$self->chromosomes( $a );
	
	return;
}
#=======================================================================
sub _mutation {
	my ($self) = @_;
	
	unless($self->_mutator){
		my $mutator = q/AI::Genetic::Pro::Mutation::/ . ucfirst(lc($self->type));
		unless($mutator->require){
			$mutator = q/AI::Genetic::Pro::Mutation::Listvector/;
			$mutator->require;
		}
		$self->_mutator($mutator->new);
	}
	
	return $self->_mutator->run($self);
}
#=======================================================================
sub _save_history {
	my @tmp;
	if($_[0]->history){ @tmp = $_[0]->getAvgFitness; }
	else { @tmp = (undef, undef, undef); }
	
	push @{$_[0]->_history->[0]}, $tmp[0]; 
	push @{$_[0]->_history->[1]}, $tmp[1];
	push @{$_[0]->_history->[2]}, $tmp[2];
	return 1;
}
#=======================================================================
sub inject {
	my ($self, $candidates) = @_;
	
	for(@$candidates){
		push @{$self->chromosomes}, 
			AI::Genetic::Pro::Chromosome->new_from_data($self->_translations, $self->type, $self->_package, $_, $self->_fix_range);
		$self->_fitness->{$#{$self->chromosomes}} = $self->fitness()->($self, $self->chromosomes->[-1]);

	}			
	$self->_strict( [ ] );
	$self->population( $self->population + scalar( @$candidates ) );

	return 1;
}
#=======================================================================
sub _state {
	my ( $self ) = @_;
	
	my @res;
	
	if( $self->_package ){
		@res = map { 
			[
				${ tied( @{ $self->chromosomes->[ $_ ] } ) },
				$self->_fitness->{ $_ },
			]
		} 0 .. $self->population - 1
	}else{
		@res = map { 
			[
				$self->chromosomes->[ $_ ],
				$self->_fitness->{ $_ },
			]
		} 0 .. $self->population - 1
	}
	
	return \@res;
}
#=======================================================================
sub evolve {
	my ($self, $generations) = @_;

	# generations must be defined
	$generations ||= -1; 	 
	
	if($self->strict and $self->_strict){
		for my $idx (0..$#{$self->chromosomes}){
			croak(q/Chromosomes was modified outside the 'evolve' function!/) unless $self->chromosomes->[$idx] and $self->_strict->[$idx];
			my @tmp0 = @{$self->chromosomes->[$idx]};
			my @tmp1 = @{$self->_strict->[$idx]};
			croak(qq/Chromosome was modified outside the 'evolve' function from "@tmp0" to "@tmp1"!/) unless compare(\@tmp0, \@tmp1);
		}
	}
	
	# split into two loops just for speed
	unless($self->preserve){
		for(my $i = 0; $i != $generations; $i++){
			# terminate ----------------------------------------------------
			last if $self->terminate and $self->terminate->($self);
			# update generation --------------------------------------------
			$self->generation($self->generation + 1);
			# update history -----------------------------------------------
			$self->_save_history;
			# selection ----------------------------------------------------
			$self->_select_parents();
			# crossover ----------------------------------------------------
			$self->_crossover();
			# mutation -----------------------------------------------------
			$self->_mutation();
		}
	}else{
		croak('You cannot preserve more chromosomes than is in population!') if $self->preserve > $self->population;
		my @preserved;
		for(my $i = 0; $i != $generations; $i++){
			# terminate ----------------------------------------------------
			last if $self->terminate and $self->terminate->($self);
			# update generation --------------------------------------------
			$self->generation($self->generation + 1);
			# update history -----------------------------------------------
			$self->_save_history;
			#---------------------------------------------------------------
			# preservation of N unique chromosomes
			@preserved = map { clone($_) } @{ $self->getFittest_as_arrayref($self->preserve - 1, 1) };
			# selection ----------------------------------------------------
			$self->_select_parents();
			# crossover ----------------------------------------------------
			$self->_crossover();
			# mutation -----------------------------------------------------
			$self->_mutation();
			#---------------------------------------------------------------
			for(@preserved){
				my $idx = int rand @{$self->chromosomes};
				$self->chromosomes->[$idx] = $_;
				$self->_fitness->{$idx} = $self->fitness()->($self, $_);
			}
		}
	}
	
	if($self->strict){
		$self->_strict( [ ] );
		push @{$self->_strict}, $_->clone for @{$self->chromosomes};
	}
}
#=======================================================================
# ALIASES ##############################################################
#=======================================================================
sub people { $_[0]->chromosomes() }
#=======================================================================
sub getHistory { $_[0]->_history()  }
#=======================================================================
sub mutProb { shift->mutation(@_) }
#=======================================================================
sub crossProb { shift->crossover(@_) }
#=======================================================================
sub intType { shift->type() }
#=======================================================================
# STATS ################################################################
#=======================================================================
sub getFittest_as_arrayref { 
	my ($self, $n, $uniq) = @_;
	$n ||= 1;
	
	$self->_calculate_fitness_all() unless scalar %{ $self->_fitness };
	my @keys = sort { $self->_fitness->{$a} <=> $self->_fitness->{$b} } 0..$#{$self->chromosomes};
	
	if($uniq){
		my %grep;
		my $chromosomes = $self->chromosomes;
		if( my $pkg = $self->_package ){
			my %tmp;
			@keys = grep { 
				my $key = ${ tied( @{ $chromosomes->[ $_ ] } ) };
				#my $key = md5_hex( ${ tied( @{ $chromosomes->[ $_ ] } ) } ); # ?
				$tmp{ $key } && 0 or $tmp{ $key } = 1;
			} @keys;
			#@keys = grep { 
			#		my $add_to_list = 0;
			#		my $key = md5_hex(${tied(@{$chromosomes->[$_]})});
			#		unless($grep{$key}) { 
			#			$grep{$key} = 1; 
			#			$add_to_list = 1;
			#		}
			#		$add_to_list;
			#	} @keys;
		}else{
			my %tmp;
			@keys = grep { 
				my $key = md5_hex( join( q[:], @{ $chromosomes->[ $_ ] } ) );
				$tmp{ $key } && 0 or $tmp{ $key } = 1;
			} @keys;
		}
	}
	
	$n = scalar @keys if $n > scalar @keys;
	return [ reverse @{$self->chromosomes}[ splice @keys, $#keys - $n + 1, $n ] ];
}
#=======================================================================
sub getFittest { return wantarray ? @{ shift->getFittest_as_arrayref(@_) } : shift @{ shift->getFittest_as_arrayref(@_) }; }
#=======================================================================
sub getAvgFitness {
	my ($self) = @_;
	
	my @minmax = minmax values %{$self->_fitness};
	my $mean = sum(values %{$self->_fitness}) / scalar values %{$self->_fitness};
	return $minmax[1], int($mean), $minmax[0];
}
#=======================================================================
1;


__END__

=head1 NAME

AI::Genetic::Pro - Efficient genetic algorithms for professional purpose with support for multiprocessing.

=head1 SYNOPSIS

    use AI::Genetic::Pro;
    
    sub fitness {
        my ($ga, $chromosome) = @_;
        return oct('0b' . $ga->as_string($chromosome)); 
    }
    
    sub terminate {
        my ($ga) = @_;
        my $result = oct('0b' . $ga->as_string($ga->getFittest));
        return $result == 4294967295 ? 1 : 0;
    }
    
    my $ga = AI::Genetic::Pro->new(        
        -fitness         => \&fitness,        # fitness function
        -terminate       => \&terminate,      # terminate function
        -type            => 'bitvector',      # type of chromosomes
        -population      => 1000,             # population
        -crossover       => 0.9,              # probab. of crossover
        -mutation        => 0.01,             # probab. of mutation
        -parents         => 2,                # number  of parents
        -selection       => [ 'Roulette' ],   # selection strategy
        -strategy        => [ 'Points', 2 ],  # crossover strategy
        -cache           => 0,                # cache results
        -history         => 1,                # remember best results
        -preserve        => 3,                # remember the bests
        -variable_length => 1,                # turn variable length ON
        -mce             => 1,                # optional MCE support
        -workers         => 3,                # number of workers (MCE)
    );
	
    # init population of 32-bit vectors
    $ga->init(32);
	
    # evolve 10 generations
    $ga->evolve(10);
    
    # best score
    print "SCORE: ", $ga->as_value($ga->getFittest), ".\n";
    
    # save evolution path as a chart
    $ga->chart(-filename => 'evolution.png');
     
    # save state of GA
    $ga->save('genetic.sga');
    
    # load state of GA
    $ga->load('genetic.sga');

=head1 DESCRIPTION

This module provides efficient implementation of a genetic algorithm for
professional purpose with support for multiprocessing. It was designed to operate as fast as possible
even on very large populations and big individuals/chromosomes. C<AI::Genetic::Pro> 
was inspired by C<AI::Genetic>, so it is in most cases compatible 
(there are some changes). Additionally C<AI::Genetic::Pro> isn't a pure Perl solution, so it 
doesn't have limitations of its ancestor (such as slow-down in the
case of big populations ( >10000 ) or vectors with more than 33 fields).

If You are looking for a pure Perl solution, consider L<AI::Genetic>.

=over 4

=item Speed

To increase speed XS code is used, however with portability in 
mind. This distribution was tested on Windows and Linux platforms 
(and should work on any other).

Multicore support is available through Many-Core Engine (C<MCE>). 
You can gain the most speed up for big populations or time/CPU consuming 
fitness functions, however for small populations and/or simple fitness 
function better choice will be single-process version.

You can get even more speed up if you turn on use of native arrays 
(parameter: C<native>) instead of packing chromosomes into single scalar. 
However you have to remember about expensive memory use in that case.

=item Memory

This module was designed to use as little memory as possible. A population
of size 10000 consisting of 92-bit vectors uses only ~24MB (C<AI::Genetic> 
would use about 78MB). However - if you use MCE - there will be bigger 
memory consumption. This is consequence of necessity of synchronization 
between many processes.

=item Advanced options

To provide more flexibility C<AI::Genetic::Pro> supports many 
statistical distributions, such as C<uniform>, C<natural>, C<chi_square>
and others. This feature can be used in selection and/or crossover. See
the documentation below.

=back

=head1 METHODS

=over 4

=item I<$ga>-E<gt>B<new>( %options )

Constructor. It accepts options in hash-value style. See options and 
an example below.

=over 8

=item -fitness

This defines a I<fitness> function. It expects a reference to a subroutine.

=item -terminate 

This defines a I<terminate> function. It expects a reference to a subroutine.

=item -type

This defines the type of chromosomes. Currently, C<AI::Genetic::Pro> supports four types:

=over 12

=item bitvector

Individuals/chromosomes of this type have genes that are bits. Each gene can be in one of two possible states, on or off.

=item listvector

Each gene of a "listvector" individual/chromosome can assume one string value from a specified list of possible string values.

=item rangevector

Each gene of a "rangevector" individual/chromosome can assume one integer 
value from a range of possible integer values. Note that only integers 
are supported. The user can always transform any desired fractional values 
by multiplying and dividing by an appropriate power of 10.

=item combination

Each gene of a "combination" individual/chromosome can assume one string value from a specified list of possible string values. B<All genes are unique.>

=back

=item -population

This defines the size of the population, i.e. how many chromosomes
simultaneously exist at each generation.

=item -crossover 

This defines the crossover rate. The fairest results are achieved with
crossover rate ~0.95.

=item -mutation 

This defines the mutation rate. The fairest results are achieved with mutation
rate ~0.01.

=item -preserve

This defines injection of the bests chromosomes into a next generation. It causes a little slow down, however (very often) much better results are achieved. You can specify, how many chromosomes will be preserved, i.e.

    -preserve => 1, # only one chromosome will be preserved
    # or
    -preserve => 9, # 9 chromosomes will be preserved
    # and so on...

Attention! You cannot preserve more chromosomes than exist in your population.

=item -variable_length

This defines whether variable-length chromosomes are turned on (default off)
and a which types of mutation are allowed. See below.

=over 8

=item level 0

Feature is inactive (default). Example:

	-variable_length => 0
	
    # chromosomes (i.e. bitvectors)
    0 1 0 0 1 1 0 1 1 1 0 1 0 1
    0 0 1 1 0 1 1 1 1 0 0 1 1 0
    0 1 1 1 0 1 0 0 1 1 0 1 1 1
    0 1 0 0 1 1 0 1 1 1 1 0 1 0
    # ...and so on

=item level 1 

Feature is active, but chromosomes can varies B<only on the right side>, Example:

	-variable_length => 1
	
    # chromosomes (i.e. bitvectors)
    0 1 0 0 1 1 0 1 1 1 
    0 0 1 1 0 1 1 1 1
    0 1 1 1 0 1 0 0 1 1 0 1 1 1
    0 1 0 0 1 1 0 1 1 1
    # ...and so on
	
=item level 2 

Feature is active and chromosomes can varies B<on the left side and on 
the right side>; unwanted values/genes on the left side are replaced with C<undef>, ie.
 
	-variable_length => 2
 
    # chromosomes (i.e. bitvectors)
    x x x 0 1 1 0 1 1 1 
    x x x x 0 1 1 1 1
    x 1 1 1 0 1 0 0 1 1 0 1 1 1
    0 1 0 0 1 1 0 1 1 1
    # where 'x' means 'undef'
    # ...and so on

In this situation returned chromosomes in an array context ($ga-E<gt>as_array($chromosome)) 
can have B<undef> values on the left side (only). In a scalar context each 
undefined value is replaced with a single space. If You don't want to see
any C<undef> or space, just use C<as_array_def_only> and C<as_string_def_only> 
instead of C<as_array> and C<as_string>.

=back

=item -parents  

This defines how many parents should be used in a crossover.

=item -selection

This defines how individuals/chromosomes are selected to crossover. It expects an array reference listed below:

    -selection => [ $type, @params ]

where type is one of:

=over 8

=item B<RouletteBasic>

Each individual/chromosome can be selected with probability proportional to its fitness.

=item B<Roulette>

First the best individuals/chromosomes are selected. From this collection
parents are selected with probability poportional to their fitness.

=item B<RouletteDistribution>

Each individual/chromosome has a portion of roulette wheel proportional to its
fitness. Selection is done with the specified distribution. Supported
distributions and parameters are listed below.

=over 12

=item C<-selection =E<gt> [ 'RouletteDistribution', 'uniform' ]>

Standard uniform distribution. No additional parameters are needed.

=item C<-selection =E<gt> [ 'RouletteDistribution', 'normal', $av, $sd ]>

Normal distribution, where C<$av> is average (default: size of population /2) and $C<$sd> is standard deviation (default: size of population).


=item C<-selection =E<gt> [ 'RouletteDistribution', 'beta', $aa, $bb ]>

I<Beta> distribution.  The density of the beta is:

    X^($aa - 1) * (1 - X)^($bb - 1) / B($aa , $bb) for 0 < X < 1.

C<$aa> and C<$bb> are set by default to number of parents.

B<Argument restrictions:> Both $aa and $bb must not be less than 1.0E-37.

=item C<-selection =E<gt> [ 'RouletteDistribution', 'binomial' ]>

Binomial distribution. No additional parameters are needed.

=item C<-selection =E<gt> [ 'RouletteDistribution', 'chi_square', $df ]>

Chi-square distribution with C<$df> degrees of freedom. C<$df> by default is set to size of population.

=item C<-selection =E<gt> [ 'RouletteDistribution', 'exponential', $av ]>

Exponential distribution, where C<$av> is average . C<$av> by default is set to size of population.

=item C<-selection =E<gt> [ 'RouletteDistribution', 'poisson', $mu ]>

Poisson distribution, where C<$mu> is mean. C<$mu> by default is set to size of population.

=back

=item B<Distribution>

Chromosomes/individuals are selected with specified distribution. See below.

=over 12

=item C<-selection =E<gt> [ 'Distribution', 'uniform' ]>

Standard uniform distribution. No additional parameters are needed.

=item C<-selection =E<gt> [ 'Distribution', 'normal', $av, $sd ]>

Normal distribution, where C<$av> is average (default: size of population /2) and $C<$sd> is standard deviation (default: size of population).

=item C<-selection =E<gt> [ 'Distribution', 'beta', $aa, $bb ]>

I<Beta> distribution.  The density of the beta is:

    X^($aa - 1) * (1 - X)^($bb - 1) / B($aa , $bb) for 0 < X < 1.

C<$aa> and C<$bb> are set by default to number of parents.

B<Argument restrictions:> Both $aa and $bb must not be less than 1.0E-37.

=item C<-selection =E<gt> [ 'Distribution', 'binomial' ]>

Binomial distribution. No additional parameters are needed.

=item C<-selection =E<gt> [ 'Distribution', 'chi_square', $df ]>

Chi-square distribution with C<$df> degrees of freedom. C<$df> by default is set to size of population.

=item C<-selection =E<gt> [ 'Distribution', 'exponential', $av ]>

Exponential distribution, where C<$av> is average . C<$av> by default is set to size of population.

=item C<-selection =E<gt> [ 'Distribution', 'poisson', $mu ]>

Poisson distribution, where C<$mu> is mean. C<$mu> by default is set to size of population.

=back

=back

=item -strategy 

This defines the astrategy of crossover operation. It expects an array
reference listed below:

    -strategy => [ $type, @params ]

where type is one of:

=over 4

=item PointsSimple

Simple crossover in one or many points. The best chromosomes/individuals are
selected for the new generation. For example:

    -strategy => [ 'PointsSimple', $n ]

where C<$n> is the number of points for crossing.

=item PointsBasic

Crossover in one or many points. In basic crossover selected parents are
crossed and one (randomly-chosen) child is moved to the new generation. For
example:

    -strategy => [ 'PointsBasic', $n ]

where C<$n> is the number of points for crossing.

=item Points

Crossover in one or many points. In normal crossover selected parents are crossed and the best child is moved to the new generation. For example:

    -strategy => [ 'Points', $n ]

where C<$n> is number of points for crossing.

=item PointsAdvenced

Crossover in one or many points. After crossover the best
chromosomes/individuals from all parents and chidren are selected for the  new
generation. For example:

    -strategy => [ 'PointsAdvanced', $n ]

where C<$n> is the number of points for crossing.

=item Distribution

In I<distribution> crossover parents are crossed in points selected with the
specified distribution. See below.

=over 8

=item C<-strategy =E<gt> [ 'Distribution', 'uniform' ]>

Standard uniform distribution. No additional parameters are needed.

=item C<-strategy =E<gt> [ 'Distribution', 'normal', $av, $sd ]>

Normal distribution, where C<$av> is average (default: number of parents/2) and C<$sd> is standard deviation (default: number of parents).

=item C<-strategy =E<gt> [ 'Distribution', 'beta', $aa, $bb ]>

I<Beta> distribution.  The density of the beta is:

    X^($aa - 1) * (1 - X)^($bb - 1) / B($aa , $bb) for 0 < X < 1.

C<$aa> and C<$bb> are set by default to the number of parents.

B<Argument restrictions:> Both $aa and $bb must not be less than 1.0E-37.

=item C<-strategy =E<gt> [ 'Distribution', 'binomial' ]>

Binomial distribution. No additional parameters are needed.

=item C<-strategy =E<gt> [ 'Distribution', 'chi_square', $df ]>

Chi-squared distribution with C<$df> degrees of freedom. C<$df> by default is set to the number of parents.

=item C<-strategy =E<gt> [ 'Distribution', 'exponential', $av ]>

Exponential distribution, where C<$av> is average . C<$av> by default is set to the number of parents.

=item C<-strategy =E<gt> [ 'Distribution', 'poisson', $mu ]>

Poisson distribution, where C<$mu> is mean. C<$mu> by default is set to the number of parents.

=back

=item PMX

PMX method defined by Goldberg and Lingle in 1985. Parameters: I<none>.

=item OX

OX method defined by Davis (?) in 1985. Parameters: I<none>.

=back

=item -cache    

This defines whether a cache should be used. Allowed values are 1 or 0
(default: I<0>).

=item -history 

This defines whether history should be collected. Allowed values are 1 or 0 (default: I<0>).

=item -native 

This defines whether native arrays should be used instead of packing each chromosome into signle scalar. 
Turning this option can give you speed up, but much more memory will be used. Allowed values are 1 or 0 (default: I<0>).

=item -mce

This defines whether Many-Core Engine (MCE) should be used during processing. 
This can give you significant speed up on many-core/CPU systems, but it'll 
increase memory consumption. Allowed values are 1 or 0 (default: I<0>).

=item -workers

This option has any meaning only if MCE is turned on. This defines how 
many process will be used during processing. Default will be used one proces per core (most efficient).

=item -strict

This defines if the check for modifying chromosomes in a user-defined fitness
function is active. Directly modifying chromosomes is not allowed and it is 
a highway to big trouble. This mode should be used only for testing, because it is B<slow>.

=back

=item I<$ga>-E<gt>B<inject>($chromosomes)

Inject new, user defined, chromosomes into the current population. See example below:

    # example for bitvector
    my $chromosomes = [
        [ 1, 1, 0, 1, 0, 1 ],
        [ 0, 0, 0, 1, 0, 1 ],
        [ 0, 1, 0, 1, 0, 0 ],
        ...
    ];
    
    # inject
    $ga->inject($chromosomes);

If You want to delete some chromosomes from population, just C<splice> them:

    my @remove = qw(1 2 3 9 12);
	for my $idx (sort { $b <=> $a }  @remove){
        splice @{$ga->chromosomes}, $idx, 1;
    }

=item I<$ga>-E<gt>B<population>($population)

Set/get size of the population. This defines the size of the population, i.e. how many chromosomes to simultaneously exist at each generation.

=item I<$ga>-E<gt>B<indType>()

Get type of individuals/chromosomes. Currently supported types are:

=over 4

=item C<bitvector>

Chromosomes will be just bitvectors. See documentation of C<new> method.

=item C<listvector>

Chromosomes will be lists of specified values. See documentation of C<new> method.

=item C<rangevector>

Chromosomes will be lists of values from specified range. See documentation of C<new> method.

=item C<combination>

Chromosomes will be unique lists of specified values. This is used for example
in the I<Traveling Salesman Problem>. See the documentation of the C<new>
method.

=back

In example:

    my $type = $ga->type();

=item I<$ga>-E<gt>B<type>()

Alias for C<indType>.

=item I<$ga>-E<gt>B<crossProb>()

This method is used to query and set the crossover rate.

=item I<$ga>-E<gt>B<crossover>()

Alias for C<crossProb>.

=item I<$ga>-E<gt>B<mutProb>()

This method is used to query and set the mutation rate.

=item I<$ga>-E<gt>B<mutation>()

Alias for C<mutProb>.

=item I<$ga>-E<gt>B<parents>($parents)

Set/get number of parents in a crossover.

=item I<$ga>-E<gt>B<init>($args)

This method initializes the population with random individuals/chromosomes. It MUST be called before any call to C<evolve()>. It expects one argument, which depends on the type of individuals/chromosomes:

=over 4

=item B<bitvector>

For bitvectors, the argument is simply the length of the bitvector.

    $ga->init(10);

This initializes a population where each individual/chromosome has 10 genes.

=item B<listvector>

For listvectors, the argument is an anonymous list of lists. The number of sub-lists is equal to the number of genes of each individual/chromosome. Each sub-list defines the possible string values that the corresponding gene can assume.

    $ga->init([
               [qw/red blue green/],
               [qw/big medium small/],
               [qw/very_fat fat fit thin very_thin/],
              ]);

This initializes a population where each individual/chromosome has 3 genes and each gene can assume one of the given values.

=item B<rangevector>

For rangevectors, the argument is an anonymous list of lists. The number of sub-lists is equal to the number of genes of each individual/chromosome. Each sub-list defines the minimum and maximum integer values that the corresponding gene can assume.

    $ga->init([
               [1, 5],
               [0, 20],
               [4, 9],
              ]);

This initializes a population where each individual/chromosome has 3 genes and each gene can assume an integer within the corresponding range.

=item B<combination>

For combination, the argument is an anonymous list of possible values of gene.

    $ga->init( [ 'a', 'b', 'c' ] );

This initializes a population where each chromosome has 3 genes and each gene
is a unique combination of 'a', 'b' and 'c'. For example genes looks something
like that:

    [ 'a', 'b', 'c' ]    # gene 1
    [ 'c', 'a', 'b' ]    # gene 2
    [ 'b', 'c', 'a' ]    # gene 3
    # ...and so on...

=back

=item I<$ga>-E<gt>B<evolve>($n)

This method causes the GA to evolve the population for the specified number of
generations. If its argument is 0 or C<undef> GA will evolve the population to
infinity unless a C<terminate> function is specified.

=item I<$ga>-E<gt>B<getHistory>()

Get history of the evolution. It is in a format listed below:

	[
		# gen0   gen1   gen2   ...          # generations
		[ max0,  max1,  max2,  ... ],       # max values
		[ mean,  mean1, mean2, ... ],       # mean values
		[ min0,  min1,  min2,  ... ],       # min values
	]

=item I<$ga>-E<gt>B<getAvgFitness>()

Get I<max>, I<mean> and I<min> score of the current generation. In example:

    my ($max, $mean, $min) = $ga->getAvgFitness();

=item I<$ga>-E<gt>B<getFittest>($n, $unique)

This function returns a list of the fittest chromosomes from the current
population.  You can specify how many chromosomes should be returned and if
the returned chromosomes should be unique. See example below.

    # only one - the best
    my ($best) = $ga->getFittest;

    # or 5 bests chromosomes, NOT unique
    my @bests = $ga->getFittest(5);

    # or 7 bests and UNIQUE chromosomes
    my @bests = $ga->getFittest(7, 1);

If you want to get a large number of chromosomes, try to use the
C<getFittest_as_arrayref> function instead (for efficiency).

=item I<$ga>-E<gt>B<getFittest_as_arrayref>($n, $unique)

This function is very similar to C<getFittest>, but it returns a reference 
to an array instead of a list. 

=item I<$ga>-E<gt>B<generation>()

Get the number of the current generation.

=item I<$ga>-E<gt>B<people>()

Returns an anonymous list of individuals/chromosomes of the current population. 

B<IMPORTANT:> the actual array reference used by the C<AI::Genetic::Pro> 
object is returned, so any changes to it will be reflected in I<$ga>.

=item I<$ga>-E<gt>B<chromosomes>()

Alias for C<people>.

=item I<$ga>-E<gt>B<chart>(%options)

Generate a chart describing changes of min, mean, and max scores in your
population. To satisfy your needs, you can pass the following options:

=over 4

=item -filename

File to save a chart in (B<obligatory>).

=item -title

Title of a chart (default: I<Evolution>).

=item -x_label

X label (default: I<Generations>).

=item -y_label

Y label (default: I<Value>).

=item -format

Format of values, like C<sprintf> (default: I<'%.2f'>).

=item -legend1

Description of min line (default: I<Min value>).

=item -legend2

Description of min line (default: I<Mean value>).

=item -legend3

Description of min line (default: I<Max value>).

=item -width

Width of a chart (default: I<640>).

=item -height

Height of a chart (default: I<480>).

=item -font

Path to font (in *.ttf format) to be used (default: none).

=item -logo

Path to logo (png/jpg image) to embed in a chart (default: none).

=item For example:

	$ga->chart(-width => 480, height => 320, -filename => 'chart.png');

=back

=item I<$ga>-E<gt>B<save>($file)

Save the current state of the genetic algorithm to the specified file.

=item I<$ga>-E<gt>B<load>($file)

Load a state of the genetic algorithm from the specified file. 

=item I<$ga>-E<gt>B<as_array>($chromosome)

In list context return an array representing the specified chromosome. 
In scalar context return an reference to an array representing the specified 
chromosome. If I<variable_length> is turned on and is set to level 2, an array 
can have some C<undef> values. To get only C<not undef> values use 
C<as_array_def_only> instead of C<as_array>.

=item I<$ga>-E<gt>B<as_array_def_only>($chromosome)

In list context return an array representing the specified chromosome. 
In scalar context return an reference to an array representing the specified 
chromosome. If I<variable_length> is turned off, this function is just an
alias for C<as_array>. If I<variable_length> is turned on and is set to 
level 2, this function will return only C<not undef> values from chromosome. 
See example below:

    # -variable_length => 2, -type => 'bitvector'
	
    my @chromosome = $ga->as_array($chromosome)
    # @chromosome looks something like that
    # ( undef, undef, undef, 1, 0, 1, 1, 1, 0 )
	
    @chromosome = $ga->as_array_def_only($chromosome)
    # @chromosome looks something like that
    # ( 1, 0, 1, 1, 1, 0 )

=item I<$ga>-E<gt>B<as_string>($chromosome)

Return a string representation of the specified chromosome. See example below:

	# -type => 'bitvector'
	
	my $string = $ga->as_string($chromosome);
	# $string looks something like that
	# 1___0___1___1___1___0 
	
	# or 
	
	# -type => 'listvector'
	
	$string = $ga->as_string($chromosome);
	# $string looks something like that
	# element0___element1___element2___element3...

Attention! If I<variable_length> is turned on and is set to level 2, it is 
possible to get C<undef> values on the left side of the vector. In the returned
string C<undef> values will be replaced with B<spaces>. If you don't want
to see any I<spaces>, use C<as_string_def_only> instead of C<as_string>.

=item I<$ga>-E<gt>B<as_string_def_only>($chromosome)

Return a string representation of specified chromosome. If I<variable_length> 
is turned off, this function is just alias for C<as_string>. If I<variable_length> 
is turned on and is set to level 2, this function will return a string without
C<undef> values. See example below:

	# -variable_length => 2, -type => 'bitvector'
	
	my $string = $ga->as_string($chromosome);
	# $string looks something like that
	#  ___ ___ ___1___1___0 
	
	$string = $ga->as_string_def_only($chromosome);
	# $string looks something like that
	# 1___1___0 

=item I<$ga>-E<gt>B<as_value>($chromosome)

Return the score of the specified chromosome. The value of I<chromosome> is 
calculated by the fitness function.

=back

=head1 SUPPORT

C<AI::Genetic::Pro> is still under development; however, it is used in many
production environments.

=head1 TODO

=over 4

=item Examples.

=item More tests.

=item More warnings about incorrect parameters.

=back

=head1 REPORTING BUGS

When reporting bugs/problems please include as much information as possible.
It may be difficult for me to reproduce the problem as almost every setup
is different.

A small script which yields the problem will probably be of help. 

=head1 THANKS

Mario Roy for suggestions about efficiency.

Miles Gould for suggestions and some fixes (even in this documentation! :-).

Alun Jones for fixing memory leaks.

Tod Hagan for reporting a bug (rangevector values truncated to signed  8-bit quantities) and supplying a patch.

Randal L. Schwartz for reporting a bug in this documentation.

Maciej Misiak for reporting problems with C<combination> (and a bug in a PMX strategy).

LEONID ZAMDBORG for recommending the addition of variable-length chromosomes as well as supplying relevant code samples, for testing and at the end reporting some bugs.

Christoph Meissner for reporting a bug.

Alec Chen for reporting some bugs.

=head1 AUTHOR

Strzelecki Lukasz <lukasz@strzeleccy.eu>

=head1 SEE ALSO

L<AI::Genetic>
L<Algorithm::Evolutionary>

=head1 COPYRIGHT

Copyright (c) Strzelecki Lukasz. All rights reserved.
This program is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.

=cut

lib/AI/Genetic/Pro/Array/Type.pm  view on Meta::CPAN

package AI::Genetic::Pro::Array::Type;
$AI::Genetic::Pro::Array::Type::VERSION = '1.009';
use warnings;
use strict;
use Exporter::Lite;
use Tie::Array::Packed;
#=======================================================================
our @EXPORT_OK = qw(
	get_package_by_element_size
	get_array_ref_by_element_size
);
#-----------------------------------------------------------------------
our $Native = 0;
#=======================================================================
sub get_package_by_element_size {
	return if $Native;
	
	my $size = shift;
	
	my $type =	#$size <			   32	? undef										:	#  Pure Perl array
				#$size <			   32	? 'AI::Genetic::Pro::Array::Tied'			:	#  Pure Perl array
			 	$size <     		  128	? 'Tie::Array::Packed::Char'				: 	#  8 bits
				$size <     		  256	? 'Tie::Array::Packed::UnsignedChar'		:	#  8 bits
				$size <  		   65_537	? 'Tie::Array::Packed::ShortNative'			:	# 16 bits
				$size < 		  131_073	? 'Tie::Array::Packed::UnsignedShortNative'	:	# 16 bits
				$size < 	2_147_483_648	? 'Tie::Array::Packed::Integer'				:	# 32 bits
				$size < 	4_294_967_297	? 'Tie::Array::Packed::UnsignedInteger'		:	# 32 bits; MAX
				undef;
				
	return unless $type;
	return $type;
}
#=======================================================================
sub get_array_ref_by_element_size {
	my $package = get_package_by_element_size(shift);
	my @array;
	tie @array, $package if $package;
	return \@array;
}
#=======================================================================
1;

lib/AI/Genetic/Pro/Chromosome.pm  view on Meta::CPAN

package AI::Genetic::Pro::Chromosome;
$AI::Genetic::Pro::Chromosome::VERSION = '1.009';
use warnings;
use strict;
use List::Util qw(shuffle first);
use List::MoreUtils qw(first_index);
use Tie::Array::Packed;
#use Math::Random qw(random_uniform_integer);
#=======================================================================
sub new {
	my ($class, $data, $type, $package, $length) = @_;

	my @genes;	
	tie @genes, $package if $package;
	
	if($type eq q/bitvector/){
		#@genes = random_uniform_integer(scalar @$data, 0, 1); 			# this is fastest, but uses more memory
		@genes = map { rand > 0.5 ? 1 : 0 } 0..$length;					# this is faster
		#@genes =  split(q//, unpack("b*", rand 99999), $#$data + 1);	# slow
	}elsif($type eq q/combination/){ 
		#@genes = shuffle 0..$#{$data->[0]}; 
		@genes = shuffle 0..$length; 
	}elsif($type eq q/rangevector/){
  		@genes = map { $_->[1] + int rand($_->[2] - $_->[1] + 1) } @$data[0..$length];
	}else{ 
		@genes = map { 1 + int(rand( $#{ $data->[$_] })) } 0..$length; 
	}

	return bless \@genes, $class;
}
#=======================================================================
sub new_from_data {
	my ($class, $data, $type, $package, $values, $fix_range) = @_;

	die qq/\nToo many elements in the injected chromosome of type "$type": @$values\n/ if $#$values > $#$data;

	my @genes;	
	tie @genes, $package if $package;
	
	if($type eq q/bitvector/){ 
		die qq/\nInproper value in the injected chromosome of type "$type": @$values\n/ 
			if first { not defined $_ or ($_ != 0 and $_ != 1) } @$values;
		@genes = @$values; 
	}elsif($type eq q/combination/){
		die qq/\nToo few elements in the injected chromosome of type "$type": @$values\n/ 
			if $#$values != $#{$data->[0]};
		for my $idx(0..$#$values){
			my $id = first_index { $_ eq $values->[$idx] } @{$data->[0]};	# pomijamy poczatkowy undef
			die qq/\nInproper element in the injected chromosome of type "$type": @$values\n/ if $id == -1;
			push @genes, $id;
		}
	}elsif($type eq q/rangevector/){
		for my $idx(0..$#$values){
			if(defined $values->[$idx]){
				my $min = $data->[$idx]->[1] - $fix_range->[$idx];
				my $max = $data->[$idx]->[2] - $fix_range->[$idx];
				die qq/\nValue out of scope in the injected chromosome of type "$type": @$values\n/ 
					if $values->[$idx] > $max or $values->[$idx] < $min;
				push @genes, $values->[$idx] + $fix_range->[$idx];
			}else{ push @genes, 0; }
		}
	}else{
		for my $idx(0..$#$values){
			my $id = first_index { 
				not defined $values->[$idx] and not defined $_ or 
				defined $_ and defined $values->[$idx] and $_ eq $values->[$idx] 
					} @{$data->[$idx]};	# pomijamy poczatkowy undef
			die qq/\nInproper element in the injected chromosome of type "$type": @$values\n/ if $id == -1;
			push @genes, $id;
		}
	}
	
	return bless \@genes, $class;
}
#=======================================================================
sub clone
{
	my ( $self ) = @_;
	
	my $cln;
	if( my $obj = tied( @$self ) ){
		$cln = $obj->make_clone;
	}else{
		@$cln = @$self;
	}
	
	return bless( $cln );
	
	#my $genes = tied(@{$self})->make_clone;
	#return bless($genes);
}

#=======================================================================
1;

lib/AI/Genetic/Pro/Crossover/Distribution.pm  view on Meta::CPAN

package AI::Genetic::Pro::Crossover::Distribution;
$AI::Genetic::Pro::Crossover::Distribution::VERSION = '1.009';
use warnings;
use strict;
#use Data::Dumper; $Data::Dumper::Sortkeys = 1;
use Math::Random qw(
	random_uniform_integer 
	random_normal 
	random_beta
	random_binomial
	random_chi_square
	random_exponential
	random_poisson
);
use List::MoreUtils qw(first_index);
#=======================================================================
sub new { 
	my ($class, $type, @params) = @_;
	bless { 
			type 	=> $type,
			params	=> \@params,
		}, $class; 
}
#=======================================================================
sub run {
	my ($self, $ga) = @_;
	
	my ($chromosomes, $parents, $crossover) = ($ga->chromosomes, $ga->_parents, $ga->crossover);
	my ($fitness, $_fitness) = ($ga->fitness, $ga->_fitness);
	my $high  = scalar @{$chromosomes->[0]};
	my @children;
	#-------------------------------------------------------------------
	while(my $elders = shift @$parents){
		my @elders = unpack 'I*', $elders;
		
		unless(scalar @elders){
			$_fitness->{scalar(@children)} = $fitness->($ga, $chromosomes->[$elders[0]]);
			push @children, $chromosomes->[$elders[0]];
			next;
		}
		
		#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
		my $len = scalar @elders;
		my @seq;
		if($self->{type} eq q/uniform/){
			@seq = random_uniform_integer($high, 0, $#elders);
		}elsif($self->{type} eq q/normal/){
			my $av = defined $self->{params}->[0] ? $self->{params}->[0] : $len/2;
			my $sd = defined $self->{params}->[1] ? $self->{params}->[1] : $len;
			@seq = map { $_ % $len } random_normal($high, $av, $sd);
		}elsif($self->{type} eq q/beta/){
			my $aa = defined $self->{params}->[0] ? $self->{params}->[0] : $len;
			my $bb = defined $self->{params}->[1] ? $self->{params}->[1] : $len;
			@seq = map { int($_ * $len) } random_beta($high, $aa, $bb);
		}elsif($self->{type} eq q/binomial/){
			@seq = random_binomial($high, $#elders, rand);
		}elsif($self->{type} eq q/chi_square/){
			my $df = defined $self->{params}->[0] ? $self->{params}->[0] : $len;
			@seq = map { $_ % $len } random_chi_square($high, $df);
		}elsif($self->{type} eq q/exponential/){
			my $av = defined $self->{params}->[0] ? $self->{params}->[0] : $len/2;
			@seq = map { $_ % $len } random_exponential($high, $av);
		}elsif($self->{type} eq q/poisson/){
			my $mu = defined $self->{params}->[0] ? $self->{params}->[0] : $len/2;
			@seq = map { $_ % $len } random_poisson($high, $mu) ;
		}else{
			die qq/Unknown distribution "$self->{type}" in "crossover"!\n/;
		}
		
		#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
		my ($min, $max) = (0, $#{$chromosomes->[0]} - 1);
		if($ga->variable_length){
			for my $el(@elders){
				my $idx = first_index { $_ } @{$chromosomes->[$el]};
				$min = $idx if $idx > $min;
				$max = $#{$chromosomes->[$el]} if $#{$chromosomes->[$el]} < $max;
			}
		}
		
		$elders[0] = $chromosome->[$elders[0]]->clone;
		for(0..$#seq){
			next if not $seq[$_] or $_ < $min or $_ > $max;
			$elders[0]->[$_] = $chromosomes->[$elders[$seq[$_]]]->[$_];
		}
		#~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
		
		push @children, $elders[ 0 ];
	}
	#-------------------------------------------------------------------
	
	return \@children;
}
#=======================================================================
1;

lib/AI/Genetic/Pro/Crossover/OX.pm  view on Meta::CPAN

package AI::Genetic::Pro::Crossover::OX;
$AI::Genetic::Pro::Crossover::OX::VERSION = '1.009';
use warnings;
use strict;
use List::MoreUtils qw(first_index);
#use Data::Dumper; $Data::Dumper::Sortkeys = 1;
#=======================================================================
sub new { bless \$_[0], $_[0]; }
#=======================================================================
sub save_fitness {
	my ($self, $ga, $idx) = @_;
	$ga->_fitness->{$idx} = $ga->fitness->($ga, $ga->chromosomes->[$idx]);
	return $ga->chromosomes->[$idx];
}
#=======================================================================
sub run {
	my ($self, $ga) = @_;
	
	my ($chromosomes, $parents, $crossover) = ($ga->chromosomes, $ga->_parents, $ga->crossover);
	my ($fitness, $_fitness) = ($ga->fitness, $ga->_fitness);
	my @children;
	#-------------------------------------------------------------------
	while(my $elders = shift @$parents){
		my @elders = unpack 'I*', $elders;
		
		unless(scalar @elders){
			push @children, $chromosomes->[$elders[0]];
			next;
		}
		
		my @points = sort { $a <=> $b } map { 1 + int(rand $#{$chromosomes->[0]}) } 0..1;
		
		@elders = sort {
					my @av = @{$a}[$points[0]..$points[1]];
					my @bv = @{$b}[$points[0]..$points[1]];
					
					for my $e(@av){
						splice(@$b, (first_index { $_ == $e } @$b), 1);
					}
					splice @$b, $points[0], 0, @av;
					
					for my $e(@bv){
						splice(@$a, (first_index { $_ == $e } @$a), 1);
					}
					splice @$a, $points[0], 0, @bv;
					0;
					
						} map { 
							$chromosomes->[$_]->clone;
								} @elders;
		
		
		my %elders = map { $_ => $fitness->($ga, $elders[$_]) } 0..$#elders;
		my $max = (sort { $elders{$a} <=> $elders{$b} } keys %elders)[-1];
		$_fitness->{scalar(@children)} = $elders{$max};
		
		push @children, $elders[$max];
	}
	#-------------------------------------------------------------------
	
	return \@children;
}
#=======================================================================
1;

lib/AI/Genetic/Pro/Crossover/PMX.pm  view on Meta::CPAN

package AI::Genetic::Pro::Crossover::PMX;
$AI::Genetic::Pro::Crossover::PMX::VERSION = '1.009';
use warnings;
use strict;
use List::MoreUtils qw(indexes);
#use Data::Dumper; $Data::Dumper::Sortkeys = 1;
#=======================================================================
sub new { bless \$_[0], $_[0]; }
#=======================================================================
sub dup {
    my ($ar) = @_;

    my %seen;
    my @dup = grep { if($seen{$_}){ 1 }else{ $seen{$_} = 1; 0} } @$ar;
    return \@dup if @dup;
    return;
}
#=======================================================================
sub run {
	my ($self, $ga) = @_;
	
	my ($chromosomes, $parents, $crossover) = ($ga->chromosomes, $ga->_parents, $ga->crossover);
	my ($fitness, $_fitness) = ($ga->fitness, $ga->_fitness);
	my @children;
	#-------------------------------------------------------------------
	while(my $elders = shift @$parents){
		my @elders = unpack 'I*', $elders;
		
		unless(scalar @elders){
			push @children, $chromosomes->[$elders[0]];
			next;
		}
		
		my @points = sort { $a <=> $b } map { 1 + int(rand $#{$chromosomes->[0]}) } 0..1;
		
		@elders = sort {
					my @av = @{$a}[$points[0]..$points[1]-1];
					my @bv = splice @$b, $points[0], $points[1] - $points[0], @av;
					splice @$a, $points[0], $points[1] - $points[0], @bv;
					
					my %av; @av{@av} = @bv;
					my %bv; @bv{@bv} = @av;

					while(my $dup = dup($a)){
    					foreach my $val (@$dup){
        					my ($ind) = grep { $_ < $points[0] or $_ >= $points[1] } indexes { $_ == $val } @$a;
        					$a->[$ind] = $bv{$val};
    					}
					}

					while(my $dup = dup($b)){
    					foreach my $val (@$dup){
        					my ($ind) = grep { $_ < $points[0] or $_ >= $points[1] } indexes { $_ == $val } @$b;
        					$b->[$ind] = $av{$val};
    					}
					}
					
					0;
						} map { 
							$chromosomes->[$_]->clone
								} @elders;
		
		
		my %elders = map { $_ => $fitness->($ga, $elders[$_]) } 0..$#elders;
		my $max = (sort { $elders{$a} <=> $elders{$b} } keys %elders)[-1];
		$_fitness->{scalar(@children)} = $elders{$max};
		
		push @children, $elders[$max];
	}
	#-------------------------------------------------------------------
	
	return \@children;
}
#=======================================================================
1;

lib/AI/Genetic/Pro/Crossover/Points.pm  view on Meta::CPAN

package AI::Genetic::Pro::Crossover::Points;
$AI::Genetic::Pro::Crossover::Points::VERSION = '1.009';
use warnings;
use strict;
use List::MoreUtils qw(first_index);
#use Data::Dumper; $Data::Dumper::Sortkeys = 1;
#=======================================================================
sub new { bless { points => $_[1] ? $_[1] : 1 }, $_[0]; }
#=======================================================================
sub run {
	my ($self, $ga) = @_;
	
	my ($chromosomes, $parents, $crossover) = ($ga->chromosomes, $ga->_parents, $ga->crossover);
	my ($fitness, $_fitness) = ($ga->fitness, $ga->_fitness);
	my @children;
	#-------------------------------------------------------------------
	while(my $elders = shift @$parents){
		my @elders = unpack 'I*', $elders;
		
		unless(scalar @elders){
			$_fitness->{scalar(@children)} = $fitness->($ga, $chromosomes->[$elders[0]]);
			push @children, $chromosomes->[$elders[0]];
			next;
		}

		my ($min, $max) = (0, $#{$chromosomes->[0]});
		if($ga->variable_length){
			for my $el(@elders){
				my $idx = first_index { $_ } @{$chromosomes->[$el]};
				$min = $idx if $idx > $min;
				$max = $#{$chromosomes->[$el]} if $#{$chromosomes->[$el]} < $max;
			}
		}
		
		my @points;
		if($min < $max and $max - $min > 2){
			my $range = $max - $min;
			@points = map { $min + int(rand $range) } 1..$self->{points};
		}

		@elders = map { $chromosomes->[$_]->clone } @elders;
		
		for my $pt(@points){
			@elders = sort {
						splice @$b, 0, $pt, splice( @$a, 0, $pt, @$b[0..$pt-1] );
						0;
							} @elders;
		}
		
		my %elders = map { $_ => $fitness->($ga, $elders[$_]) } 0..$#elders;
		my $maximum = (sort { $elders{$a} <=> $elders{$b} } keys %elders)[-1];
		$_fitness->{scalar(@children)} = $elders{$maximum};
		
		push @children, $elders[$maximum];
	}
	#-------------------------------------------------------------------
	return \@children;
}
#=======================================================================
1;

lib/AI/Genetic/Pro/Crossover/PointsAdvanced.pm  view on Meta::CPAN

package AI::Genetic::Pro::Crossover::PointsAdvanced;
$AI::Genetic::Pro::Crossover::PointsAdvanced::VERSION = '1.009';
use warnings;
use strict;
use List::MoreUtils qw(first_index);
#use Data::Dumper; $Data::Dumper::Sortkeys = 1;
#use AI::Genetic::Pro::Array::PackTemplate;
#=======================================================================
sub new { bless { points => $_[1] ? $_[1] : 1 }, $_[0]; }
#=======================================================================
sub run {
	my ($self, $ga) = @_;
	
	my ($chromosomes, $parents, $crossover) = ($ga->chromosomes, $ga->_parents, $ga->crossover);
	my ($fitness, $_fitness) = ($ga->fitness, $ga->_fitness);
	#-------------------------------------------------------------------
	while(my $elders = shift @$parents){
		my @elders = unpack 'I*', $elders;

		unless(scalar @elders){
			push @$chromosomes, $chromosomes->[$elders[0]];
			next;
		}
	
		my ($min, $max) = (0, $#{$chromosomes->[0]} - 1);
		if($ga->variable_length){
			for my $el(@elders){
				my $idx = first_index { $_ } @{$chromosomes->[$el]};
				$min = $idx if $idx > $min;
				$max = $#{$chromosomes->[$el]} if $#{$chromosomes->[$el]} < $max;
			}
		}
		
		my @points;
		if($min < $max and $max - $min > 2){
			my $range = $max - $min;
			@points = map { $min + int(rand $range) } 1..$self->{points};
		}

		@elders = map { $chromosomes->[$_]->clone } @elders;
		for my $pt(@points){
			@elders = sort {
						splice @$b, 0, $pt, splice( @$a, 0, $pt, @$b[0..$pt-1] );
						0;
							} @elders;
		}
		
		push @$chromosomes, @elders;
	}
	#-------------------------------------------------------------------
	# wybieranie potomkow ze zbioru starych i nowych osobnikow
	@$chromosomes = sort { $fitness->($ga, $a) <=> $fitness->($ga, $b) } @$chromosomes;
	splice @$chromosomes, 0, scalar(@$chromosomes) - $ga->population;
	%$_fitness = map { $_ => $fitness->($ga, $chromosomes->[$_]) } 0..$#$chromosomes;
	#-------------------------------------------------------------------
	return $chromosomes;
}
#=======================================================================
1;

lib/AI/Genetic/Pro/Crossover/PointsBasic.pm  view on Meta::CPAN

package AI::Genetic::Pro::Crossover::PointsBasic;
$AI::Genetic::Pro::Crossover::PointsBasic::VERSION = '1.009';
use warnings;
use strict;
use List::MoreUtils qw(first_index);
#use Data::Dumper; $Data::Dumper::Sortkeys = 1;
#=======================================================================
sub new { bless { points => $_[1] ? $_[1] : 1 }, $_[0]; }
#=======================================================================
sub run {
	my ($self, $ga) = @_;
	
	my ($chromosomes, $parents, $crossover) = ($ga->chromosomes, $ga->_parents, $ga->crossover);
	my ($fitness, $_fitness) = ($ga->fitness, $ga->_fitness);
	my @children;
	#-------------------------------------------------------------------
	while(my $elders = shift @$parents){
		my @elders = unpack 'I*', $elders;
		
		unless(scalar @elders){
			$_fitness->{scalar(@children)} = $fitness->($ga, $chromosomes->[$elders[0]]);
			push @children, $chromosomes->[$elders[0]];
			next;
		}
		
		my ($min, $max) = (0, $#{$chromosomes->[0]} - 1);
		if($ga->variable_length){
			for my $el(@elders){
				my $idx = first_index { $_ } @{$chromosomes->[$el]};
				$min = $idx if $idx > $min;
				$max = $#{$chromosomes->[$el]} if $#{$chromosomes->[$el]} < $max;
			}
		}
		
		my @points;
		if($min < $max and $max - $min > 2){
			my $range = $max - $min;
			@points = map { $min + int(rand $range) } 1..$self->{points};
		}

		@elders = map { $chromosomes->[$_]->clone } @elders;
		for my $pt(@points){
			@elders = sort {
						splice @$b, 0, $pt, splice( @$a, 0, $pt, @$b[0..$pt-1] );
						0;
							} @elders;
		}

		my $idx = int rand @elders;
		$_fitness->{scalar(@children)} = $fitness->($ga, $elders[$idx]);
		push @children, $elders[ $idx ];
	}
	#-------------------------------------------------------------------
	
	return \@children;
}
#=======================================================================
1;

lib/AI/Genetic/Pro/Crossover/PointsSimple.pm  view on Meta::CPAN

package AI::Genetic::Pro::Crossover::PointsSimple;
$AI::Genetic::Pro::Crossover::PointsSimple::VERSION = '1.009';
use warnings;
use strict;
use List::MoreUtils qw(first_index);
#use Data::Dumper; $Data::Dumper::Sortkeys = 1;
#=======================================================================
sub new { bless { points => $_[1] ? $_[1] : 1 }, $_[0]; }
#=======================================================================
sub run {
	my ($self, $ga) = @_;
	
	my ($chromosomes, $parents, $crossover) = ($ga->chromosomes, $ga->_parents, $ga->crossover);
	my ($fitness, $_fitness) = ($ga->fitness, $ga->_fitness);
	my @children;
	#-------------------------------------------------------------------
	while(my $elders = shift @$parents){
		my @elders = unpack 'I*', $elders;

		unless(scalar @elders){
			push @children, $chromosomes->[$elders[0]];
			next;
		}
		
		my ($min, $max) = (0, $#{$chromosomes->[0]} - 1);
		if($ga->variable_length){
			for my $el(@elders){
				my $idx = first_index { $_ } @{$chromosomes->[$el]};
				$min = $idx if $idx > $min;
				$max = $#{$chromosomes->[$el]} if $#{$chromosomes->[$el]} < $max;
			}
		}
		
		my @points;
		if($min < $max and $max - $min > 2){
			my $range = $max - $min;
			@points = map { $min + int(rand $range) } 1..$self->{points};
		}
		
		@elders = map { $chromosomes->[$_]->clone } @elders;
		for my $pt(@points){
			@elders = sort {
						splice @$b, 0, $pt, splice( @$a, 0, $pt, @$b[0..$pt-1] );
						0;
							} @elders;
		}
		
		push @children, @elders;
	}
	#-------------------------------------------------------------------
	# wybieranie potomkow ze zbioru nowych osobnikow
	@children = sort { $fitness->($ga, $a) <=> $fitness->($ga, $b) } @children;
	splice @children, 0, scalar(@children) - scalar(@$chromosomes);
	%$_fitness = map { $_ => $fitness->($ga, $children[$_]) } 0..$#children;
	#-------------------------------------------------------------------
	return \@children;
}
#=======================================================================
1;

lib/AI/Genetic/Pro/MCE.pm  view on Meta::CPAN

package AI::Genetic::Pro::MCE;
$AI::Genetic::Pro::MCE::VERSION = '1.009';
use warnings;
use strict;
use base 							qw( AI::Genetic::Pro );
#-----------------------------------------------------------------------
use Clone 							qw( clone   );
use List::Util 						qw( shuffle );
use MCE( Sereal => 0 );
#use MCE::Loop;
use MCE::Map;
use MCE::Util;
#-----------------------------------------------------------------------	
$Storable::Deparse 	= 1;
$Storable::Eval 	= 1;
#-----------------------------------------------------------------------
__PACKAGE__->mk_accessors( qw(
	_pop
	_tpl
));
#=======================================================================
sub new {
	my ( $cls, $obj, $tpl ) = @_;
	
	my $self = bless $obj, $cls;
	
	#-------------------------------------------------------------------
	$self->_init_mce;
	$self->_init_pop;
	
	#-------------------------------------------------------------------
	$AI::Genetic::Pro::Array::Type::Native = 1 if $self->native;
	
	#-------------------------------------------------------------------
	delete $tpl->{ $_ } for qw( -history -mce -population -workers );
	$self->_tpl( $tpl );
	
	#-------------------------------------------------------------------
	return $self;
}
#=======================================================================
sub _init_pop {
	my ( $self ) = @_;
	
	my $pop = int( $self->population / $self->workers );
	my $rst = $self->population % $self->workers;
	
	my @pop = ( $pop ) x $self->workers;
	$pop[ 0 ] += $rst;
	
	$self->_pop( \@pop );
}
#=======================================================================
sub _calculate_fitness_all {
	my ($self) = @_;
	
	# Faster version. Thanks to Mario Roy :-)
	my %fit = mce_map_s {
			$_ => $self->fitness()->( $self, $self->chromosomes->[ $_ ] )
		} 0, $#{ $self->chromosomes };

	# The old one
	#my %fit = mce_map {
	#		$_ => $self->fitness()->( $self, $self->chromosomes->[ $_ ] )
	#	} 0 .. $#{ $self->chromosomes };

	$self->_fitness( \%fit );
	
	return;
}
#=======================================================================
sub _init_mce {
	my ( $self ) = @_;
	
	#-------------------------------------------------------------------
	$self->workers( MCE::Util::get_ncpu() ) unless $self->workers;
	
	#-------------------------------------------------------------------
	MCE::Map->init(
		chunk_size 	=> 1,					# Thanks Roy :-)
		#chunk_size => q[auto],				# The old one
		max_workers => $self->workers,
		posix_exit => 1,					# Thanks Roy :-)
	);
	
	#-------------------------------------------------------------------
	return;
}
#=======================================================================
sub init {
	my ( $self, $val ) = @_;
	
	#-------------------------------------------------------------------
	my $pop = $self->population;
	$self->population( 1 );
	$self->SUPER::init(  $val  );
	$self->population( $pop );
	
	#-------------------------------------------------------------------
	my $one = shift @{ $self->chromosomes };	
	my $tpl = $self->_tpl;
	
	my @lst = mce_map {
		my $arg = clone( $tpl );
		$arg->{ -population } = $_;
		my $gal = AI::Genetic::Pro->new( %$arg );
		$gal->init( $val );
		@{ $gal->_state };
		
	} @{ $self->_pop };
	
	#-------------------------------------------------------------------
	return $self->_adopt( \@lst );
}
#=======================================================================
sub _adopt {
	my ( $self, $lst ) = @_;
	
	if( my $typ = $self->_package ){
		for my $idx ( 0 .. $#$lst ){
			$lst->[ $idx ]->[ 0 ] = $typ->make_with_packed( $lst->[ $idx ]->[ 0 ] );
			bless $lst->[ $idx ]->[ 0 ], q[AI::Genetic::Pro::Chromosome];
		}
	}
	
	my ( @chr, %fit, @rhc, %tif );
	for my $sth ( @$lst ){
		push @chr, $sth->[ 0 ];
		$fit{ $#chr } = $sth->[ 1 ];
	}
	
	#@$lst = ( );
	
	my @idx = shuffle 0 .. $#chr;
	
	for my $i ( @idx ){
		push @rhc, $chr[ $i ];
		$tif{ $#rhc } = $fit{ $i };
	}
	
	$self->_fitness	  ( \%tif );
	$self->chromosomes( \@rhc );
	
	return;
}
#=======================================================================
sub _chunks {
	my ( $self ) = @_;
	
	my $cnt = 0;
	my @chk;
	
	for my $idx ( 0 .. $#{ $self->_pop } ){
		my $pos = 0;
		my %tmp = map { $pos++ => $self->_fitness->{ $_ } } $cnt .. $cnt + $self->_pop->[ $idx ] -1 ;
		my @tmp = splice @{ $self->chromosomes }, 0, $self->_pop->[ $idx ];
		$cnt += @tmp;
		
		if( $self->_package ){
			push @chk, [
				[ map { ${ tied( @$_ ) } } @tmp ],
				\%tmp,
			];
		}else{
			push @chk, [
				\@tmp,
				\%tmp,
			];
		}
	}
	
	return \@chk;
}
#=======================================================================
sub evolve {
	my ( $self, $generations ) = @_;

	$generations ||= -1; 	 

	for(my $i = 0; $i != $generations; $i++){
		
		# terminate ----------------------------------------------------
		last if $self->terminate and $self->terminate->( $self );
		
		# update generation --------------------------------------------
		$self->generation($self->generation + 1);
		
		# update history -----------------------------------------------
		$self->_save_history;

		my $tpl = $self->_tpl;
		my @lst = mce_map {
			#- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
			my $ary = $_;
			#- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
			my $arg = clone( $tpl );
			$arg->{ -population } = 1;
			my $gal = AI::Genetic::Pro->new( %$arg );
			$gal->init( 1 );
			#- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
			if( my $typ = $self->_package ){
				for my $idx ( 0 .. $#{ $ary->[ 0 ] } ){
					$ary->[ 0 ][ $idx ] = $typ->make_with_packed( $ary->[ 0 ][ $idx ] );
					bless $ary->[ 0 ][ $idx ], q[AI::Genetic::Pro::Chromosome];
				}	
			}
			#- - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
			$gal->population ( scalar( @{ $ary->[ 0 ] } ) );
			$gal->chromosomes( $ary->[ 0 ] );
			$gal->_fitness	 ( $ary->[ 1 ] );
			$gal->strict	 ( 0 );
			#- - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
			$gal->evolve	 ( 1 );
			#- - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
			@{ $gal->_state };
			
		} $self->_chunks;

		$self->_adopt( \@lst );
	}

	return;
}
#=======================================================================
1;

lib/AI/Genetic/Pro/Mutation/Bitvector.pm  view on Meta::CPAN

package AI::Genetic::Pro::Mutation::Bitvector;
$AI::Genetic::Pro::Mutation::Bitvector::VERSION = '1.009';
use warnings;
use strict;
#use Data::Dumper; $Data::Dumper::Sortkeys = 1;
#=======================================================================
sub new { bless \$_[0], $_[0]; }
#=======================================================================
sub run {
	my ($self, $ga) = @_;

	# this is declared here just for speed
	my $mutation = $ga->mutation;
	my $chromosomes = $ga->chromosomes;
	my $_translations = $ga->_translations;
	my ($fitness, $_fitness) = ($ga->fitness, $ga->_fitness);
	
	# main loop
	for my $idx (0..$#$chromosomes){
		next if rand() >= $mutation;
		
		if($ga->variable_length){
			my $rand = rand();
			if($rand < 0.16 and $#{$chromosomes->[$idx]} > 1){
				pop @{$chromosomes->[$idx]};
			}elsif($rand < 0.32 and $#{$chromosomes->[$idx]} > 1){
				shift @{$chromosomes->[$idx]};
			}elsif($rand < 0.48 and $#{$chromosomes->[$idx]} < $#$_translations){
				push @{$chromosomes->[$idx]}, rand > 0.5 ? 0 : 1;
			}elsif($rand < 0.64 and $#{$chromosomes->[$idx]} < $#$_translations){
				unshift @{$chromosomes->[$idx]}, rand > 0.5 ? 0 : 1;
			}elsif($rand < 0.8){
				##tied(@{$chromosomes->[$idx]})->reverse;
				
				#if( my $obj = tied( @{ $chromosomes->[ $idx ] } ) ){
				#	$obj->reverse;
				#}else{
				#	@{ $chromosomes->[ $idx ] } = reverse @{ $chromosomes->[ $idx ] };
				#}
				#@{ $chromosomes->[ $idx ] } = reverse @{ $chromosomes->[ $idx ] };
				
			}else{
				my $id = int rand @{$chromosomes->[$idx]};
				$chromosomes->[$idx]->[$id] = $chromosomes->[$idx]->[$id] ? 0 : 1;
			}
		}else{
			my $id = int rand @{$chromosomes->[$idx]};
			$chromosomes->[$idx]->[$id] = $chromosomes->[$idx]->[$id] ? 0 : 1;	
		}
		# we need to change fitness
		$_fitness->{$idx} = $fitness->($ga, $chromosomes->[$idx]);
	}
	
	return 1;
}
#=======================================================================
# too slow; mutation is too dangerous in this solution
sub run0 {
	my ($self, $ga) = @_;

	my $mutation = $ga->mutation; # this is declared here just for speed
	foreach my $chromosome (@{$ga->{chromosomes}}){
		if(rand() < $mutation){ tied(@$chromosome)->reverse; }
		else{
			for(0..$#$chromosome){
				next if rand > $mutation;
				$chromosome->[$_] = $chromosome->[$_] ? 0 : 1;
			}
		}
	}
	
	return 1;
}
#=======================================================================
1;

lib/AI/Genetic/Pro/Mutation/Combination.pm  view on Meta::CPAN

package AI::Genetic::Pro::Mutation::Combination;
$AI::Genetic::Pro::Mutation::Combination::VERSION = '1.009';
use warnings;
use strict;
use List::MoreUtils qw(first_index);
#use Data::Dumper; $Data::Dumper::Sortkeys = 1;
#=======================================================================
sub new { bless \$_[0], $_[0]; }
#=======================================================================
sub run {
	my ($self, $ga) = @_;

	# this is declared here just for speed
	my $mutation = $ga->mutation;
	my $chromosomes = $ga->chromosomes;
	my $_translations = $ga->_translations;
	my ($fitness, $_fitness) = ($ga->fitness, $ga->_fitness);
	my $inv = $mutation / 2;
	
	# main loop
	for my $idx (0..$#$chromosomes){
		
		my $rand = rand;
		
		if($rand < $inv) { tied(@{$chromosomes->[$idx]})->reverse; }
		elsif($rand < $mutation){
			my $el = int rand @{$chromosomes->[$idx]};
			my $new = int rand @{$_translations->[0]};
			next if $new == $chromosomes->[$idx]->[$el];
			
			my $id = first_index { $_ == $new } @{$chromosomes->[$idx]};
			$chromosomes->[$idx]->[$id] = $chromosomes->[$idx]->[$el] if defined $id and $id != -1;
			$chromosomes->[$idx]->[$el] = $new;
		}
		
		# we need to change fitness
		$_fitness->{$idx} = $fitness->($ga, $chromosomes->[$idx]);
	}
	
	return 1;
}
#=======================================================================
1;

lib/AI/Genetic/Pro/Mutation/Listvector.pm  view on Meta::CPAN

package AI::Genetic::Pro::Mutation::Listvector;
$AI::Genetic::Pro::Mutation::Listvector::VERSION = '1.009';
use warnings;
use strict;
use List::MoreUtils qw(first_index);
#use Data::Dumper; $Data::Dumper::Sortkeys = 1;
#=======================================================================
sub new { bless \$_[0], $_[0]; }
#=======================================================================
sub run {
	my ($self, $ga) = @_;

	# this is declared here just for speed
	my $mutation = $ga->mutation;
	my $chromosomes = $ga->chromosomes;
	my $_translations = $ga->_translations;
	my ($fitness, $_fitness) = ($ga->fitness, $ga->_fitness);
	
	# main loop
	for my $idx (0..$#$chromosomes){
		next if rand() >= $mutation;

		if($ga->variable_length){
			my $rand = rand();
			my $min = first_index { $_ } @{$chromosomes->[$idx]};
			my $range = $#{$chromosomes->[$idx]} - $min + 1;
		
			if($rand < 0.4 and $range > 2){
				if($rand < 0.2 and $ga->variable_length > 1){ $chromosomes->[$idx]->[$min] = 0; }
				else{ pop @{$chromosomes->[$idx]};	}
			}elsif($rand < 0.8 and $range < $#$_translations){
				if($rand < 0.6 and $ga->variable_length > 1 and not $chromosomes->[$idx]->[0]){
					$chromosomes->[$idx]->[ $min - 1 ] = 1 + int rand $#{$_translations->[ $min - 1 ]};
				}elsif(exists $_translations->[scalar @{$chromosomes->[$idx]}]){
					push @{$chromosomes->[$idx]}, 1 + int rand $#{$_translations->[scalar @{$chromosomes->[$idx]}]};
				}
			}else{
				my $id = $min + int rand($range - 1);
				$chromosomes->[$idx]->[$id] = 1 + int rand $#{$_translations->[$id]};
			}
		}else{
			my $id = int rand @{$chromosomes->[$idx]};
			$chromosomes->[$idx]->[$id] = 1 + int rand $#{$_translations->[$id]};
		}
		
		# we need to change fitness
		$_fitness->{$idx} = $fitness->($ga, $chromosomes->[$idx]);
	}
	
	return 1;
}
#=======================================================================
1;

lib/AI/Genetic/Pro/Mutation/Rangevector.pm  view on Meta::CPAN

package AI::Genetic::Pro::Mutation::Rangevector;
$AI::Genetic::Pro::Mutation::Rangevector::VERSION = '1.009';
use warnings;
use strict;
use List::MoreUtils qw(first_index);
use Math::Random qw(random_uniform_integer);
#use Data::Dumper; $Data::Dumper::Sortkeys = 1;
#=======================================================================
sub new { bless \$_[0], $_[0]; }
#=======================================================================
sub run {
	my ($self, $ga) = @_;

	# this is declared here just for speed
	my $mutation = $ga->mutation;
	my $chromosomes = $ga->chromosomes;
	my $_translations = $ga->_translations;
	my ($fitness, $_fitness) = ($ga->fitness, $ga->_fitness);

	# main loop
	for my $idx (0..$#$chromosomes){
		next if rand() >= $mutation;

		if($ga->variable_length){
			my $rand = rand();

			my $min = first_index { $_ } @{$chromosomes->[$idx]};
			my $range = $#{$chromosomes->[$idx]} - $min + 1;
		
			if($rand < 0.4 and $range > 2){
				if($rand < 0.2 and $ga->variable_length > 1){ $chromosomes->[$idx]->[$min] = 0; }
				else{ pop @{$chromosomes->[$idx]};	}
			}elsif($rand < 0.8 and $range < scalar @{$_translations}){
				if($rand < 0.6 and $ga->variable_length > 1 and not $chromosomes->[$idx]->[0]){
					$chromosomes->[$idx]->[ $min - 1 ] = random_uniform_integer(1, @{$_translations->[ $min - 1 ]}[1..2]);
				}elsif(exists $_translations->[scalar @{$chromosomes->[$idx]}]){
					push @{$chromosomes->[$idx]}, random_uniform_integer(1, @{$_translations->[scalar @{$chromosomes->[$idx]}]}[1..2]);	
				}
			}else{
				my $id = $min + int rand($range - 1);
				$chromosomes->[$idx]->[$id] = random_uniform_integer(1, @{$_translations->[$id]}[1..2]);	
			}
		}else{
			my $id = int rand @{$chromosomes->[$idx]};
			$chromosomes->[$idx]->[$id] = random_uniform_integer(1, @{$_translations->[$id]}[1..2]);	
		}
		
		# we need to change fitness
		$_fitness->{$idx} = $fitness->($ga, $chromosomes->[$idx]);
	}
	
	return 1;
}
#=======================================================================
sub run0 {
	my ($self, $ga) = @_;

	# this is declared here just for speed
	my $mutation = $ga->mutation;
	
	# main loop
	foreach my $chromosome (@{$ga->{chromosomes}}){
		next if rand() <= $mutation;
		
		if($ga->variable_length){
			my $rand = rand();
			if($rand < 0.33 and $#$chromosome > 1){
				pop @$chromosome;
			}elsif($rand < 0.66 and $#$chromosome < $#{$ga->_translations}){
				push @$chromosome, random_uniform_integer(1, @{$ga->_translations->[scalar @$chromosome]});
			}else{
				my $idx = int rand @$chromosome;
				$chromosome->[$idx] = random_uniform_integer(1, @{$ga->_translations->[$idx]});	
			}
		}else{
			my $idx = int rand @$chromosome;
			$chromosome->[$idx] = random_uniform_integer(1, @{$ga->_translations->[$idx]});		
		}
	}
	
	return 1;
}
#=======================================================================
1;

lib/AI/Genetic/Pro/Selection/Distribution.pm  view on Meta::CPAN

package AI::Genetic::Pro::Selection::Distribution;
$AI::Genetic::Pro::Selection::Distribution::VERSION = '1.009';
use warnings;
use strict;
#use Data::Dumper; $Data::Dumper::Sortkeys = 1;
#use AI::Genetic::Pro::Array::PackTemplate;
use Math::Random qw(
	random_uniform_integer 
	random_normal 
	random_beta
	random_binomial
	random_chi_square
	random_exponential
	random_poisson
);
use Carp 'croak';
#=======================================================================
sub new { 
	my ($class, $type, @params) = @_;
	bless { 
			type 	=> $type,
			params	=> \@params,
		}, $class; 
}
#=======================================================================
sub run {
	my ($self, $ga) = @_;
	
	my ($fitness, $chromosomes) = ($ga->_fitness, $ga->chromosomes);
	croak "You must set a number of parents to use the Distribution strategy"
		unless defined($ga->parents);
	my $parents = $ga->parents;
	my @parents;
	my $high = scalar @$chromosomes;
	#-------------------------------------------------------------------
	if($self->{type} eq q/uniform/){
		push @parents, 
			pack 'I*', random_uniform_integer($parents, 0, $#$chromosomes) 
				for 0..$#$chromosomes;
	}elsif($self->{type} eq q/normal/){
		my $av = defined $self->{params}->[0] ? $self->{params}->[0] : $#$chromosomes/2;
		my $sd = defined $self->{params}->[1] ? $self->{params}->[1] : $#$chromosomes;
		push @parents, 
			pack 'I*', map { int $_ % $high } random_normal($parents, $av, $sd)  
				for 0..$#$chromosomes;
	}elsif($self->{type} eq q/beta/){
		my $aa = defined $self->{params}->[0] ? $self->{params}->[0] : $parents;
		my $bb = defined $self->{params}->[1] ? $self->{params}->[1] : $parents;
		push @parents, 
			pack 'I*', map { int($_ * $high) } random_beta($parents, $aa, $bb)
				for 0..$#$chromosomes;
	}elsif($self->{type} eq q/binomial/){
		push @parents, 
			pack 'I*', random_binomial($parents, $#$chromosomes, rand) 
				for 0..$#$chromosomes;
	}elsif($self->{type} eq q/chi_square/){
		my $df = defined $self->{params}->[0] ? $self->{params}->[0] : $#$chromosomes;
		push @parents,
			pack 'I*', map { int $_ % $high } random_chi_square($parents, $df)
				for 0..$#$chromosomes;
	}elsif($self->{type} eq q/exponential/){
		my $av = defined $self->{params}->[0] ? $self->{params}->[0] : $#$chromosomes/2;
		push @parents, 
			pack 'I*', map { int $_ % $high } random_exponential($parents, $av)  
				for 0..$#$chromosomes;
	}elsif($self->{type} eq q/poisson/){
		my $mu = defined $self->{params}->[0] ? $self->{params}->[0] : $#$chromosomes/2;
		push @parents,
			pack 'I*', map { int $_ % $high } random_poisson($parents, $mu)
				for 0..$#$chromosomes;
	}else{
		die qq/Unknown distribution "$self->{type}" in "selection"!\n/;
	}
	
	#-------------------------------------------------------------------
	return \@parents;
}
#=======================================================================

1;

lib/AI/Genetic/Pro/Selection/Roulette.pm  view on Meta::CPAN

package AI::Genetic::Pro::Selection::Roulette;
$AI::Genetic::Pro::Selection::Roulette::VERSION = '1.009';
use warnings;
use strict;
#use Data::Dumper; $Data::Dumper::Sortkeys = 1;
use List::Util qw(sum min);
use List::MoreUtils qw(first_index);
use Carp 'croak';

#=======================================================================
sub new { bless \$_[0], $_[0]; }
#=======================================================================
sub run {
	my ($self, $ga) = @_;
	
	my ($fitness) = ($ga->_fitness);
	my (@parents, @elders);
	#-------------------------------------------------------------------
	my $count = $#{$ga->chromosomes};
	my $const = min values %$fitness;
	$const = $const < 0 ? abs($const) : 0;
	my $total = sum( map { $_ < 0 ? $_ + $const : $_ } values %$fitness);
	$total ||= 1;
	
	# elders
	for my $idx (0..$count){
		push @elders, $idx for 1..int((($fitness->{$idx} + $const) / $total) * $count);
	}
	
	if((my $add = $count - scalar @elders) > 0){
		my $idx = $elders[rand @elders];
		push @elders, int rand($count) for 0..$add;
	}
	
	croak "You must set a crossover probability to use the Roulette strategy"
		unless defined($ga->crossover);
	croak "You must set a number of parents to use the Roulette strategy"
		unless defined($ga->parents);

	# parents
	for(0..$count){
		if(rand > $ga->crossover){
			push @parents, pack 'I*', $elders[ rand @elders ]
		}else{
			my @group;
			push @group, $elders[ rand @elders ] for 1..$ga->parents;
			push @parents, pack 'I*', @group;
		}
	}

	#-------------------------------------------------------------------
	return \@parents;
}
#=======================================================================

1;

lib/AI/Genetic/Pro/Selection/RouletteBasic.pm  view on Meta::CPAN

package AI::Genetic::Pro::Selection::RouletteBasic;
$AI::Genetic::Pro::Selection::RouletteBasic::VERSION = '1.009';
use warnings;
use strict;
use List::Util qw(min);
#use Data::Dumper; $Data::Dumper::Sortkeys = 1;
use List::MoreUtils qw(first_index);
use Carp 'croak';
#=======================================================================
sub new { bless \$_[0], $_[0]; }
#=======================================================================
sub run {
	my ($self, $ga) = @_;
	
	my ($fitness, $chromosomes) = ($ga->_fitness, $ga->chromosomes);
	croak "You must set a number of parents to use the RouletteBasic strategy"
		unless defined($ga->parents);
	my $parents = $ga->parents;
	my (@parents, @wheel);
	my $const = min values %$fitness;
	$const = $const < 0 ? abs($const) : 0;
	my $total = 0;
	#-------------------------------------------------------------------
	foreach my $key (keys %$fitness){
		$total += $fitness->{$key} + $const;
		push @wheel, [ $key, $total ];
	}
	
	for(0..$#$chromosomes){
		my @group;
		for(1..$parents){
			my $rand = rand($total);
			my $idx = first_index { $_->[1] > $rand } @wheel;
			if($idx == 0){ $idx = 1 }
			elsif($idx == -1 ) { $idx = scalar @wheel; }
			push @group, $wheel[$idx-1]->[0];
		}
		push @parents, pack 'I*', @group;
	}
	
	#-------------------------------------------------------------------
	return \@parents;
}
#=======================================================================

1;

lib/AI/Genetic/Pro/Selection/RouletteDistribution.pm  view on Meta::CPAN

package AI::Genetic::Pro::Selection::RouletteDistribution;
$AI::Genetic::Pro::Selection::RouletteDistribution::VERSION = '1.009';
use warnings;
use strict;
use List::Util qw(min);
use List::MoreUtils qw(first_index);
#use Data::Dumper; $Data::Dumper::Sortkeys = 1;
#use AI::Genetic::Pro::Array::PackTemplate;
use Math::Random qw(
	random_uniform
	random_normal 
	random_beta
	random_binomial
	random_chi_square
	random_exponential
	random_poisson
);
use Carp 'croak';
#=======================================================================
sub new { 
	my ($class, $type, @params) = @_;
	bless { 
			type 	=> $type,
			params	=> \@params,
		}, $class; 
}
#=======================================================================
sub roulette {
	my ($total, $wheel) = @_;
	my $rand = rand($total);
	my $idx = first_index { $_->[1] > $rand } @$wheel;
	if($idx == 0){ $idx = 1 }
	elsif($idx == -1 ) { $idx = scalar @$wheel; }
	return $wheel->[$idx-1]->[0];
}
#=======================================================================
sub run {
	my ($self, $ga) = @_;
	
	my ($fitness, $chromosomes) = ($ga->_fitness, $ga->chromosomes);
	croak "You must set a number of parents for the RouletteDistribution strategy"
		unless defined($ga->parents);
	my $parents = $ga->parents;
	my $high = scalar @$chromosomes;
	my (@parents, @wheel);
	my $const = min values %$fitness;
	$const = $const < 0 ? abs($const) : 0;
	my $total = 0;
	#-------------------------------------------------------------------
	foreach my $key (keys %$fitness){
		$total += $fitness->{$key} + $const;
		push @wheel, [ $key, $total ];
	}
	#-------------------------------------------------------------------
	if($self->{type} eq q/uniform/){
		push @parents, 
			pack 'I*', 
				map { roulette($total, \@wheel) }
				 	random_uniform($parents, 0, $total) 
						for 0..$#$chromosomes;
	}elsif($self->{type} eq q/normal/){
		my $av = defined $self->{params}->[0] ? $self->{params}->[0] : $#$chromosomes/2;
		my $sd = defined $self->{params}->[1] ? $self->{params}->[1] : $#$chromosomes;
		push @parents, 
			pack 'I*', 
				map { roulette($total, \@wheel) }
					map { int $_ % $high } random_normal($parents, $av, $sd)  
						for 0..$#$chromosomes;
	}elsif($self->{type} eq q/beta/){
		my $aa = defined $self->{params}->[0] ? $self->{params}->[0] : $parents;
		my $bb = defined $self->{params}->[1] ? $self->{params}->[1] : $parents;
		push @parents, 
			pack 'I*', 
				map { roulette($total, \@wheel) }
					map { int($_ * $high) } random_beta($parents, $aa, $bb)
						for 0..$#$chromosomes;
	}elsif($self->{type} eq q/binomial/){
		push @parents, 
			pack 'I*', 
				map { roulette($total, \@wheel) }
					random_binomial($parents, $#$chromosomes, rand) 
						for 0..$#$chromosomes;
	}elsif($self->{type} eq q/chi_square/){
		my $df = defined $self->{params}->[0] ? $self->{params}->[0] : $#$chromosomes;
		push @parents,
			pack 'I*', 
				map { roulette($total, \@wheel) }
					map { int $_ % $high } random_chi_square($parents, $df)
						for 0..$#$chromosomes;
	}elsif($self->{type} eq q/exponential/){
		my $av = defined $self->{params}->[0] ? $self->{params}->[0] : $#$chromosomes/2;
		push @parents, 
			pack 'I*', 
				map { roulette($total, \@wheel) }
					map { int $_ % $high } random_exponential($parents, $av)  
						for 0..$#$chromosomes;
	}elsif($self->{type} eq q/poisson/){
		my $mu = defined $self->{params}->[0] ? $self->{params}->[0] : $#$chromosomes/2;
		push @parents,
			pack 'I*', 
				map { roulette($total, \@wheel) }
					map { int $_ % $high } random_poisson($parents, $mu)
						for 0..$#$chromosomes;
	}else{
		die qq/Unknown distribution "$self->{type}" in "selection"!\n/;
	}
	
	#-------------------------------------------------------------------
	return \@parents;
}
#=======================================================================

1;

t/00_load.t  view on Meta::CPAN

#/usr/bin/!perl

use Test::More qw(no_plan);

use_ok( 'AI::Genetic::Pro' );
use_ok( 'Class::Accessor::Fast::XS' );
use_ok( 'Clone' );
use_ok( 'GD::Graph::linespoints' );
use_ok( 'Digest::MD5' );
use_ok( 'Exporter::Lite' );	
use_ok( 'List::MoreUtils' );
use_ok( 'List::Util' );
use_ok( 'Math::Random' );
use_ok( 'Struct::Compare' );
use_ok( 'Tie::Array::Packed' );
use_ok( 'UNIVERSAL::require' );

t/01_inject.t  view on Meta::CPAN

use strict;
use warnings;

use FindBin qw($Bin);
use lib $Bin;
use Test::More qw(no_plan);
use Struct::Compare;
use AI::Genetic::Pro;

use constant BITS => 32;

my @Win; 
push @Win, 1 for 1..BITS;
my $Win = sum( \@Win );

sub sum {
	my ($ar) = @_;
	my $counter = 0;
	for(0..$#$ar){
		$counter += $ar->[$_] if $ar->[$_];
	}
	return $counter;
}

sub fitness {
	my ($ga, $chromosome) = @_;
	return sum(scalar $ga->as_array($chromosome));
}

sub terminate {
    my ($ga) = @_;
	return 1 if $Win == $ga->as_value($ga->getFittest);
	return;
}

my $ga = AI::Genetic::Pro->new(        
        -fitness         => \&fitness,        # fitness function
        -terminate       => \&terminate,      # terminate function
        -type            => 'bitvector',      # type of chromosomes
        -population      => 100,              # population
        -crossover       => 0.9,              # probab. of crossover
        -mutation        => 0.05,             # probab. of mutation
        -parents         => 2,                # number  of parents
        -selection       => [ 'Roulette' ],   # selection strategy
        -strategy        => [ 'Points', 2 ],  # crossover strategy
        -cache           => 0,                # cache results
        -history         => 0,                # remember best results
        -preserve        => 0,                # remember the bests
        -variable_length => 0,                # turn variable length OFF
);

# init population of 32-bit vectors
$ga->init(BITS);

my $population = [ ];
for my $chromosome(@{$ga->chromosomes}){
	push @$population, $chromosome->clone;
}

my @data;
for(0..BITS){
	my @chromosome;
	push @chromosome, rand() < 0.5 ? 1 : 0 for 1..BITS;
	push @data, \@chromosome;
}

push @$population, @data;
$ga->inject(\@data);

my $OK = 1;
for(0..$#$population){
	my @tmp0 = @{$population->[$_]};
	my @tmp1 = @{$ga->chromosomes->[$_]};
	unless(compare(\@tmp0, \@tmp1)){
		$OK = 0;
		last;
	}
}

ok($OK);

t/02_cache.t  view on Meta::CPAN

use strict;
use warnings;

use FindBin qw($Bin);
use lib $Bin;
use Test::More qw(no_plan);
use Time::HiRes;
use AI::Genetic::Pro;

use constant BITS => 32;

sub sum {
	my ($ar) = @_;
	my $counter = 0;
	for(0..$#$ar){
		$counter += $ar->[$_] if $ar->[$_];
	}
	return $counter;
}

sub fitness {
	my ($ga, $chromosome) = @_;
	return sum(scalar $ga->as_array($chromosome));
}

my $ga = AI::Genetic::Pro->new(        
        -fitness         => \&fitness,        # fitness function
        -terminate       => sub { return; },  # terminate function
        -type            => 'bitvector',      # type of chromosomes
        -population      => 10,               # population
        -crossover       => 0.9,              # probab. of crossover
        -mutation        => 0.05,             # probab. of mutation
        -parents         => 2,                # number  of parents
        -selection       => [ 'Roulette' ],   # selection strategy
        -strategy        => [ 'Points', 2 ],  # crossover strategy
        -cache           => 0,                # cache results
        -history         => 0,                # remember best results
        -preserve        => 0,                # remember the bests
        -variable_length => 0,                # turn variable length OFF
);

# init population of 32-bit vectors
$ga->init(BITS);
$ga->chromosomes( [ ] );
$ga->inject( [ [ qw( 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1) ] ] );
my $start = [Time::HiRes::gettimeofday()];
$ga->as_value($ga->chromosomes->[0]) for 0..10000;
my $time0 =Time::HiRes::tv_interval($start);


$ga = AI::Genetic::Pro->new(        
        -fitness         => \&fitness,        # fitness function
        -terminate       => sub { return; },  # terminate function
        -type            => 'bitvector',      # type of chromosomes
        -population      => 10,               # population
        -crossover       => 0.9,              # probab. of crossover
        -mutation        => 0.05,             # probab. of mutation
        -parents         => 2,                # number  of parents
        -selection       => [ 'Roulette' ],   # selection strategy
        -strategy        => [ 'Points', 2 ],  # crossover strategy
        -cache           => 1,                # cache results
        -history         => 0,                # remember best results
        -preserve        => 0,                # remember the bests
        -variable_length => 0,                # turn variable length OFF
);

# init population of 32-bit vectors
$ga->init(BITS);
$ga->chromosomes( [ ] );
$ga->inject( [ [ qw( 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1) ] ] );
$start = [Time::HiRes::gettimeofday()];
$ga->as_value($ga->chromosomes->[0]) for 0..10000;
my $time1 =Time::HiRes::tv_interval($start);

ok( $time0 >= $time1 );



( run in 0.519 second using v1.01-cache-2.11-cpan-a5abf4f5562 )