Beefy Boxes and Bandwidth Generously Provided by pair Networks
good chemistry is complicated,
and a little bit messy -LW
 
PerlMonks  

Re: How to remove the certain element of an object

by tobyink (Canon)
on Feb 03, 2013 at 18:53 UTC ( [id://1016847]=note: print w/replies, xml ) Need Help??


in reply to How to remove the certain element of an object

Your OO design seems questionable - you seem to be using the Person class to represent individual people (good!) but also to represent collections of people/populations. Use two separate classes

package Nation { use Moose; has population => (is => 'ro', isa => 'ArrayRef[Person]'); ...; } package Person { use Moose; has name => (is => 'ro', isa => 'Str'); ...; }

I'm not 100% clear on exactly what you want to do. Do you want to remove people from the population when $person->need_to_go is true? If so, I'd probably do something like this:

use List::MoreUtils qw(part); # Split population into people to keep, and people to go... my ($keep, $go) = part { !!$_->need_to_go } @{ $people->population }; # Set the population to just the people we want to keep. @{ $people->population } = @$keep;
package Cow { use Moo; has name => (is => 'lazy', default => sub { 'Mooington' }) } say Cow->new->name

Replies are listed 'Best First'.
Re^2: How to remove the certain element of an object
by vagabonding electron (Curate) on Feb 04, 2013 at 10:09 UTC

    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], '', ''; } }

      I'm no Ruby expert, but I think you're misinterpreting the example in the book. @@population is a "class attribute", not an object attribute. In other words, it's a property of the "Person" class; not a property of each Person.

      Using Moose you could model it along these lines:

      package Person { use Moose; use MooseX::ClassAttribute; has name => (is => 'ro', isa => 'Str'); class_has population => (is => 'ro', isa => 'ArrayRef'); } my $bob = Person->new(name => "Robert"); push @{ Person->population }, $bob;

      Though there are many reasons to avoid class attributes. (Basically think of all the good reasons to avoid global variables, and then s/global variables/class attributes/gi.)

      package Cow { use Moo; has name => (is => 'lazy', default => sub { 'Mooington' }) } say Cow->new->name
        Thank you very much for this tobyink, I see that I have to read much more ...
Re^2: How to remove the certain element of an object # Seems to work now!
by vagabonding electron (Curate) on Feb 04, 2013 at 15:50 UTC

    Dear tobyink

    thanks to your and Athanasius great help I was able to go further and make a script that seems to bring a reasonable output (if I do not miss something). Here is the script, thank you very much again and it would be great if you could comment this one too :-) :

    Thanks again!

    VE

    #! 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; } }

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: note [id://1016847]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others drinking their drinks and smoking their pipes about the Monastery: (6)
As of 2024-03-19 10:09 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found