#!/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
}