|< 1 2 >| | 11 Einträge, 2 Seiten |
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
use strict;
use warnings;
use Perl6::Say;
use Data::Dumper qw/Dumper/;
my $t_order = [];
my $nt_order = [];
my @class = qw(5 4 3 6 1);
say "sort leftof (@class): " . join ":", (sort {sort_leftof($a, $b, $t_order, $nt_order)} @class);
sub sort_leftof {
my $x1 = shift;
my $x2 = shift;
my $t_order = shift;
my $nt_order = shift;
if( $x1 < 500 and $x2 < 500 ) {
$x1 < $x2;
}
} # /sort_leftof
1
2
3
4
5
6
7
8
9
10
11
sub sort_leftof {
my $x1 = shift;
my $x2 = shift;
my $t_order = shift;
my $nt_order = shift;
if( $x1 < 500 and $x2 < 500 ) {
$x1 < $x2;
}
} # /sort_leftof
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();
QuoteJa, was ist eigentlich mit den Rückgabewerten? Müssen die 0 oder 1 sein?
QuoteIf SUBNAME is specified, it gives the name of a subroutine that returns an integer less than, equal to, or greater than 0, depending on how the elements of the list are to be ordered.
pktm+2008-04-01 23:32:16--Ich rate dann mal so:
Wenn die 0 zurück kommt, dann werden die beiden Elemente aufsteigend sortiert und bei der 1 absteigend.
Quote<=> machts leider nicht besser, aber der umgekehrte Operator.
|< 1 2 >| | 11 Einträge, 2 Seiten |