{"id":23179450,"url":"https://github.com/perigrin/mx-declare-weasels","last_synced_at":"2025-07-11T14:05:00.144Z","repository":{"id":66600315,"uuid":"206521","full_name":"perigrin/mx-declare-weasels","owner":"perigrin","description":null,"archived":false,"fork":false,"pushed_at":"2009-05-21T16:05:48.000Z","size":84,"stargazers_count":4,"open_issues_count":0,"forks_count":0,"subscribers_count":3,"default_branch":"master","last_synced_at":"2025-02-10T10:32:00.444Z","etag":null,"topics":[],"latest_commit_sha":null,"homepage":null,"language":"Perl","has_issues":true,"has_wiki":null,"has_pages":null,"mirror_url":null,"source_name":null,"license":null,"status":null,"scm":"git","pull_requests_enabled":true,"icon_url":"https://github.com/perigrin.png","metadata":{"files":{"readme":"README.md","changelog":null,"contributing":null,"funding":null,"license":null,"code_of_conduct":null,"threat_model":null,"audit":null,"citation":null,"codeowners":null,"security":null,"support":null}},"created_at":"2009-05-21T04:47:27.000Z","updated_at":"2014-09-08T20:12:29.000Z","dependencies_parsed_at":"2023-02-20T07:30:25.289Z","dependency_job_id":null,"html_url":"https://github.com/perigrin/mx-declare-weasels","commit_stats":null,"previous_names":[],"tags_count":0,"template":false,"template_full_name":null,"repository_url":"https://repos.ecosyste.ms/api/v1/hosts/GitHub/repositories/perigrin%2Fmx-declare-weasels","tags_url":"https://repos.ecosyste.ms/api/v1/hosts/GitHub/repositories/perigrin%2Fmx-declare-weasels/tags","releases_url":"https://repos.ecosyste.ms/api/v1/hosts/GitHub/repositories/perigrin%2Fmx-declare-weasels/releases","manifests_url":"https://repos.ecosyste.ms/api/v1/hosts/GitHub/repositories/perigrin%2Fmx-declare-weasels/manifests","owner_url":"https://repos.ecosyste.ms/api/v1/hosts/GitHub/owners/perigrin","download_url":"https://codeload.github.com/perigrin/mx-declare-weasels/tar.gz/refs/heads/master","host":{"name":"GitHub","url":"https://github.com","kind":"github","repositories_count":247276186,"owners_count":20912288,"icon_url":"https://github.com/github.png","version":null,"created_at":"2022-05-30T11:31:42.601Z","updated_at":"2022-07-04T15:15:14.044Z","host_url":"https://repos.ecosyste.ms/api/v1/hosts/GitHub","repositories_url":"https://repos.ecosyste.ms/api/v1/hosts/GitHub/repositories","repository_names_url":"https://repos.ecosyste.ms/api/v1/hosts/GitHub/repository_names","owners_url":"https://repos.ecosyste.ms/api/v1/hosts/GitHub/owners"}},"keywords":[],"created_at":"2024-12-18T07:14:50.348Z","updated_at":"2025-04-05T02:17:45.643Z","avatar_url":"https://github.com/perigrin.png","language":"Perl","funding_links":[],"categories":[],"sub_categories":[],"readme":"I was reading a [blog post][1] recently that mentioned the [Dawkins Weasel\nprogram][2]. I have always wanted to play around with [Genetic Algorithms][3]\nand this one seemed simple enough to hack at for a few hours. Four hours later\nI think I have something that can illustrate Modern Moose nicely ( Spacecataz\nthis is specifically for you, seduce you back away from Python). NOTE: I have\nre-arranged some stuff to make this discussion a little easier. The [source\ncode][8] will show the right order and will run properly.\n\n\n    #!/usr/bin/env perl\n    use 5.10.0;\n    use MooseX::Declare;\n\nLike any good perl modern script we start out with a `#!` line, state that\nwe're gonna use a Modern Perl (5.10+), and we're gonna use some of the new\nsugary syntax from [`MooseX::Declare`][3]\n\nNow in the [code I pilfered the algorithm][4] from we have some global\nparameters. [Matt Trout][11] likes to call Singleton objects [\"God\" objects][12], so\nwe'll just borrow that nomenclature here. Technically this isn't a [Singleton][13]\neither, but we're gonna abuse things a bit for the sake of a pun.\n\n    class GOD {\n        use constant TARGET        =\u003e 'METHINKS IT IS LIKE A WEASEL';\n        use constant MUTATION_RATE =\u003e 0.09;\n\n        sub DEFAULT_STRING() { join '', map { RANDOM_LETTER() } 0..(length TARGET) -1 }\n        sub RANDOM_LETTER() { ( 'A' .. 'Z', ' ' )[ rand(27) ] }\n    }\n\n`DEFAULT_STRING` and `RANDOM_LETTER` are some utility methods we'll use in a\nbit.\n\nSo now that we have God we can create the `World`. Our `World` is basically a\ncontainer for evolving generations of objects (in our case `Weasels`). We have\na small world, it can only hold 50 `Weasels` at a time.\n\n    class World {\n        use constant SIZE =\u003e 50;\n\nOur world is also a harsh mistress, there can only be one generation alive at\na time. (Though all is not lost as we'll see, `Weasels` can worship their\nancestors). We keep an ArrayRef of Weasels around. \n\n        use MooseX::AttributeHelpers;\n        \n        has current_generation =\u003e (\n            isa        =\u003e 'ArrayRef[Weasel]',\n            is         =\u003e 'rw',\n            auto_deref =\u003e 1,\n            builder    =\u003e 'first_generation',\n            metaclass  =\u003e 'Collection::List',\n            provides   =\u003e {\n                first =\u003e 'best',\n            }\n        );\n\nWe're useing [`MooseX::AttributeHelpers`][5] to provide us with a simple\nhelper method that returns the \"best\" Weasel in each generation. We know its\nthe best because our world keeps `Weasels` sorted by their fitness.\n\n        sub _generate (\u0026) {\n            [ sort { $a-\u003efitness \u003c=\u003e $b-\u003efitness } map { $_[0]-\u003e() } 1 .. SIZE ];\n        }\n        \n        method first_generation {  _generate { Weasel-\u003enew }    }\n        method new_generation {\n             $self-\u003ecurrent_generation( _generate { $self-\u003ebest-\u003espawn } );\n        }\n\nThere are two times we want to generate a new generation of `Weasels`, at the\ndawn of the world when the `current_generation` attribute is first initalized,\nand when we call new_generation. At initalization we create an Ur-Weasel,\nevery other time we let the best `Weasel` of it's generation breed. It's good\nto be fit.\n\nSo now that we've covered how generations work, the Way the world `run`'s\nshould be obvious. Keep generating `new_generation`s until the [Kwisatz\nHaderach][6] is born.\n\n        method run {\n            $self-\u003enew_generation() until $self-\u003eperfect_offspring;\n        }\n\nHow do we know when we have perfect offspring? When the best of our generation\nis perfect.\n\n        method perfect_offspring { $self-\u003ebest-\u003eperfect }\n\nFinally so that the runtime isn't totally boring waiting for the world to end,\nwe use a [method modifier][7] to tack on some output letting us know who the\nbest in each generation is.\n\n        after new_generation { say $self-\u003ebest-\u003eto_string };\n    }\n\nSo let's look at the population of our world. Ah the `Weasel`, the most\nquintessential of `GOD`'s creations. `Weasel`'s do one thing in life, they\nbreed mutants. So our Weasel class composes the [Role][9]\n`NonLockingMutations` which we'll gloss over for a bit and just say \"`Weasels`\ncan evolve\".\n\n    class Weasel with NonLockingMutations {\n\nNow I said before that `Weasel`s have a strong sense of ancestory, even though\nthe `World` only knows about one generation of `Weasel` at a time, each weasel\nknows exactly who it's parent was, and what generation they belong to.\n        \n        has parent     =\u003e ( isa =\u003e 'Weasel', is =\u003e 'ro', );\n        has generation =\u003e ( isa =\u003e 'Int',    is =\u003e 'rw', builder =\u003e 'my_generation' );\n\n        method my_generation {\n            return 0 unless $self-\u003eparent;\n            $self-\u003eparent-\u003egeneration + 1;\n        }\n\nThey also have a little genetic string. Which they inherit from their parent\n(unless they're the Ur-`Weasel` in which case they get it from `GOD`).\n        \n        has string     =\u003e ( isa =\u003e 'Str',    is =\u003e 'ro', lazy_build =\u003e 1 );\n        \n        method _build_string {\n            return $self-\u003einherit_string if $self-\u003eparent;\n            return GOD::DEFAULT_STRING;\n        }\n\nFinally `Weasel`s can breed, they each have one child and teach it who its\nparent is, and they know how to tell the `World` about themselves.\n\n        method spawn { Weasel-\u003enew( parent =\u003e $self ) }\n        \n        method to_string {\n            \"${\\sprintf('%04d', $self-\u003egeneration)}:${ \\$self-\u003estring } (${\\sprintf('%02d', $self-\u003efitness)})\";\n        }\n    }\n\nNow we get to the interesting part of this, the reason we created our own\nlittle universe. `Weasel`s would never become perfect if they couldn't Mutate.\n\n\n    role Mutations {\n        requires qw(string parent mutate);\n\nIn our universe fitness is determined by the [Levenshtein][10] distance of the\n`Weasel`s string from `GOD`'s target.\n\n        use Text::LevenshteinXS qw(distance);\n        \n        has fitness =\u003e ( isa =\u003e 'Int', is =\u003e 'rw', lazy_build =\u003e 1 );\n        \n        method _build_fitness { distance( $self-\u003estring, GOD::TARGET() ) }    \n\nWe know we're perfect when our distance from `GOD`s `TARGET` (our fitness) is\n0.\n\n        method perfect { $self-\u003efitness == 0 }\n\nMutations are also where we inherit strings from our parents. Strings are\nnever inherited cleanly, there's always a chance at mutation. That chance\nhowever depends on the mutation mechanism we're using\n\n        method inherit_string {\n            return join '', map { $self-\u003emutate($_) }\n                0..(length $self-\u003eparent-\u003estring) - 1;\n        }\n    }\n\nMutations in our world come in two flavors, Non Locking Mutations mean every\ncharacter is free to mutate no matter if it already matches the corresponding\ncharacter in the `TARGET`. Locking Mutations don't change characters that\nalready match.\n\nHere are the implementations for each, they're pretty straight forward, and\nmostly the same. If we haven't been hit by a cosmic beam (ie a random number\nis less than `GOD`s `MUTATION_RATE`), return that character unmodified.\nOtherwise return a new random character.\n\n    role NonLockingMutations with Mutations {\n        sub mutate {\n            my $target = substr($_[0]-\u003eparent-\u003estring, $_[1], 1);\n            return $target unless rand() \u003c GOD::MUTATION_RATE;\n            return GOD::RANDOM_LETTER;\n        }\n    }\n\nThe only thing that `LockingMutations` changes on this is if we already match\n`GOD`s `TARGET`, return the current character.\n\n    role LockingMutations with Mutations {\n        sub mutate {        \n            my $target = substr($_[0]-\u003eparent-\u003estring, $_[1], 1);\n            return $target if $target eq substr(GOD::TARGET, $_[1],1);\n            return $target unless rand() \u003c GOD::MUTATION_RATE;\n            return GOD::RANDOM_LETTER;\n        }\n    }\n\nThat's it, everything is implemented. We start the world running and see\nour results\n\n    World-\u003enew-\u003erun;\n\n\n[1]: http://spacecataz1663.blogspot.com/2009/05/shhhh-im-having-affair.html\n[2]: http://en.wikipedia.org/wiki/Weasel_program\n[3]: http://search.cpan.org/dist/MooseX-Declare\n[4]: http://www.nmsr.org/weasel.htm\n[5]: http://search.cpan.org/dist/MooseX-AttributeHelpers\n[6]: http://en.wikipedia.org/wiki/Kwisatz_Haderach\n[7]: http://search.cpan.org/dist/Moose/lib/Moose/Manual/MethodModifiers.pod\n[8]: http://github.com/perigrin/mx-declare-weasels\n[9]: http://search.cpan.org/dist/Moose/lib/Moose/Manual/Roles.pod\n[10]: http://en.wikipedia.org/wiki/Levenshtein_distance\n[11]: http://www.shadowcat.co.uk/blog/matt-s-trout/\n[12]: http://en.wikipedia.org/wiki/God_object\n[13]: http://en.wikipedia.org/wiki/Singleton_pattern","project_url":"https://awesome.ecosyste.ms/api/v1/projects/github.com%2Fperigrin%2Fmx-declare-weasels","html_url":"https://awesome.ecosyste.ms/projects/github.com%2Fperigrin%2Fmx-declare-weasels","lists_url":"https://awesome.ecosyste.ms/api/v1/projects/github.com%2Fperigrin%2Fmx-declare-weasels/lists"}