Opened by pktm at 2008-04-02 00:31
User since
2003-08-07
2921 Artikel
BenutzerIn
![[Homepage]](/battie/theme/default/homepage.gif)
2003-08-07
2921 Artikel
BenutzerIn
Ja, was ist eigentlich mit den Rückgabewerten? Müssen die 0 oder 1 sein?
Hier eine vollständigere Version:
Das ist so lauffähig. Testdaten sind gegeben. Es wird durchweg falschherum sortiert :-s
Grüße, pktm
Hier eine vollständigere Version:
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
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
#!/Perl/bin/perl
package Test;
use strict;
use warnings;
use Perl6::Say;
use Data::Dumper qw/Dumper/;
sub new {
my $class = shift;
return bless({}, $class);
} # /new
sub compare_test {
my $self = shift;
my $t_order = [[500,[1,2]],[504,[3]],[501,[4,5]],[502,[6]],[507,[7,8]],[0,[9]]];
my $nt_order = [[502,['507']],[503,['501']],[504,['503']],[505,['504','500']],['0',['505']]];
say "sort leftof(5 4 3 6 1) => (1 3 4 5 6): " . join ":", (sort {$self->sort_leftof($a, $b, $t_order, $nt_order)} qw(5 4 3 6 1));
say "sort leftof(500 504) => (500 504): " . join ":", (sort {$self->sort_leftof($a, $b, $t_order, $nt_order)} qw(500 504));
say "sort leftof(9 505) => (505 9): " . join ":", (sort {$self->sort_leftof($a, $b, $t_order, $nt_order)} qw(9 505));
}
sub sort_leftof {
my $self = shift;
my $x1 = shift;
my $x2 = shift;
my $t_order = shift;
my $nt_order = shift;
croak("Ungültige Werte! ($x1, $x2)") if $x1 == $x2;
if( $x1 < 500 and $x2 < 500 ) {
# -- Beides Terminale
# 1 : 2
$x1 < $x2;
}elsif( ($x1 < 500 and $x1 != 0) and ($x2 >= 500 or $x1 == 0) ) {
# -- linkes ist Terminal
# 1 : 500
$x1 < $self->get_leftmost_terminal($x2,$t_order,$nt_order);
}elsif( ($x1 >= 500 or $x1 == 0) and ($x2 < 500 and $x2 != 0) ) {
# -- rechtes ist Terminal
# 500 : 1
$self->get_rightmost_terminal($x1,$t_order,$nt_order) < $x2;
}elsif( ($x1 == 0 or $x1 >= 500) and ($x2 == 0 or $x2 >= 500) ) {
# -- beides sind Nichtterminale
# 500 : 501
$self->get_rightmost_terminal($x1,$t_order,$nt_order) < $self->get_leftmost_terminal($x2,$t_order,$nt_order);
}
} # /sort_leftof
=head2 get_leftmost_terminal( ... )
=cut
sub get_leftmost_terminal {
my $self = shift;
my $c = shift;
my $t_order = shift;
my $nt_order = shift;
croak("Cannot lookup noncomplex structure! ID: $c") if( $c != 0 and $c < 500 );
# Ist $c bereits in $t_order enthalten?
foreach my $tupel ( @{$t_order} ) {
if( $tupel->[0] == $c ) {
return $tupel->[1]->[0];
}
}
# Wenn hier, dann ist $c noch nicht in $n_order enthalten, dafür aber in
# $nt_order.
foreach my $tupel ( @{$nt_order} ) {
if( $tupel->[0] == $c ) {
return $self->get_leftmost_terminal($tupel->[1]->[0], $t_order, $nt_order);
}
}
croak("get_leftmost_terminal: terminal id $c not found!");
} # /get_leftmost_terminal
=head2 get_rightmost_terminal( ... )
=cut
sub get_rightmost_terminal {
my $self = shift;
my $c = shift;
my $t_order = shift;
my $nt_order = shift;
croak("Cannot lookup noncomplex structure! ID: $c") if( $c != 0 and $c < 500 );
# Ist $c bereits in $t_order enthalten?
foreach my $tupel ( @{$t_order} ) {
if( $tupel->[0] == $c ) {
return $tupel->[1]->[-1];
}
}
# Wenn hier, dann ist $c noch nicht in $n_order enthalten, dafür aber in
# $nt_order.
foreach my $tupel ( @{$nt_order} ) {
if( $tupel->[0] == $c ) {
return $self->get_rightmost_terminal($tupel->[1]->[0], $t_order, $nt_order);
}
}
croak("get_leftmost_terminal: terminal id $c not found!");
} # /get_rightmost_terminal
1;
use strict;
use warnings;
my $app = Test->new();
$app->compare_test();
Das ist so lauffähig. Testdaten sind gegeben. Es wird durchweg falschherum sortiert :-s
Grüße, pktm
http://www.intergastro-service.de (mein erstes CMS :) )