comment on

Thank you very much tobyink ! I will work further with this.

The background of this - I am trying to translate some Ruby scripts from this book into Perl Exploring Everyday Things ... . There is a free sampler on O'Reilly exactly with the part I am trying to translate - the direct link to the sampler seems not to working but here is the main page of the book http://shop.oreilly.com/product/0636920022626.do . It deals with the Monte Carlo simulation to model the restroom usage in an office. You observe the queues which are formed in the restroom dependent on the number of the people in the group and the number of facilities in the restroom etc.

Well it is probably bold of me to try to do so since I do not speak Ruby at all and I am still a beginner in Perl. Otherwise I thought it is dumb just to install Ruby and copy the scripts mechanically. BTW the class Person there in the book represents the group and the individuals - I found this strange at first but I thought if adults do so I could try it too :-) Thank you for your proposal to use the separate classes!

In fact I have a working attempt that seems to be similar to the original but not in OO-way. I am trying to do first steps in the OO-programming and I thought this exercise could be educational.

BTW here is my "working attempt" (tried to wrap it in the spoiler to save place but failed).

#!/usr/bin/perl
use strict;
use warnings;

# use List::Util qw(min);
use List::MoreUtils qw(first_index each_arrayref);
# use Data::Dumper;

my %queue;
my %occupied;
my %report;
my %monitor;

my $limit = 540;
my $nr_facilities = 3;
my $probability = 4/540;
my $duration = 1; 

for ( my $y = 10; $y <= 300; $y += 10)
{
    my @clients = ( 1 .. $y );
    for my $actual_time ( 1 .. $limit )
    {
        push @{ $monitor{$y} }, scalar keys %{ $queue{$y} };
        
        # correction: purge the specific person.
        for my $id ( @clients )
        {
            my $chance = rand;
            if ( $chance < $probability )
            {
                # my $id = shift @clients;
                purge_this_one( \@clients, $id ); # This very person l
+eaves the team.
                push @{ $queue{$y}{$id} }, $actual_time; # Start waiti
+ng ("timestamp").
            }
        }    
        for my $occ_nr ( keys %{ $occupied{$y} } )
        {
            if ( ( $actual_time - $occupied{$y}{$occ_nr}->[1] ) > $dur
+ation )
            {
                delete $occupied{$y}{$occ_nr}; # Free the facility.
                push @clients, $occ_nr; # Back in the team.
            }
        }    

        while ( scalar keys %{ $queue{$y} } > 0 and  # if there is a q
+ueue already...
             scalar keys %{ $occupied{$y} } <= $nr_facilities ) # 
             # three facilities, if any is not occupied, then ... 
        {
                # who waited long?
                my @key_waiting = 
                    map { $_->[0] }
                    sort { $a->[1] <=> $b->[1] } 
                    map { [ $_, $queue{$y}{$_}->[0] ] } 
                    keys %{ $queue{$y} };
                my $turn = shift @key_waiting;
                # my $turn = min keys %{ $queue{$y} }; # old version o
+f $turn.
                                
                push @{ $queue{$y}{$turn} }, $actual_time; # End waiti
+ng ("timestamp").
                @{ $occupied{$y}{$turn} } = @{ $queue{$y}{$turn} }; # 
+Facility occupied.
                @{ $report{$y}{$turn} } = @{ $queue{$y}{$turn} }; # Re
+porting (who waited from .. to).
                delete $queue{$y}{$turn}; # Purge from queue;
        }        
    }
}

my @keys = sort {$a <=> $b} keys %monitor;
my @AoA = @monitor{@keys};
my @transpose = pivot ( @AoA );

my $outfile = "output.txt";
open my $out, ">", $outfile or die "$!";
print {$out} join(';', @keys ), "\n";

print {$out} join(';', @$_ ), "\n" for @transpose;

system q["C:/Program Files/R/R-2.13.0/bin/R.exe" CMD BATCH R_script.r]
+;

sub purge_this_one
{
    my $idx = first_index { $_ == $_[1] } @{$_[0]};
    splice( @{$_[0]}, $idx, 1 ); 
    return @{$_[0]};
}

sub pivot
{
    my @arr = @_;
    my $iter = each_arrayref(@arr);
    my @pivot;
    while ( my @tuple = $iter->() )
    {
        push @pivot, [@tuple];
    }
    return @pivot;
}
# In case somebody is curious:
printf "%-5s %-5s %-5s %-5s %-5s\n", 'Group', 'Nr', 'Start', 'End', 'W
+ait';
for my $group ( sort {$a <=> $b} keys %report )
{
    for my $nr ( sort {$a <=> $b} keys %{ $report{$group} } )
    {
    printf "%-5s %-5s %-5s %-5s %-5s\n", 
        $group, 
        $nr, 
        $report{$group}{$nr}->[0], 
        $report{$group}{$nr}->[1], 
        $report{$group}{$nr}->[1] - $report{$group}{$nr}->[0];
    }
    for my $nr ( sort {$a <=> $b} keys %{ $queue{$group} } )
    {
        printf "%-5s %-5s %-5s %-5s %-5s\n", $group, $nr, $queue{$grou
+p}{$nr}->[0], '', '';
    }
    
}
[download]

In reply to Re^2: How to remove the certain element of an object by vagabonding electron
in thread How to remove the certain element of an object by vagabonding electron

Are you posting in the right place? Check out Where do I post X? to know for sure.
Posts may use any of the Perl Monks Approved HTML tags. Currently these include the following:
<code> <a> <b> <big> <blockquote> <br /> <dd> <dl> <dt> <em> <font> <h1> <h2> <h3> <h4> <h5> <h6> <hr /> <i> <li> <nbsp> <ol> <p> <small> <strike> <strong> <sub> <sup> <table> <td> <th> <tr> <tt> <u> <ul>
Snippets of code should be wrapped in <code> tags not <pre> tags. In fact, <pre> tags should generally be avoided. If they must be used, extreme care should be taken to ensure that their contents do not have long lines (<70 chars), in order to prevent horizontal scrolling (and possible janitor intervention).
Want more info? How to link or How to display code and escape characters are good places to start.


Do you know where your variables are?
	PerlMonks