use Modern::Perl; use Data::Printer; use Getopt::Std; use List::Util qw(sum); =begin (a) Write a function peopleWaiting which takes an array of integers as its input – interpreted as a queue as above – and returns the number of people waiting in the queue. (b) Write a function addToQueue that adds an entry to the end of the queue if a free space is available. It should take the queue (as an array) and the “waiting tolerance” of the new customer (assumed to be > 0) as its input. It should return a boolean value, namely true if the entry was successfully added, and false if there was no space in the queue. (c) Write a function removeFromQueue that will remove the first entry from the queue, i.e., the next customer to be served. It should then advance the queue, i.e., move all waiting customers forward, leaving an additional free space at the end. It should return a boolean value, namely true if there was a customer in the queue and false if the queue was empty. (d) Write a procedure expire that takes a queue as its input, and an integer representing a time (in minutes) that has passed. It should subtract this time from the "waiting tolerance" of all customers in the queue. If the tolerance limit has been reached for any customer (e.g., if the time given is 15 minutes and they have no more than 15 minutes of "waiting tolerance" left), then the customer should be removed from the queue (they "leave the shop") and any remaining customers should advance forward. (e) Write a function serveOneCustomer, taking a queue array and a probability p as its input. The function should do the following: It removes the first customer from the queue; then expires 15 minutes from the queue as in (d) (while the customer is being served, or the barber goes for a break). After that, it simulates arriving customers by doing the following 15 times: • With probability p, add a new customer to the end of the queue. • The new customer (if any) has a waiting tolerance of at least 30 minutes but less than 90 minutes, randomly chosen. The function should return a boolean value, namely, whether a customer was served in this turn or not. (f) Write a function runDay which simulates the running of an entire day in the shop. It takes a queue, the number n of 15-minutes turns in the day, and a probability p as its input. The function then runs n turns of the type described in (e), starting the fist one with the queue as given. It counts the number of customers actually served in the day, and returns it as an integer. (g) Write a function averageNumberServed which computes the number of customers served per day, on average. Its parameters are: the number of turns per day; the number of days d to average over; the probability p; and the number of seats. It does d times the following: It sets up a new, empty queue of the specified length, and simulates one day on it as in (f), with parameters as given, recording the number of customers served. It then computes the arithmetic average over the number of customers served, and returns this as a oating point number. =cut use vars qw(%opts %q_sizes); # keeps track of size of queue during expire() getopts('p:t:', \%opts); # probability my $probability = $opts{p} or die "require probability value"; my $tat = $opts{t} || 15; # turnaround time - how long it takes to be served # list of waiting tolerances: my @que = ( 43, 15, 57, 0, 0, ); # p @que; my $array_size = @que; # number of elements in array # say 'number of people waiting: ' . peopleWaiting(@que); # check_expire(); # check_addToQueue(); # check_removeFromQueue(); # check_serveOneCustomer(); # check_runDay(); # %q_sizes = (); # reset after above do_averageNumberServed(); { # calculate queue size, as proportion of total ( 365 * 32-turns ): my $total = sum( values %q_sizes ); for my $array_size ( sort keys %q_sizes ) { say sprintf "array size %s = %-4s of %s [%0.2f%%]", $array_size, $q_sizes{$array_size}, $total, 100 * $q_sizes{$array_size} / $total; } } # p %q_sizes; # check average random number generator over 1 million cycles: # my $i = 0; # $i += int rand(59) + 30 for 1 .. 10**6; say $i / 10**6; # $i += rand(1) for 1 .. 10**6; say $i / 10**6; exit; #=============================================================================== sub check_expire { expire($tat, \@que); p @que; say 'number of people waiting: ' . peopleWaiting(@que); #expire($t, \@que); p @que; #say 'number of people waiting: ' . peopleWaiting(@que); } sub check_addToQueue { # add new entry (1st arg = tolerance): my $result = addToQueue(28, \@que); say "added new entry: $result"; # p @que; } sub check_removeFromQueue { # remove 1st entry: my $result = removeFromQueue(\@que); say "removed entry: $result"; # p @que; } sub check_serveOneCustomer { # serve customer (1st arg = probability): my $result = serveOneCustomer($probability, \@que); say "customer served: $result"; # p @que; } sub check_runDay { # run day: my $number_of_turns = int 8 * 60 / $tat; # no. of 15-minute turns in a day my $number_of_customers = runDay($probability, $number_of_turns, \@que); say '=' x 80; say "number of customers served in 1 day for probability $probability: " . $number_of_customers; say '=' x 80; } sub do_averageNumberServed { # calculate average number of customers served per day: my $number_of_turns = int 8 * 60 / $tat; # no. of 15-minute turns in a day my $number_of_days = 3650; my $number_of_seats = 5; my @args = ( $probability, $number_of_turns, $number_of_days, $number_of_seats ); my $average_per_day = averageNumberServed(@args); say '=' x 80; say sprintf 'average number of customers served in %s days for probability %s: %s', $number_of_days, $probability, $average_per_day; say '=' x 80; } #=============================================================================== sub peopleWaiting { grep $_ > 0, @_ } sub addToQueue { my ($value, $que) = @_; # p $que; my $i = 0; for (@$que) { unless ($_) { # skip non-zero vals $que->[$i] += $value; # will be adding to zero return 1; # return 'true' } $i++; } return 0; # return 'false' } sub removeFromQueue { my $que = shift; my $val = shift @$que; # p $val; push @$que, 0; # p $que; return $val ? 1 : 0; # returns 'true' if val was positive int } sub expire { my ($tat, $que) = @_; # int, arrayref my $i = 0; # initialise array index counter # for array position 0 to last index position: for ( 0 .. $array_size - 1 ) { # p $i; # subtract $t: $que->[$i] -= $tat; # test element at index position & auto-increment counter, if element <=0 remove # it and decrement counter as next element now occupies current index position: splice @$que, --$i, 1 if $que->[$i++] <= 0; } # p $que; # append zeros until array grows to original size: push @$que, 0 while @$que < $array_size; } sub serveOneCustomer { my ($probability, $que) = @_; # p $probability; p $que; # remove 1st element & add zero to end, returns true if success: my $boolean = removeFromQueue($que); # p $boolean; # run expire function on queue if 1st value was true # (if false all queue values must be zero): expire($tat, $que) if $boolean; # p $que; for ( 1 .. $tat ) { # p $_; # generate random number between 30 & 89: my $tolerance = int rand(59) + 30; # p $tolerance; my $rand = rand(1); # p $rand; # add new customer if rand value LESS THAN p value: addToQueue($tolerance, $que) if $rand < $probability; } # p $que; my $q_size = grep $_, @$que; # p ($q_size, $que); $q_sizes{$q_size}++; # queue-size counter return $boolean; } sub runDay { my ($probability, $number_of_turns, $que) = @_; my $total_served = 0; for ( 1 .. $number_of_turns ) { $total_served += serveOneCustomer($probability, $que); } return $total_served; } sub averageNumberServed { my ($probability, $number_of_turns, $number_of_days, $number_of_seats) = @_; my $total_served = 0; for ( 1 .. $number_of_days ) { # create new empty queue: my @que = map 0, ( 1 .. $number_of_seats ); # p @que; $total_served += runDay($probability, $number_of_turns, \@que); } return sprintf '%.02f', $total_served / $number_of_days; }