#! perl
use strict;
use warnings;
use feature 'say';
package Restroom;
{
use Moose;
has queue => ( handles => { queue_obtain => 'push',
queue_release => 'shift' ,
queue_inventory => 'count',
},
isa => 'ArrayRef[Person]',
default => sub { [] },
traits => ['Array'],
is => 'ro',);
has facility_nr => ( isa => 'Int', is => 'rw', default => 3 );
has facilities => ( handles => { fac_open => 'push',
fac_close => 'shift' ,
fac_count => 'count',
},
isa => 'ArrayRef[Facility]',
default => sub { [] },
traits => ['Array'],
is => 'ro',);
has returner => (
handles => {in => 'push', out => 'shift', r_nr
+ => 'count',},
isa => 'ArrayRef[Person]',
default => sub{ [] },
traits => ['Array'],
is => 'ro',
);
sub initialize
{
my $self = shift;
for ( 1 .. $self->facility_nr )
{
my $facility = Facility->new();
$self->fac_open( $facility );
$facility->number($_);
}
}
sub enter
{
use List::MoreUtils qw(any);
my $self = shift;
my $person = shift;
if ( any { ! $_->occupied() } @{ $self->facilities } )
{
for my $facility ( @{ $self->facilities } )
{
if ( not $facility->occupied() )
{
$facility->occupy( $person );
last;
}
}
}
else
{
$self->queue_obtain( $person );
}
}
sub tick
{
my $self = shift;
for my $facility ( @{ $self->facilities } )
{
$facility->tick( );
if ( $facility->ret_nr )
{
$self->in($facility->stepout);
}
}
}
no Moose;
}
package Facility;
{
use Moose;
has occupier => (
handles => {doit => 'push', leave => 'shift',
+check => 'count',},
isa => 'ArrayRef[Person]',
default => sub{ [] },
traits => ['Array'],
is => 'ro',
);
has duration => ( isa => 'Int', is => 'rw', default => 0, );
has number => ( isa => 'Int', is => 'rw', default => 0);
has returner => (
handles => {stepin => 'push', stepout => 'shif
+t', ret_nr => 'count',},
isa => 'ArrayRef[Person]',
default => sub{ [] },
traits => ['Array'],
is => 'ro',
);
sub occupy
{
my $self = shift;
my $person = shift;
unless( $self->occupied() )
{
$self->doit( $person ); #?
$self->duration(1);
return 1;
}
else
{
return 0;
}
}
sub vacate
{
my $self = shift;
my $person = $self->leave;
$self->stepin( $person );
}
sub tick
{
my $self = shift;
my $occupier = $self->occupier;
if ( $self->check and ( $self->duration > $occupier->[0]->use_
+duration ) )
{
$self->vacate();
$self->duration(0);
}
elsif ( $self->check )
{
$self->duration($self->duration + 1);
}
}
sub occupied
{
my $self = shift;
return $self->check;
}
}
package Person;
{
use Moose;
use constant DURATION => 540;
has use_duration => ( isa => 'Int', is => 'ro', default => 1, );
has frequency => ( isa => 'Int', is => 'ro', default => 4, ); #
+ debug!
has number => ( isa => 'Int', is => 'rw', default => 0, );
sub need_to_go
{
my ($self) = @_;
return rand(DURATION) + 1 <= $self->frequency;
}
}
package Team;
{
use Moose;
has population => (
isa => 'ArrayRef[Person]',
is => 'ro',
traits => ['Array'],
handles => { obtain => 'push', release => 's
+hift', },
);
sub cull
{
use List::MoreUtils qw(part);
my ($self) = @_;
my ($need, $stay) = part { ! $_->need_to_go } @{ $self->popul
+ation };
return $need // [];
}
sub display
{
use Data::Dump;
my ($self, $msg) = @_;
say "\n$msg\n";
dd $self;
}
}
package main;
{
use constant DURATION => 540; #
use List::MoreUtils qw(each_arrayref);
my %data;
for ( my $people_nr = 10; $people_nr <= 600; $people_nr += 10)
{
say $people_nr; # simply to inform in the meantime.
my $rr = Restroom->new();
$rr->initialize;
my $people = Team->new;
for my $case ( 1 .. $people_nr )
{
my $per = Person->new;
$per->number( $case );
$people->obtain( $per );
}
for my $t ( 1 .. DURATION )
{
push @{ $data{$people_nr} }, $rr->queue_inventory;
my @queue = @{ $rr->queue };
@{ $rr->queue } = ();
if ( @queue )
{
my $next = shift @queue;
$rr->enter( $next);
}
# Those who do not need to go stay in the office.
my @wanted = @{ $people->cull} if $people->cull;
my %wanted = map{$_ =>1} @wanted;
@{ $people->population} = grep(!defined $wanted{$_}, @{ $p
+eople->population});
#
while ( my $p = shift @wanted )
{
$rr->enter( $p );
}
$rr->tick;
while ( $rr->r_nr )
{
$people->obtain( $rr->out);
}
}
}
my @keys = sort {$a <=> $b} keys %data;
my @AoA = @data{@keys};
my @transpose = pivot ( @AoA );
my $outfile = "output_OO.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_scrip
+t.r];
sub pivot
{
my @arr = @_;
my $iter = each_arrayref(@arr);
my @pivot;
while ( my @tuple = $iter->() )
{
push @pivot, [@tuple];
}
return @pivot;
}
}
|