zu meiner Perlseite
zur Startseite des Servers
TOP
zuletzt geändert:
QOTW steht für "Quest Of The Week". Es handelt sich dabei um ein Perl-Quest, das mehr oder weniger im wöchentlichen Rythmus gestellt wird.
Genaueres zum Quest findet man auf der offiziellen QOTW-Seite (englisch). Es gibt drei Mailinglisten, auf denen die neuen Aufgaben gestellt werden und Diskussionen rund um die Aufgaben ablaufen.
Nach jeder Aufgabe gibt es einen Zeitraum von 60 Stunden, in denen keine Lösungen oder Spoiler gepostet werden dürfen. Dazu ein Hinweis aus eigener Erfahrung: Die Startzeit in der entsprechenden Mail mit der Aufgabe ist die lokale Zeit in irgendeinem US-Bundeststaat. Man darf sich nicht darauf verlassen, einfach zu der Zeit 60 Stunden zu addieren und dann eine Lösung schicken zu dürfen. Zu dem Thema hatte ich eine ärgerliche Diskussion mit einem ziemlich arroganten Amerikaner aus dieser Liste, also Vorsicht ;-)
Hier findet man die genauen Teilname-Regeln (englisch).
Aufgabenstellung:
You will write a program that schedules the semester of courses at
Haifa University. @courses is an array of course names, such as
"Advanced Basket Weaving". @slots is an array of time slots at which
times can be scheduled, such as "Monday mornings" or "Tuesdays and
Thursdays from 1:00 to 2:30". (Time slots are guaranteed not to
overlap.)
You are also given a schedule which says when each course meets.
$schedule[$n][$m] is true if course $n meets during time slot $m,
and false if not.
Your job is to write a function, 'allocate_minimal_rooms', to allocate
classrooms to courses. Each course must occupy the same room during
every one of its time slots. Two courses cannot occupy the same room
at the same time. Your function should produce a schedule which
allocates as few rooms as possible.
The 'allocate_minimal_rooms' function will get three arguments:
1. The number of courses
2. The number of different time slots
3. A reference to the @schedule array
It should return a reference to an array, say $room, that
indicates the schedule. $room->[$n] will be the number of the
room in which course $n will meet during all of its time
slots. If courses $n and $m meet at the same time, then
$room->[$n] must be different from $room->[$m], because the
two courses cannot use the same room at the same time.
For example, suppose:
Time slots
0 1 2 3 4
Courses
0 X X (Advanced basket weaving)
1 X X X (Applied hermeneutics of quantum gravity)
2 X X (Introduction to data structures)
The @schedule array for this example would contain
([1, 1, 0, 0, 0],
[0, 1, 1, 0, 1],
[1, 0, 0, 1, 0],
)
'allocate_minimal_rooms' would be called with:
allocate_minimal_rooms(3, 5, \@schedule)
and might return
[0, 1, 1]
indicating that basket weaving gets room 0, and that applied
hermeneutics and data structures can share room 1, since they
never meet at the same time.
[1, 0, 0]
would also be an acceptable solution, of course.
Zeitstempel "Wed, 19 May 2004 09:43:36 -0400"
Diese Aufgabe reizte mich, da sie äquivalent zur Eckenfärbung eines Graphen ist. Und mit diesem Problem habe ich mich in meiner Diplomarbeit beschäftigt.
| Rooms |
#!/usr/bin/perl
use strict;
use warnings;
use Data::Dumper;
package Graph;
# This is a very simplified class representing a graph just for this purpose.
sub new {
my $g = bless({}, shift);
$g->vertices(0);
$g->alists([]);
return $g;
} # sub Graph::new
#------------------------------------------------------------------------------
sub _property {
my $self = shift; # Object
my $attr = shift; # attribute to get or set
my $setter = @_ == 1; # Is the method a setter?
my $value = shift; # value (if setter)
# If we would use "if (defined $value)" here, we couldn't set a attribute
# to undef, so this form is used:
if ($setter) {
my $old_value = $self->{$attr};
$self->{$attr} = $value;
return $old_value;
}
else {
return $self->{$attr};
}
} # sub Graph::_property
#------------------------------------------------------------------------------
sub vertices { return shift->_property('vertices', @_) }
sub alists { return shift->_property('alists', @_) }
#------------------------------------------------------------------------------
sub color {
my $self = shift;
my $algorithm = shift;
my @colors = ();
return @colors unless $self->vertices();
for (0..$self->vertices()-1) {
push @colors, -1;
}
if ($algorithm eq 'backtracking') {
# calculate upper limit with greedy:
my @colgreedy = $self->color('greedy');
my $maxcolor = 0;
for (@colgreedy) {
$maxcolor = $_ if $_ > $maxcolor;
}
# stepping down until no better solution can be found:
my $success = 1;
my $colref_old = \@colgreedy;
while ($success) {
--$maxcolor;
my @bcolors;
push @bcolors, -1 for (0..$self->vertices()-1);
$success = $self->_kBacktracking($maxcolor, \@bcolors);
if ($success) {
$colref_old = [ @bcolors ];
}
}
$colors[$_] = $colref_old->[$_] for (0..$self->vertices()-1);
}
elsif ($algorithm eq 'simple') {
$colors[0] = 0;
for my $v (1..$self->vertices()-1) {
$colors[$v] = 0;
while ($self->_has_neighbour_with_color($v, $colors[$v], \@colors)) {
++$colors[$v];
}
}
}
elsif ($algorithm eq 'greedy') {
$_ = 0 for @colors;
my $color = 0;
my $counter = 0;
while ($counter < $self->vertices()) {
++$color;
for my $v (0..$self->vertices()-1) {
if ($colors[$v] < 1 and $colors[$v] != -$color) {
$colors[$v] = $color;
++$counter;
for my $n ( @{ $self->alists()->[$v] } ) {
$colors[$n] = -$color if $colors[$n] < 1;
}
}
}
}
--$_ for @colors; # Fängt bei Null an!
}
else {
die "unknown algorithm '$algorithm'";
}
return @colors;
} # sub Graph::color
#------------------------------------------------------------------------------
sub _has_neighbour_with_color {
my $self = shift; # object
my $v = shift; # vertex
my $col = shift; # color number
my $colors = shift; # reference to color array
for my $n ( @{ $self->alists()->[$v] } ) {
return 1 if $$colors[$n] == $col;
}
return 0;
} # sub Graph::_has_neighbour_with_color
#------------------------------------------------------------------------------
sub _kBacktracking {
my $self = shift; # object
my $k = shift; # color number
my $c = shift; # reference to color array
die "_kBacktracking : Farbe $k zu klein." if $k < 0;
return $self->_btcTry(0, $k, $c);
} # sub Graph::_kBacktracking
#------------------------------------------------------------------------------
sub _btcTry {
my $self = shift; # object
my $i = shift; # vertex number
my $k = shift; # color number
my $c = shift; # reference to color array
my $n = $self->vertices();
my $color = -1;
my $q = 0;
die "_btcTry : vertex i = $i is not valid (valid is: [0, " . ($n-1) . "])"
if $i >= $n;
die "_btcTry : color k = $k is not valid (valid is: [0, " . ($n-1) . "])"
if $k < 0 or $k >= $n;
while (not $q and $color != $k) {
++$color;
last if $i == 0 and $color > 0;
if ($self->_btcPossible($i, $color, $c)) {
$c->[$i] = $color;
if ($i < $n-1) {
$q = $self->_btcTry($i+1, $k, $c);
$c->[$i] = -1 unless $q;
}
else {
$q = 1;
}
}
}
return $q;
} # sub Graph::_btcTry
#------------------------------------------------------------------------------
sub _btcPossible {
my $self = shift; # object
my $i = shift; # vertex number
my $color = shift; # color number
my $c = shift; # reference to color array
for my $n (@{ $self->alists()->[$i] }) {
return 0 if $c->[$n] == $color;
}
return 1;
} # sub Graph::_btcPossible
package main;
sub main ();
sub allocate_minimal_rooms ($$$);
main();
exit;
sub main () {
my @courses = (
'Advanced basket weaving',
'Applied hermeneutics of quantum gravity',
'Introduction to data structures'
);
my @slots = (
'Monday morning _very_ early :-D',
'Tuesday',
'We. 10:00 to 12:00',
'Th. 19:00 to 20:00',
'Friday evening',
);
my @schedule = (
[1, 1, 0, 0, 0],
[0, 1, 1, 0, 1],
[1, 0, 0, 1, 0],
);
my $rooms = allocate_minimal_rooms(scalar @courses,
scalar @slots,
\@schedule);
for my $rind (0..$#$rooms) {
print "course '$courses[$rind]' meets in room ", @{$rooms}[$rind], ".\n";
}
} # sub main
sub allocate_minimal_rooms ($$$) {
my $nrofcourses = shift;
my $nrofslots = shift;
my $schedule = shift;
#
# first caculating minimal overlap:
# (only for a minimum value, jfyi)
#
if (0)
{
my @minlapslots;
my $min = 1;
for my $sind (0..$nrofslots-1) {
$minlapslots[$sind] = 0;
for my $cind (0..$nrofcourses-1) {
$minlapslots[$sind] += $schedule->[$cind][$sind];
}
$min = $minlapslots[$sind] if $min < $minlapslots[$sind];
}
print "We need at least $min rooms.\n";
print Dumper(\@minlapslots);
}
# This problem is NP complete. It's analog to the problem of coloring the
# vertices of a graph with the minimum number of colors.
#
# And about this problem and solutions for it I wrote my degree
# dissertation in graph theory.
#
# Thusfor I transform the problem to a graph, where each vertex stands for
# one course and an edge stands for a slot, in which both of the adjacent
# vertexes (=courses) will meet:
my $graph = new Graph;
$graph->vertices($nrofcourses);
my $alists = $graph->alists();
for my $cind (0..$nrofcourses-1) {
$graph->alists()->[$cind] = [];
for my $cind2 (0..$nrofcourses-1) {
next if $cind == $cind2;
for my $sind (0..$nrofslots-1) {
if (
$schedule->[$cind ][$sind] and
$schedule->[$cind2][$sind]
)
{
push @{$graph->alists()->[$cind]}, $cind2;
}
}
}
}
print Dumper($graph);
#
# Now we could use any algorithm we want to color the graph, if we want
# the exact minimal number of rooms, we have to use backtracking.
# Else we could use any heuristic algorithm we want, as greedy for example.
# The first one will be exact, the latter one much faster.
#
# In my degree dissertation I discussed many algorithms (but I used C++
# and not Perl). If anyone here is interessted, I could post more
# algorithms.
#
# Color the graph:
my @rooms = $graph->color('backtracking');
#my @rooms = $graph->color('greedy');
#my @rooms = $graph->color('simple');
return \@rooms;
# This was a very mathematical way of solving the given problem:
# transforming it in a problem I solved before and solve that ;-)
# Thusfore a "direct" transformation of the backtracking algorithm to the
# form of the given problem would perhaps be faster, but I wanted to show
# the interrelation of the given problem to graph theory.
# NP complete problems like this one won't be solved by an exact algorithm
# with polynomial complexity. If you find such an algorithm, you will get
# rich :-D Because if you solve any of the NP complete Problems, you have
# solved _all_ of them, including Traveling Salesman Problem and much more.
} # allocate_minimal_rooms
|
Aufgabenstellung:
When I was in elementary school I wasted many an hour playing hangman
with my friends.
The Game of Hangman
--------------------
The goal of the game is to guess a word with a certain (limited)
number of guesses. If we fail the "man" gets "hanged," if we succeed
he is set free. (We're not going to discuss the lesson's of life or
justice this game teaches to the 8 year olds who play it regularly).
The game starts out with one person (not the player) choosing a
"mystery" word at random and telling the player how many letters the
mystery word contains. The player then guesses letters, one at a time,
and the mystery word's letters are filled in until a) the entire word
is filled in, or b) the maximum number of guesses are reached and the
the player loses (man is hanged).
Write a perl program which lets the user play hangman. The program
should take the following arguments:
1) the dictionary file to use
2) the maximum number of guesses to give the player.
The program must then chose a mystery word from the dictionary file
and print out as many underscores ("_") as there are letters in the
mystery word. The program will then read letters from the user one at
a time. After each guess the program must print the word with properly
guessed letters filled in. If the word has been guessed (all the
letters making up the word have been guessed) then the program must
print "LIFE!" and exit. If the word is not guessed before the maximum
number of guesses is reached then the program must print "DEATH!" and
exit.
Example interaction:
% ./hangman /usr/share/dict 5
___
c
___
m
m__
d
m__
a
ma_
n
LIFE!
$ ./hangman /usr/share/dict 3
___
c
___
m
m__
d
DEATH!
%
NOTES
------
1) The dictionary file will contain one word per line and use only
7-bit ASCII characters. It may contain randomly generated
words. The dictionary will contain only words longer than 1
character. The size of the dictionary may be very large. See
http://perl.plover.com/qotw/words/
for sample word lists.
2) The dictionary file used for the test (or the program for
generating it) will be made available along with the write-up.
3) If a letter appears more than once in the mystery word, all
occurrences of that letter must be filled in. So, if the word is
'bokonon' and the player guesses 'o' the output must be '_o_o_o_'.
Zeitstempel "Wed, 26 May 2004 07:47:45 -0400"
Diese Aufgabe war nicht schwer, aber als ich sie las, schwebte mir ein Programmcode in Form eines hängenden Männchens vor. Deshalb machte ich mich an die Lösung der Aufgabe, hier ist sie:
| Hangman |
print
("$0 [-h] [-o] [-v] dictfile tries\n\t-o allows original game rules\n\t-v shows helpful in",
"fos\n")&&exit if $ARGV[0 ]eq'-h'or 2<@ARGV;$ n=$v=1,shift if $ARGV[ 0]eq'-vo'or$ ARGV [0]eq
'-ov';$v=1,shift if$ARGV[0]eq'-v';$n= 1,shift if$ARGV [0]eq'-o';$v=1,shift if$ ARGV[0]eq'-v'
;open I,$ ARGV
[0]or die 'n'.
'o '. 'd'. 'i'.
'ct'. 'i'. 'o'.
'na'. 'r'. 'y'.
" '".$ARGV [0].
"' fo". "u".'nd '
.'('. "$!)";@w=<I>;
chomp ($w=$w[int rand
@w]); $t=$ARGV[01];
while (07){%S=();
%T=() ;if
(join (''
,grep {!$S{$_}++}sort
split (//,$w))eq join('',grep{
! $T{ $_}++}sort(split //,$g))){
print "\tLIFE!\n";exit;}last if! $t;
print "\t",(map{(index($g,$_)>=0)?$_
:'_'} split(//,$w)),($v?" ($t ".($n?
'wro' .'ng ':'').'guesses left [gue'
.'ss' .'ed:'.$g.'/'.$f.'])':''),"\n"
;$i = substr<STDIN>,0,1;--$t if!$n;if(
index ($w,$i)>=0){--$t if$n&&index($g,$i
)>=0; $g.=$i;}else{--$t if $n;
$ f.= $i;}}print "\tDEA"
,"TH" ,"!\n";print"the "
,"So" ,"lution was $w\n"
if$v; # Copyright 2004
#by C hristian Dühl. Al
#l ri ghts reserved. Thi
#s pr ogram is free soft
#ware . You can redistrib
#ute# it and/or m odify it un
#der#
#the#
#same
#term
#s as
#perl itself.
|
Quellcode zum Download (hangman.pl).
Hier ist die Lösung in menschenlesbarer Form:
| Hangman (Human readable) |
print("$0 [-h] [-o] [-v] dictfile tries\n\t-o allows original game rules\n\t-v shows helpful infos\n")
&& exit if $ARGV[0] eq '-h' or 2 < @ARGV;
$n = $v = 1, shift if $ARGV[0] eq '-vo' or $ARGV[0] eq '-ov';
$v = 1, shift if $ARGV[0] eq '-v';
$n = 1, shift if $ARGV[0] eq '-o';
$v = 1, shift if $ARGV[0] eq '-v';
open I, $ARGV[0] or die "no dictionary '" . $ARGV[0] . "' found ($!)";
@w = <I>;
chomp($w = $w[int rand @w]);
$t = $ARGV[01];
while (07) {
%S = ();
%T = ();
if ( join('', grep {!$S{$_}++} sort split(//, $w)) eq join('', grep {!$T{$_}++} sort(split //, $g)) ) {
print "\tLIFE!\n";
exit;
}
last if !$t;
print "\t", (map {(index($g, $_) >= 0) ? $_ : '_'} split(//, $w)),
($v ? " ($t " . ($n ? 'wrong ' : '')
. 'guesses left [guessed:'
. $g . '/' . $f . '])'
: ''),
"\n";
$i = substr <STDIN>, 0, 1;
--$t if !$n;
if (index($w, $i) >= 0) {
--$t if $n && index($g, $i) >= 0;
$g .= $i;
}
else {
--$t if $n;
$f .= $i;
}
}
print "\tDEATH!\n";
print "the Solution was $w\n" if $v;
# Copyright 2004 by Christian Dühl. All rights reserved. This program is free software.
# You can redistribute it and/or modify it under the same terms as perl itself.
|
Quellcode zum Download (hangman_human.pl).
Das Programm erhält als ersten Parameter wie oben in der Aufgabenstellung beschrieben eine Wörterbuchdatei genannt. Dieses Wörterbuch wurde vom Autor des Quests zur Verfügung gestellt.
Mit der Option -h bekommt man eine Syntaxbeschreibung des Aufrufs. Die Optionen -o und -v sind eigentlich generell empfehlenswert. Erstere schaltet auf die Originalregeln des Spiels um (default: Regeln laut Aufgabenbeschreibung), letztere zeigt hilfreiche Zusatzinformationen für den Spieler an.
Hier finden sich zwei Threads, in denen ich diese Lösung vorgestellt habe, in der Mailingliste war die Resonanz gleich Null oder noch schlechter ("war wohl nicht so gemeint, dass man sich den Code ansehen soll, deshalb habe ich das auch nicht getan" - schade, wenn der arme Mensch kein perltidy hat...):
Aufgabenstellung:
You will write a program to perform scheduling. As we all
know, tasks sometimes take longer than expected. Sometimes
when this happens, the final deadline of the project is
affected; sometimes it isn't. For example, consider the four
tasks A, B, C, and D. B and C depend on A, which means that
they cannot be started until A is finished. D depends on B and
C, and cannot be started until both B and C are finished:
.-> B .
A :-> D
`-> C '
Suppose we expect the four tasks to take the following times:
A: 1 day
B: 2 days
C: 3 days
D: 1 day
Then we don't expect the project to be finished for at least 5
days: one day to complete A and start C; 3 days to complete C
and start D, and another day to finish D. Any delay in any of
the three tasks A, C, or D will cause the completion date to
slip. We say that A, C, and D are on the "critical path".
But B is not on the critical path, because B can go on while C
is going on, and can take up to one day longer than expected
without delaying the start of D.
You will write a program which will calculate critical paths. The
input to the program will be a file in the following format:
A 1
B 2 A
C 3 A
D 1 B C
FINAL 0 D
Each line represents one task. The first field in each line
is the name of the task. The second field is the expected
duration. If there are any other fields, they are the names
of other tasks which must be finished before this task can
start.
The program will find all the tasks on the critical path to
the task named FINAL and will print them out, one per line.
It may happen that the input specifies tasks that cannot possibly be
completed. For example:
A 1 B
B 1 A
FINAL 0 A B
Here A can't start until B is finished, but B can't start until A is
finished. In such cases, the program should diagnose an error.
Zeitstempel "Thu, 05 Aug 2004 11:44:43 -0400"
Meine Lösung:
| Critical tasks |
#!/usr/bin/perl
=pod
=head1 NAME
qotw21.pl
=head1 SYNTAX
qotw21.pl task-file
cat task-file | qotw21.pl
=head1 TASK
You will write a program to perform scheduling. As we all
know, tasks sometimes take longer than expected. Sometimes
when this happens, the final deadline of the project is
affected; sometimes it isn't. For example, consider the four
tasks A, B, C, and D. B and C depend on A, which means that
they cannot be started until A is finished. D depends on B and
C, and cannot be started until both B and C are finished:
.-> B .
A :-> D
`-> C '
Suppose we expect the four tasks to take the following times:
A: 1 day
B: 2 days
C: 3 days
D: 1 day
Then we don't expect the project to be finished for at least 5
days: one day to complete A and start C; 3 days to complete C
and start D, and another day to finish D. Any delay in any of
the three tasks A, C, or D will cause the completion date to
slip. We say that A, C, and D are on the "critical path".
But B is not on the critical path, because B can go on while C
is going on, and can take up to one day longer than expected
without delaying the start of D.
You will write a program which will calculate critical paths. The
input to the program will be a file in the following format:
A 1
B 2 A
C 3 A
D 1 B C
FINAL 0 D
Each line represents one task. The first field in each line
is the name of the task. The second field is the expected
duration. If there are any other fields, they are the names
of other tasks which must be finished before this task can
start.
The program will find all the tasks on the critical path to
the task named FINAL and will print them out, one per line.
It may happen that the input specifies tasks that cannot possibly be
completed. For example:
A 1 B
B 1 A
FINAL 0 A B
Here A can't start until B is finished, but B can't start until A is
finished. In such cases, the program should diagnose an error.
=cut
#------------------------------------------------------------------------------
# pragmas and modules:
#------------------------------------------------------------------------------
use strict;
use warnings;
#use Data::Dumper; $Data::Dumper::Sortkeys = 1;
#------------------------------------------------------------------------------
# prototypes:
#------------------------------------------------------------------------------
sub allpre ($$);
sub allsuc ($$);
sub calcpathes ($$);
#------------------------------------------------------------------------------
# global variables:
#------------------------------------------------------------------------------
my %task;
#------------------------------------------------------------------------------
# read input file
#------------------------------------------------------------------------------
while (<>) {
#print;
chomp;
my ($name, $time, @pre) = split /\s+/;
if (exists $task{$name}) {
die "Ambigous task definition '$_' in line $.: task '$name' ".
"already defined!";
}
else {
$task{$name} = { duration => $time,
predecessor => [ @pre ],
};
}
}
#------------------------------------------------------------------------------
# test task integrity
#------------------------------------------------------------------------------
=head1 TESTS
The following problems are tested by the program:
=over
=item Is there a task called 'FINAL'?
If not, the program dies with the message
C
|
Quellcode zum Download (qotw21.pl).
It documents itself with perlpod:
QOTW21(1) User Contributed Perl Documentation QOTW21(1)
NAME
qotw21.pl
SYNTAX
qotw21.pl task-file
cat task-file | qotw21.pl
TASK
You will write a program to perform scheduling. As we all
know, tasks sometimes take longer than expected. Sometimes
when this happens, the final deadline of the project is
affected; sometimes it isn't. For example, consider the four
tasks A, B, C, and D. B and C depend on A, which means that
they cannot be started until A is finished. D depends on B and
C, and cannot be started until both B and C are finished:
.-> B .
A :-> D
`-> C '
Suppose we expect the four tasks to take the following times:
A: 1 day
B: 2 days
C: 3 days
D: 1 day
Then we don't expect the project to be finished for at least 5
days: one day to complete A and start C; 3 days to complete C
and start D, and another day to finish D. Any delay in any of
the three tasks A, C, or D will cause the completion date to
slip. We say that A, C, and D are on the "critical path".
But B is not on the critical path, because B can go on while C
is going on, and can take up to one day longer than expected
without delaying the start of D.
You will write a program which will calculate critical paths. The
input to the program will be a file in the following format:
A 1
B 2 A
C 3 A
D 1 B C
FINAL 0 D
Each line represents one task. The first field in each line
is the name of the task. The second field is the expected
duration. If there are any other fields, they are the names
of other tasks which must be finished before this task can
start.
The program will find all the tasks on the critical path to
the task named FINAL and will print them out, one per line.
It may happen that the input specifies tasks that cannot possibly be
completed. For example:
A 1 B
B 1 A
FINAL 0 A B
Here A can't start until B is finished, but B can't start until A is
finished. In such cases, the program should diagnose an error.
TESTS
The following problems are tested by the program:
Is there a task called 'FINAL'?
If not, the program dies with the message
C.
Are all given predecessor tasks known?
If not the program dies with
C.
Is a task a direct predecessor of itself?
If this is the case, the program dies with
C.
Is a task a indirect predecessor of itself?
If this is the case, the program dies with
C.
Are there any unused tasks for the task 'FINAL'?
If this is the case, the program gives the warning
C.
CALCULATIONS
The following things are calculated by the program:
The direct predecessors of all tasks.
(These are given in the input directly.)
All predecessors of all tasks.
Therefore we have to cycle through all the predecessors and
collect them by doing so. (This is done in the function
C.)
The level (or column) of each task.
This means in which column the task can be printed. This is
the first step for plotting the tasks. Tasks with no
predecessors can be printed in column 0 (the left most column),
all other tasks can be printed one column after the highest
column of all its predecessors.
The direct successors of all tasks.
Therefore we have to look at all tasks, if the given task
'X' is a predeccessor of task 'Y', then 'Y' is a successor
of task 'X'.
All successors of all tasks.
Therefore we have to cycle through all the successors and
collect them by doing so. (This is done in the function
C.)
The pathes to the task 'FINAL'.
Therefore we have to cycle backwards through all the
predecessors and split the possible pathes for each
direct predeccessor we find.
DATA STRUCTURES
The program creates a HoH (hash of hashes), where the name
of the tasks are the keys and the values are a hash with
informations about this task. Here is an example for one
entry of this HoH:
'FINAL' => {
'duration' => '0',
'level' => 3,
'predecessor' => [
'D'
],
'predecessorall' => [
'A',
'B',
'C',
'D'
],
'successor' => [],
'successorall' => []
}
The name of this HoH is C<%task>.
The calculated pathes to the task 'FINAL' are stored in an
AoA (array of arrays) called C<@pathes>. This is the structur
of the AoA:
(
[
'A',
'B',
'D'
],
[
'A',
'C',
'D'
]
)
The critical tasks are stored in a simple array called
C<@maxtasks> and they are printed out one task by line.
EXAMPLES
The example given in the task description
crian@blitz:~/perl/qotw> cat qotw21_input1.txt
A 1
B 2 A
C 3 A
D 1 B C
FINAL 0 D
crian@blitz:~/perl/qotw> qotw21.pl qotw21_input1.txt
A
C
D
Circle predecessors / successors ('A'-'B'-'A')
crian@blitz:~/perl/qotw> cat qotw21_input2.txt
A 1 B
B 1 A
FINAL 0 A B
crian@blitz:~/perl/qotw> qotw21.pl qotw21_input2.txt
preliminary circle with task 'B' at
./qotw21.pl line 432, <> line 3.
Multiple definition of one task ('A')
crian@blitz:~/perl/qotw> cat qotw21_input3.txt
A 1 B
A 1 C
B 1 C
FINAL 0 C
crian@blitz:~/perl/qotw> qotw21.pl qotw21_input3.txt
Ambigous task definition 'A 1 C' in line 2: task 'A'
already defined! at ./qotw21.pl line 102, <> line 2.
Undefined tasks ('C')
crian@blitz:~/perl/qotw> cat qotw21_input4.txt
A 1 B
B 1 C
FINAL 0 A B
crian@blitz:~/perl/qotw> qotw21.pl qotw21_input4.txt
Task 'C' is not defined, but it is a preliminary task
of task 'B' at ./qotw21.pl line 145, <> line 3.
Longer circle predecessors / successors ('E'-'F'-'G'-'E')
crian@blitz:~/perl/qotw> cat qotw21_input5.txt
A 1
B 2 A
C 3 A
D 1 B C
E 1 G
F 1 E
G 1 F
FINAL 0 D G
crian@blitz:~/perl/qotw> qotw21.pl qotw21_input5.txt
preliminary circle with task 'E' at
./qotw21.pl line 432, <> line 8.
Unused tasks ('E')
crian@blitz:~/perl/qotw> cat qotw21_input6.txt
A 1
B 2 A
C 3 A
D 1 B C
E 12 C
FINAL 0 D
crian@blitz:~/perl/qotw> qotw21.pl qotw21_input6.txt
unused tasks for 'FINAL' : 'E' at
./qotw21.pl line 220, <> line 6.
A
C
D
perl v5.8.3 2004-08-08 QOTW21(1)
Hier ist ein Thread, in denen ich diese Lösung vorgestellt habe: