Thread RDW #2 - Rätsel der Woche Nr. 2 (155 answers)
Opened by renee at 2004-07-16 12:08

ptk
 2004-07-19 15:04
#84464 #84464
User since
2003-11-28
3645 Artikel
ModeratorIn
[default_avatar]
Da wurde irgendwann irgendwas verschluckt.
Code: (dl )
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
#!/usr/bin/perl

use strict;

# Eingabe
my @array = (1..9);

my %res;
warn time;
oneless(@array);
warn time;

# Formatierung der Ausgabe
# Key als Array umschreiben
my @res;
while(my($k) = each %res) {
push @res, [split /,/, $k];
}
# Ergebnisarray schoener sortieren
@res = sort {
my $r = @$a <=> @$b;
if ($r == 0) {
join(",", @$a) cmp join(",", @$b);
} else {
$r;
}
} @res;
require Data::Dumper;
print Data::Dumper->new([\@res],['res'])->Indent(0)->Dump, "\n";

sub oneless {
my @array = @_;
$res{ join",",@array } = 1;
return if !@array;
for my $i (0 .. $#array) {
oneless(map { $array[$_] } 0 .. $i-1, $i+1 .. $#array);
}
}

View full thread RDW #2 - Rätsel der Woche Nr. 2