#!/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();