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
#!/usr/bin/perl
use strict;
use 5.010;
use warnings;
# Feldwertigkeit, Priorität absteigend
my $best = [qw /29 20 31 5 18 36 17 3 16 9 27 32
25 35 11 10 23 4 26 12 24 30 6 15
13 2 21 19 14 33 22 7 34 8 1 28/];
# dieses Array nach @best umsortieren
my @prio = qw/7 12M 3 4 17CG 25 33/;
my $tp=join(' ', @prio);
$tp=~s/[A-Z]+//g;
my @sp = split ' ', $tp;
my @folge;
for (@$best) {
my $i = 0;
for my $k (@sp) {
push @folge, $i if $_ == $k;
$i++
}
}
my @neu;
for (@folge) {
push @neu, $prio[$_]
}
print "Geordnet nach \@best: @neu\n";
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
#! /usr/bin/perl # vim:ts=4 sw=4 sts=4 et nu fdc=3: use strict; #use warnings; my @order = qw( 9 20 31 5 18 36 17 3 16 9 27 32 25 35 11 10 23 4 26 12 24 30 6 15 13 2 21 19 14 33 22 7 34 8 1 28 ); my @items = qw( 7 12M 3 4 17CG 25 33 ); # prepare order hash my %order; { my $position = 0; $order{$_}=$position++ for @order; } my @ordered_items; for my $element ( @items ) { # clean element from non-digits ( my $copy = $element ) =~ tr/0-9//cd; if ( exists $order{$copy} ) { $ordered_items[ $order{$copy} ] = $element; } else { warn "No position defined for '$element'. skipped ...\n"; } } # clean result array of undefined values @ordered_items = grep {defined} @ordered_items; print "@ordered_items\n"; __END__
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
#!/usr/bin/perl
use strict;
use 5.010;
use warnings;
# Feldwertigkeit, Priorität absteigend
my $best = [qw /29 20 31 5 18 36 17 3 16 9 27 32
25 35 11 10 23 4 26 12 24 30 6 15
13 2 21 19 14 33 22 7 34 8 1 28/];
# dieses Array nach @best umsortieren
my @prio = qw/7 12M 3 4 17CG 25 33/;
my $tp=join(' ', @prio);
$tp=~s/[A-Z]+//g;
my @sp = split ' ', $tp;
my @folge;
for (@$best) {
my $i = 0;
for my $k (@sp) {
push @folge, $prio[$i] if $_ == $k;
$i++
}
}
print "Geordnet nach \@best: @folge\n";
(my $copy = $k ) =~ tr/0-9//cd;
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
my @folge;
for (@$best) {
my $i = 0;
for my $k (@prio) {
(my $copy = $k ) =~ tr/0-9//cd;
push @folge, $prio[$i] if $_ == $copy;
$i++
}
}
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
#! /usr/bin/perl use strict; use warnings; my @order = qw( 29 20 31 5 18 36 17 3 16 9 27 32 25 35 11 10 23 4 26 12 24 30 6 15 13 2 21 19 14 33 22 7 34 8 1 28 ); my @items = qw( 7 12M 3 4 17CG 25 33 ); my %items_hash; for my $key (@items) { ( my $copy = $key ) =~ tr/0-9//cd; $items_hash{$copy}=$key; } my @folge; my $fpos=0; my $elm; for ( @order ) { $elm=delete($items_hash{$_}); $folge[$fpos++]=$elm if(defined($elm)) } print "@folge\n";
QuoteLetztens weiß eh nur hugenyn, was er eigentlich erreichen will und braucht.
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
#! /usr/bin/perl use strict; use warnings; my @order = qw( 29 20 31 5 18 36 17 3 16 9 27 32 25 35 11 10 23 4 26 12 24 30 6 15 13 2 21 19 14 33 22 7 34 8 1 28 ); my @items = qw( 7 12M 3 4 17CG 25 33 ); my %items_hash; for my $key (@items) { ( my $copy = $key ) =~ tr/0-9//cd; $items_hash{$copy}=$key; } my @folge; my $elm; for ( @order ) { $elm=delete($items_hash{$_}); push(@folge,$elm) if(defined($elm)); } print "@folge\n";
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
#!/usr/bin/perl
use strict;
use 5.010;
use warnings;
# Feldwertigkeit, Priorität absteigend
my $best = [qw /29 20 31 5 18 36 17 3 16 9 27 32
25 35 11 10 23 4 26 12 24 30 6 15
13 2 21 19 14 33 22 7 34 8 1 28/];
# dieses Array nach Haeufigkeit und
# darin jeweils nach @best sortieren
my @prio = qw/7 1 12 3 4 17 7 7 3 25 33 4 29 7 12 1 3/;
# erwartetes Ergebnis @rang: 7 3 4 12 1 29 17 25 33
my %prio_hash;
for my $key (@prio)
{
( my $copy = $key ) =~ tr/0-9//cd;
$prio_hash{$copy}=$key
}
my (@folge,$elm);
for ( @$best )
{
$elm=delete($prio_hash{$_});
push(@folge,$elm) if(defined($elm));
}
print "\n";
print "Das ist \@prio : @prio\n";
print "\n";
print "Sortiert nach \@best: @folge\n";
print "\n";
# auffuellen nach @prio
my @best_prio;
for (@folge) {
for my $i (@prio) {
push @best_prio, $_ if($i == $_)
}
}
print "\@best_prio : @best_prio\n";
print "\n";
my $erg =code(\@best_prio);
my @rang=sort ordne keys %$erg;
print "\@rang nach Häufigkeit: @rang\n";
print "\n";
# ++++++++++++++++++++++++++++++++++++++++++
sub ordne {
$$erg{$b} <=> $$erg{$a}
}
print "\n";
sub code {
my $woerter = shift;
my %zaehler;
foreach ( @$woerter ) {
$zaehler{$_}++;
}
return \%zaehler
}
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
#!/usr/bin/perl
use strict;
use 5.010;
use warnings;
# Feldwertigkeit, Priorität absteigend
my $best = [qw /29 20 31 5 18 36 17 3 16 9 27 32
25 35 11 10 23 4 26 12 24 30 6 15
13 2 21 19 14 33 22 7 34 8 1 28/];
# dieses Array nach Haeufigkeit und
# darin jeweils nach @best sortieren
my @prio = qw/7 1 12 3 4 17 7 7 3 25 33 4 29 7 12 1 3/;
# erwartetes Ergebnis @rang: 7 3 4 12 1 29 17 25 33
my $erg =code(\@prio);
my (@ar, $i, $k);
$k=1;
do {
my @et;
while ( (my $s, my $w) = each %$erg ) {
push @et, $s if $w eq $k
}
if (@et > 1) {
unshift @ar, @{&reihe(\@et)}
} else {
unshift @ar, @et
}
$k++; $i+=$k;
}
while ($i < @prio);
print "Ergebnis in \@ar ist: @ar\n";
print "\n";
# ++++++++++++++++++++++++++++++++++++++++++
sub reihe {
my $er=shift;
my %items_hash;
for my $key (@$er)
{
( my $copy = $key ) =~ tr/0-9//cd;
$items_hash{$copy}=$key;
}
my @folge;
my $elm;
for ( @$best )
{
$elm=delete($items_hash{$_});
push(@folge,$elm) if(defined($elm));
}
return \@folge
}
sub code {
my $woerter = shift;
my %zaehler;
foreach ( @$woerter ) {
$zaehler{$_}++;
}
return \%zaehler
}