Greetings monks. I'm working on an article about Perl's newly stable threading support. I've created an example application derived from an old Ada threading assignment - an elevator simulator. In it the people and the elevators are all implemented as separate threads.
Take a look at the code below and give it a whirl. Any suggestions would be greatly appreciated. I'm interested in simplifying it if possible; it's probably twice as long as I'd like. No golf though, this has to be readable by mere novices!
-sam
#!/usr/bin/perl
=pod
=head1 NAME
elevator.pl - a multi-threaded elevator simulator
=head1 SYNOPSIS
elevator.pl --elevators 3 --people 10 --floors 10
=head1 DESCRIPTION
This program simulates a building with elevators and people. The
people get on the elevators and ride them to their destinations. Then
they get off and wait a while. Finally, the people travel to the
ground floor and leave the building. Statistics are collected
measuring the efficiency of the elevators from the perspective of the
people.
=head1 OPTIONS
The following options are available to control the simulation:
--elevators - number of elevators in the building (default 3)
--floors - number of floors in the building (default 20)
--people - number of people to create (default 10)
--elevator-speed - how long an elevator takes to travel one floor,
in seconds (default .25)
--elevator-wait - how long an elevator waits at a floor for passeng
+ers,
in seconds (default .5)
--people-freq - how many people are created per second (default 2
+)
--people-wait - how long a person spends on their destination flo
+or,
in seconds (default 5)
=head1 AUTHOR
Sam Tregar <sam@tregar.com>
=head1 SEE ALSO
L<threads>
=cut
use 5.008; # 5.8 required for stable threading
use strict; # Amen
use warnings; # Hallelluja
use threads; # pull in threading routines
use threads::shared; # and variable sharing routines
# get options from command line with Getopt::Long
use Getopt::Long;
our $NUM_ELEVATORS = 3;
our $NUM_FLOORS = 20;
our $NUM_PEOPLE = 10;
our $ELEVATOR_SPEED = 0.25;
our $ELEVATOR_WAIT = 0.5;
our $PEOPLE_FREQ = 2;
our $PEOPLE_WAIT = 5;
GetOptions("elevators=i" => \$NUM_ELEVATORS,
"floors=i" => \$NUM_FLOORS,
"people=i" => \$NUM_PEOPLE,
"elevator-speed=f" => \$ELEVATOR_SPEED,
"elevator-wait=f" => \$ELEVATOR_WAIT,
"people-freq=i" => \$PEOPLE_FREQ,
"people-wait=f" => \$PEOPLE_WAIT );
die "Usage $0 [options]\n" if @ARGV;
# Building State
our %DOOR : shared; # a door for each elevator on each floor
our @BUTTON : shared; # a button for each floor to call the elevators
our %PANEL : shared; # a panel of buttons inside each elevator for ea
+ch floor
# Simulation State
our $FINISHED : shared = 0; # used to signal the elevators to shut do
+wn
# run the simulator
init_building();
init_elevator();
init_people();
finish();
exit 0;
# initialize building state
sub init_building {
# set all indicators to 0 to start the simulation
for my $floor (0 .. $NUM_FLOORS - 1) {
$BUTTON[$floor] = 0;
for my $elevator (0 .. $NUM_ELEVATORS - 1) {
$PANEL{"$elevator.$floor"} = 0;
$DOOR{"$elevator.$floor"} = 0;
}
}
# this is as good a time as any to seed rand()
srand(time ^ $$);
}
# create elevator threads
sub init_elevator {
our @elevators;
for (0 .. $NUM_ELEVATORS - 1) {
# pass each elevator thread a unique elevator id
push @elevators, threads->new(\&Elevator::run,
id => $_);
}
}
# create people threads
sub init_people {
our @people;
for (0 .. $NUM_PEOPLE - 1) {
# pass each person thread a unique person id and a random
# destination
push @people, threads->new(\&Person::run,
id => $_,
dest => int(rand($NUM_FLOORS - 2))
++ 1);
# pause if we've launched enough people this second
sleep 1 unless $_ % $PEOPLE_FREQ;
}
}
# finish the simulation - join all threads and collect statistics
sub finish {
our (@people, @elevators);
# join the people threads and collect statistics
my ($total_wait, $total_ride, $max_wait, $max_ride) = (0,0,0,0);
foreach (@people) {
my ($wait1, $wait2, $ride1, $ride2) = $_->join;
$total_wait += $wait1 + $wait2;
$total_ride += $ride1 + $ride2;
$max_wait = $wait1 if $wait1 > $max_wait;
$max_wait = $wait2 if $wait2 > $max_wait;
$max_ride = $ride1 if $ride1 > $max_ride;
$max_ride = $ride2 if $ride2 > $max_ride;
}
# tell the elevators to shut down
{ lock $FINISHED; $FINISHED = 1; }
$_->join for @elevators;
# print out statistics
print "\n", "-" x 72, "\n\nSimulation Complete\n\n", "-" x 72, "\n
+\n";
printf "Average Wait Time: %6.2fs\n", ($total_wait / ($NUM_PEOPL
+E * 2));
printf "Average Ride Time: %6.2fs\n\n", ($total_ride / ($NUM_PEOPL
+E * 2));
printf "Longest Wait Time: %6.2fs\n", $max_wait;
printf "Longest Ride Time: %6.2fs\n\n", $max_ride;
}
#######################################################
# The Elevator Class #
#######################################################
package Elevator;
use threads; # pull in threading routines
use threads::shared; # and variable sharing routines
use Time::HiRes qw(sleep); # used to pause for fractional seconds
# state enumeration
use constant STARTING => 0;
use constant STOPPED => 1;
use constant GOING_UP => 2;
use constant GOING_DOWN => 3;
# create a new Elevator object
sub new {
my $pkg = shift;
my $self = { state => STARTING,
floor => 0,
dest => 0,
@_,
};
return bless($self, $pkg);
}
# run an Elevator thread, takes a numeric id as an argument and
# creates a new Elevator object
sub run {
my $self = Elevator->new(@_);
my $id = $self->{id};
# run until simulation is finished
while (1) {
# get next destination
$self->{dest} = $self->next_dest;
# stopped?
if ($self->{dest} == $self->{floor}) {
# state transition to STOPPED?
if ($self->{state} != STOPPED) {
print "Elevator $id stopped at floor ",
($self->{dest} + 1), ".\n";
$self->{state} = STOPPED;
}
# wait for passengers
$self->open_door;
sleep $ELEVATOR_WAIT;
} elsif ($self->{dest} > $self->{floor}) {
# state transition to GOING UP?
if ($self->{state} != GOING_UP) {
print "Elevator $id going up to floor ",
($self->{dest} + 1), ".\n";
$self->{state} = GOING_UP;
$self->close_door;
}
# travel to next floor up
sleep $ELEVATOR_SPEED;
$self->{floor}++;
} else {
# state transition to GOING DOWN?
if ($self->{state} != GOING_DOWN) {
print "Elevator $id going down to floor ",
($self->{dest} + 1), ".\n";
$self->{state} = GOING_DOWN;
$self->close_door;
}
# travel to next floor down
sleep $ELEVATOR_SPEED;
$self->{floor}--;
}
# simulation over?
{ lock $FINISHED; return if $FINISHED; }
}
}
# choose the next destination floor by looking at BUTTONs and PANELs
sub next_dest {
my $self = shift;
my ($id, $state, $floor) = @{$self}{('id', 'state', 'floor')};
lock @BUTTON;
lock %PANEL;
# look up from current floor unless travelling down. Head
# for the first activated button or panel
if ($state == GOING_UP || $state == STOPPED) {
for ($floor .. ($NUM_FLOORS - 1)) {
return $_ if $BUTTON[$_] or $PANEL{"$id.$_"};
}
}
# look down from current floor
for ($_ = $floor; $_ >= 0; $_--) {
return $_ if $BUTTON[$_] or $PANEL{"$id.$_"};
}
# look up again if going down and nothing found
if ($state == GOING_DOWN) {
for ($floor .. ($NUM_FLOORS - 1)) {
return $_ if $BUTTON[$_] or $PANEL{"$id.$_"};
}
}
# stop if nothing found
return $floor;
}
# open the elevator doors
sub open_door {
my $self = shift;
lock %DOOR;
$DOOR{"$self->{id}.$self->{floor}"} = 1;
cond_broadcast(%DOOR);
}
# close the elevator doors
sub close_door {
my $self = shift;
lock %DOOR;
$DOOR{"$self->{id}.$self->{floor}"} = 0;
}
#######################################################
# The Person Class #
#######################################################
package Person;
use threads; # pull in threading routines
use threads::shared; # and variable sharing routines
use Time::HiRes qw(sleep time); # used to pause for fractional
# seconds and get better statistics
# create a new Person object
sub new {
my $pkg = shift;
my $self = { @_,
floor => 0,
elevator => 0 };
return bless($self, $pkg);
}
# run a Person thread, takes an id and a destination floor as
# arguments. Creates a Person object.
sub run {
my $self = Person->new(@_);
my $id = $self->{id};
# wait for elevator going up
my $wait_start1 = time;
$self->wait;
my $wait1 = time - $wait_start1;
# board the elevator, wait for arrival destination floor and get o
+ff
my $ride_start1 = time;
$self->board;
$self->ride;
$self->disembark;
my $ride1 = time - $ride_start1;
# spend some time on the destination floor and then head back
sleep $PEOPLE_WAIT;
$self->{dest} = 0;
# wait for elevator going down
my $wait_start2 = time;
$self->wait;
my $wait2 = time - $wait_start2;
# board the elevator, wait for arrival destination floor and get o
+ff
my $ride_start2 = time;
$self->board;
$self->ride;
$self->disembark;
my $ride2 = time - $ride_start2;
# return wait and ride times
return ($wait1, $wait2, $ride1, $ride2);
}
# singal an elevator to come to this floor
sub press_button {
my $self = shift;
lock @BUTTON;
$BUTTON[$self->{floor}] = 1;
}
# wait for an elevator
sub wait {
my $self = shift;
print "Person $self->{id} waiting on floor 1 for elevator to floor
+ ",
($self->{dest} + 1), ".\n";
while(1) {
$self->press_button();
lock(%DOOR);
cond_wait(%DOOR);
for (0 .. $NUM_ELEVATORS - 1) {
if ($DOOR{"$_.$self->{floor}"}) {
$self->{elevator} = $_;
return;
}
}
}
}
# get on an elevator
sub board {
my $self = shift;
lock @BUTTON;
lock %PANEL;
$BUTTON[$self->{floor}] = 0;
$PANEL{"$self->{elevator}.$self->{dest}"} = 1;
}
# ride to the destination
sub ride {
my $self = shift;
print "Person $self->{id} riding elevator $self->{elevator} to flo
+or ",
($self->{dest} + 1), ".\n";
lock %DOOR;
cond_wait(%DOOR) until $DOOR{"$self->{elevator}.$self->{dest}"};
}
# get off the elevator
sub disembark {
my $self = shift;
print "Person $self->{id} getting off elevator $self->{elevator} "
+,
"at floor ", ($self->{dest} + 1), ".\n";
lock %PANEL;
$PANEL{"$self->{elevator}.$self->{dest}"} = 0;
$self->{floor} = $self->{dest};
}
srand(time^$$) is bad.
by Abigail-II (Bishop) on Aug 07, 2002 at 09:34 UTC
|
While scanning your code, I couldn't help noticing that you wrote:
# this is as good a time as any to seed rand()
srand(time ^ $$);
This is actually a bad seed. Very old Camels suggested this, but
even the Camel-II warns about. The problem is that
time ^ $$ == (time + 1) ^ ($$ + 1) surprisingly often.
Below I quote from a post I made to comp.lang.perl.misc in March 1996
which analysis the problem, and which eventually lead to Perl using
a much more "random" seed. The post shows how often
time ^ $$ == (time + 1) ^ ($$ + 1).
Write both time and $$ as binary numbers. Suppose both time and $$ end
+ with
a 0 followed by n 1's (n >= 0). Then the bit patterns are:
time: t_k t_(k-1) ... t_(n+1) 0 1 ... 1
$$: s_k s_(k-1) ... s_(n+1) 0 1 ... 1
hence, the bit pattern of time^$$ is:
t_k^s_k t_(k-1)^s_(k-1) ... t_(n+1)^s_(n+1) 0 0 ... 0.
Now, look at the bit patterns of time + 1 and $$ + 1:
time+1: t_k t_(k-1) ... t_(n+1) 1 0 ... 0
$$+1: s_k s_(k-1) ... t_(k+1) 1 0 ... 0
XORing time+1 and $$+1 gives:
t_k^s_k t_(k-1)^s_(k-1) ... t_(n+1)^s_(n+1) 0 0 ... 0, which equals ti
+me^$$.
It is easily seen that if time ends with a 0 followed by n 1's, and $$
+ ends
with a 0 followed by m 1's (n <> m, wlog assume n < m), that then bit
+n + 1
(counted from the right) of time^$$ will differ from bit n + 1 of (tim
+e+1)^($$+1).
Now, how often do time and $$ end with the same number of 1's? If each
+ bit of
time and $$ has a 0.5 chance of being 1 or 0, the following holds:
Let Pt(n) be the chance time ends with a 0 followed by n 1's.
Then Pt(n) = 1/2^(n+1).
Similary, Ps(n) = 1/2^(n+1); Ps(n) being the chance $$ ends with a
0 followed by n 1's.
Let Q(n) be the chance BOTH time and $$ end with a 0 followed by n 1's
+.
Since Pt and Ps are independent, we have:
Q(n) = Pt(n) * Ps(n) = 1/2^(2n+2) = (0.25)^(n+1).
To get the total chance time^$$ equals (time+1)^($$+1), we need to
take a summation over all possible values of n. So, let Q be the chanc
+e
time^$$ == (time+1)^($$+1). Then we have:
Q = Sigma_{n=0}^{k} Q(n) = Sigma_{n=0}^{k} (0.25)^(n+1) =
Sigma_{n=1}^{k+1} (0.25)^n.
where k is the number of bits in an integer.
Hence Q = (0.25 - 0.25^(k+1))/0.75, which goes to 1/3 when k -> oo.
So, in almost one third of the cases, time^$$ equals (time+1)^($$+1).
(In the above analysis, ^ is used in 3 different roles:
- as the xor function,
- as the power function,
- in the LaTeX way.
I hope the context makes it clear which case applies)
Abigail
| [reply] [Watch: Dir/Any] [d/l] [select] |
|
| [reply] [Watch: Dir/Any] |
|
Ah, well that makes things much easier. Since this program requires 5.8.0 I can just drop the srand() call altogether.
Thanks!
-sam
| [reply] [Watch: Dir/Any] |
Re: Multi-Threaded Elevator Simulator
by particle (Vicar) on Aug 07, 2002 at 12:40 UTC
|
# join the people threads and collect statistics
my ($total_wait, $total_ride, $max_wait, $max_ride) = (0,0,0,0);
foreach (@people) {
my ($wait1, $wait2, $ride1, $ride2) = $_->join;
$total_wait += $wait1 + $wait2;
$total_ride += $ride1 + $ride2;
$max_wait = $wait1 if $wait1 > $max_wait;
$max_wait = $wait2 if $wait2 > $max_wait;
$max_ride = $ride1 if $ride1 > $max_ride;
$max_ride = $ride2 if $ride2 > $max_ride;
}
is shorter and more clearly written as:
# join the people threads and collect statistics
my ($total_wait, $total_ride, $max_wait, $max_ride) = (0,0,0,0);
foreach (@people) {
my ($wait1, $wait2, $ride1, $ride2) = $_->join;
$total_wait = $wait1 + $wait2;
$total_ride = $ride1 + $ride2;
$max_wait = $wait1 > $wait2 ? $wait1 : $wait2;
$max_ride = $ride1 > $ride2 ? $ride1 : $ride2;
}
in the Elevator class, the constant STARTING is declared and never used.
as an aside: in new york city, there are three buildings with double-decker elevators (i've worked in two of them.) lobby and mezzanine are the base levels, and when going up you must use the lobby for odd floors (L 3 5 7 ... ) and mezzanine for odd floors (M 4 6 8 ...). going down, you can reach any floor from either level (except the edge case at the bottom.) i believe the Elevator class can be easily subclassed to handle this scenario as well. cool.
~Particle *accelerates*
| [reply] [Watch: Dir/Any] [d/l] [select] |
|
Your version is shorter but it's not right! My code computes max_ride and max_wait across all people. Yours finds the max_ride and max_wait for each person and only keeps the last one.
As far as making the simulation more accurate, there are many ways I could go. For one thing I could limit the number of people in a single elevator. And I could have the elevators communicate so they don't all rush off to the same floor at once. But ultimately this would be counter-productive as a teaching example since it would only make the code longer and thicker.
Thanks,
-sam
| [reply] [Watch: Dir/Any] |
|
As far as making the simulation more accurate, there are many ways I could go.
I suggest you go to a near-by university and observe people's habbits getting on and off elevators (as well as finding out how the elevators operate), calculating how long people usually wait for an elevator to come down before leaving ... etc.
(Or if that doesn't strike you as fun, or you don't have several weeks ... :), you could always check out Knuth's The Art of Computer Programming. I don't have the books here as a reference, but I believe it is either the first or second one. Knuth does just what I described above--memory permitting, of course. Its pretty informative if you have the books or can get them at a library--of course, I make no guarentees that he talks about threading, either in Perl 5.8.0 or otherwise :)
| [reply] [Watch: Dir/Any] |
|
|
man...I hate when people point out the obvious when its not even related to the point. The point was to test the new and improved 5.8 threading...which I think was a good idea....besides...
$max_wait = $wait1 > $wait2 ? $wait1 : $wait2;
does not equal
$max_wait = $wait1 if $wait1 > $max_wait;
because $max_wait is an aggregate value and is not in the same scope....you would lose your max value at every iteration....instead...
$max_wait = ($wait1 > $wait2) ? ($wait1 > $max_wait) ? $wait1 : $max
+_wait : ($wait2 > $max_wait) ? $wait2 : $max_wait;
would work....
-insomnia | [reply] [Watch: Dir/Any] [d/l] [select] |
|
|
Re: Multi-Threaded Elevator Simulator
by talexb (Chancellor) on Aug 13, 2002 at 17:00 UTC
|
use 5.008; # 5.8 required for stable threading
Is this correct? You ask for 5.008, and that gets you 5.8?
--t. alex
"Mud, mud, glorious mud. Nothing quite like it for cooling the blood!"
--Michael Flanders and Donald Swann
| [reply] [Watch: Dir/Any] [d/l] |
|
$ perl -e 'use 5.8'
Perl v5.800.0 required (did you mean v5.008?)--this is only v5.8.0, st
+opped at -e line 1.
BEGIN failed--compilation aborted at -e line 1.
-sam
PS: I cover this topic in greater depth in my just-published book, Writing Perl Modules for CPAN. Buy a copy and support the artist of this message! | [reply] [Watch: Dir/Any] [d/l] [select] |
|
|