Greetings fellow monks,
Today I bring you a nice perl script that I wrote in class.
It was in OOP class and I needed a prototype before I started the implementation in java so I chose my favourite language.
After a first implementation I discovered some intriguing aspects of the following algorithm. Because I wanted to understand its implications I needed more data so I rewrote it again and again. This is quite an interesting algorithm indeed.

The radoteur (as explained in the comments at the beginning of the code) is an algorithm developed by a french researcher. It will take a list of events and will cycle through it creating a new stream. A first event is selected and when it reoccurs the immediate event after that one is then selected. Here I use word list but you could do it on images using each pixel rgb value or anything that comes to ind.

so here is the code, have fun, I tried it on /usr/share/dict/words as well as the rockyou.txt wordlist that you can find on kali linux, the results are most interesting. Some time real words appear from the mess, expressions even. I hope you will have as much fun playing with it as I had writing it.

Cheers!

#!/usr/bin/perl

#this is a perl implementation of the radoteur from the book "Théorie 
+du Bordel
#Ambiant" authored by the french researcher Roland Moreno
#It will take a word list as input and output giberrish-y words from i
+t, after
#a while it will cycle, this program has been specially written to ide
+ntify
#the relationship between the wordlist and the size of the cycles
#next thing would be to do some stat works on the word size, their num
+bers
#inside the wordlist to find the equation that models the word list - 
+cycle
#size the most accurately

use strict;
use warnings;
my($evt,$niter);
my $cycled = 0;
$niter= 0;

#this is a double hash, the first level keys are line numbers, the sec
+ond
#its values are another hash which keys are letter coordinates inside 
+the 
#line's word, if we have the same letter in the same word on the same 
+line
#appear twice then we have cycled
my %letter_lines;
if(!defined $ARGV[0]){
    die "to use me, give me the word list file as argument\n";
}
start:
open my $fh, '<',$ARGV[0];
FILE_ITER: while(<$fh>){
        #here I take in the new word and split it into its letters
        #I also count the iteration number
    my $word = $_;
    $niter++;
    my @letters = split("", $word);

        #if evt is undefined, that's because we were looking for a new
+line
        #in the previous event or its the first iteration, in any case
        #the new event will be the first letter of the current word
    if(!defined($evt)){

        if(defined $letter_lines{$.}{0}){
                        printf STDERR "we have cycled: doing line $. l
+etter 0
                        again\n";
            $cycled = 1;
            last FILE_ITER;
        }

        else{
            $letter_lines{$.}{0} = 1;
                        print STDERR "adding to hash line $. letter 0\
+n";
        }
        $evt = shift @letters;
        print $evt;
        next FILE_ITER;
    }
    else{
        WORD_ITER:foreach my $i (0 .. $#letters){
            if($evt eq $letters[$i]){
                $evt = $i < $#letters?$letters[$i+1]:undef;
                if(defined $evt){
                                        if(defined $letter_lines{$.}{$
+i+1}){
                                            print STDERR "we have cycl
+ed :
                                            line $. letter ".($i+1)."\
+n";
                                            $cycled = 1;
                                            last FILE_ITER;
                                        }
                                        else{
                                            print STDERR "adding to ha
+sh line $.
                                            letter ".($i+1)."\n";
                                            $letter_lines{$.}{$i+1} = 
+1;
                                            print $evt;
                                        }
                }
                last WORD_ITER;
            }
        }
    }
}
close($fh);
if($cycled == 1){
    die "cycled in $niter iterations\n";
}
else{
    print STDERR "going back to the beginning\n";
    goto start;
}

[download]

P.S. If you see any improvements or corrections to my code, please do tell me so, I know its not an SOPW post, yet I want to improve so feel free to send some feedback my way, it won't go to /dev/null.

Replies are listed 'Best First'.
Re: Radoteur
by Athanasius (Archbishop) on Oct 19, 2015 at 03:31 UTC

    Hello QuillMeantTen,

    If you see any improvements or corrections to my code, please do tell me so

    Well, since you asked ... :-)

    1. You should always test calls to open and close for failure. Either append an explicit or die ... to each call, or just put use autodie at the head of the script.
    2. This statement: 
                             printf STDERR "we have cycled: doing line $. le
+tter 0
                       again\n";

      [download]
      prints a newline character followed by 24 spaces between 0 and again\n. This is almost certainly not what you intended.
    3. Reserve die (which is Perl’s way of throwing an exception) for error conditions; don’t use it for normal program termination.
    4. Don’t use goto, that way leads to spaghetti code! Recast the program logic to use a standard (structured) looping construct.
    5. Don’t use printf when print will do exactly the same job.

    Here’s my re-write of the code. In addition to the points noted above, I’ve streamlined the script’s control flow. Comments have been removed:

    Read more... (2 kB)

    Hope that helps,

    Athanasius <°(((>< contra mundum Iustus alius egestas vitae, eros Piratica,

[reply]
[d/l]
[select]

      Great many thanks for your input, I have started rewriting my code before even reading all your post, so here is my take on your advice:

      Read more... (4 kB)
[reply]
[d/l]

        Your loop labels are not required here (and rarely ever are). You can remove them in both the loops, and the last and next calls. For example, replace:

        WORD_ITER:foreach(...)

        [download]

        with:

        foreach(...)

        [download]

        and:

        next WORD_ITER;
last WORD_ITER;

        [download]

        with just:

        next;
last;

        [download]

        You can do this in both your while and for statements/blocks.

[reply]
[d/l]
[select]

Back to Cool Uses for Perl