Лучший способ сортировки по частоте в 2D массиве?

Question

У меня есть этот метод сортировки, который в основном представляет собой просто основные мыслительные процессы, не использующие силу Perl, и время от времени он не действует так, как я хочу (пропускает некоторый подсчет частоты).Мне было интересно, есть ли лучший способ сортировки этого.

Цель Сортировать массив по частоте найденных совпадений.

Пример массива массивов

##ADDED 1 to END of EACH ROW, just because my sort forced me too!!!
my @all_matches = (["chpt10_2", "sent. 2", "alice", "nsubj", "animals", "protect"],
               ["chpt12_1", "sent. 54", "bob", "nsubj", "cells", "protect"],
               ["chpt25_4", "sent. 47", "carol", "nsubj", "plants", "protect"],
               ["chpt34_1", "sent. 1", "dave", "nsubj", "cells", "protect"],
               ["chpt35_1", "sent. 2", "eli", "nsubj", "cells", "protect"],
               ["chpt38_1", "sent. 1", "fred", "nsubj", "animals", "protect"],
               ["chpt54_1", "sent. 1", "greg", "nsubj", "uticle", "protect"]
              );

Текущая сортировка

@all_matches = sort {lc($a->[4]) cmp lc($b->[4])} @all_matches;

my ($last_word, $current_word, $word_count);

for my $j (0 .. $#all_matches) {

    $current_word = $all_matches[$j][4];

    if (lc($last_word) eq lc($current_word)) {
        $word_count++;
        }
    else {
        if ($j != 0)
        {
            for (my $k = 1; $k <= $word_count; $k++)
            {
               $all_matches[($j-$k)][6] = $word_count; 
            }
        }
        $last_word = $current_word;
        $word_count = 1;
        }
}
@all_matches = sort {$b->[6] <=> $a->[6] || lc($a->[4]) cmp lc($b->[4])} @all_matches;

Проблема 6-й столбец устанавливается в 1, когда all_matches передается в !!!Причина, по которой это было сделано, заключалась в том, что иногда счет ($match->[6]) был пустым.

Бонус? Частота совпадений, когда последние два столбца появляются вместе (сейчас я довольноуверен, что просто проверяет 2-й последний столбец).В этом тестовом примере последний столбец одинаков, в реальном случае на конце есть разные суффиксы (т. Е. Защита, защита, защита и т. Д.)

СПАСИБО много за ваше время.Я пытался использовать хеш и думал, что это сработало, но некоторые вещи пренебрегали.

Вот моя попытка хеширования.Пока не могу сказать, почему это не сработало:

my %freq;
foreach ( map{$_->[4]}@results) #feeds in list of animals, cells, uticle, etc.
{
   $freq{lc $_}++;
}


@results = sort {$freq{lc $b->[4]} <=> $freq{lc $a->[4]} #freq order
                                   or
                         $a->[0]  cmp $b->[0]            #text col 0      
                } @results; 

Answer 1

Почему бы не создать хеш ключей с подсчетом вхождений и использовать это:

my %counts;
foreach my $rowref (@all_matches)
{
     $counts{lc($rowref->[4])}++;
}

@all_matches = sort { $counts{lc($b->[4])} <=> $counts{lc($a->[4])} ||
                      lc($a->[4]) cmp lc($b->[4])
                    } @all_matches;

Испытано ...

#!/usr/bin/env perl

use strict;
use warnings;

my @all_matches = (
    ["chpt10_2", "sent. 2", "alice", "nsubj", "animals", "protect"],
    ["chpt12_1", "sent. 54", "bob", "nsubj", "cells", "protect"],
    ["chpt25_4", "sent. 47", "carol", "nsubj", "plants", "protect"],
    ["chpt34_1", "sent. 1", "dave", "nsubj", "cells", "protect"],
    ["chpt35_1", "sent. 2", "eli", "nsubj", "cells", "protect"],
    ["chpt38_1", "sent. 1", "fred", "nsubj", "animals", "protect"],
    ["chpt54_1", "sent. 1", "greg", "nsubj", "uticle", "protect"]
    );

my %counts;
foreach my $rowref (@all_matches)
{
    $counts{lc($rowref->[4])}++;
}

@all_matches = sort { $counts{lc($b->[4])} <=> $counts{lc($a->[4])} ||
                      lc($a->[4]) cmp lc($b->[4])
                    } @all_matches;

my $i = 0;
foreach my $rowref (@all_matches)
{
    $i++;
    print "$i";
    print " $_" foreach (@$rowref);
    print "\n";
}

Выход:

1 chpt12_1 sent. 54 bob nsubj cells protect
2 chpt34_1 sent. 1 dave nsubj cells protect
3 chpt35_1 sent. 2 eli nsubj cells protect
4 chpt10_2 sent. 2 alice nsubj animals protect
5 chpt38_1 sent. 1 fred nsubj animals protect
6 chpt25_4 sent. 47 carol nsubj plants protect
7 chpt54_1 sent. 1 greg nsubj uticle protect

Как отмечается в комментарии, учитывая показанные данные, операции lc не нужны - и их удаление повысит производительность, как если бы к каждому массиву добавлялся ключ с преобразованием регистра.

И с lc, используемым один раз в строке - обратите внимание на значения данных, которые были сброшены:

#!/usr/bin/env perl

use strict;
use warnings;

my @all_matches = (
    [ "chpt10_2", "sent. 2",  "alice", "nsubj", "animAls", "protect" ],
    [ "chpt12_1", "sent. 54", "bob",   "nsubj", "celLs",   "protect" ],
    [ "chpt25_4", "sent. 47", "carol", "nsubj", "plAnts",  "protect" ],
    [ "chpt34_1", "sent. 1",  "dave",  "nsubj", "cElls",   "protect" ],
    [ "chpt35_1", "sent. 2",  "eli",   "nsubj", "cells",   "protect" ],
    [ "chpt38_1", "sent. 1",  "fred",  "nsubj", "Animals", "protect" ],
    [ "chpt54_1", "sent. 1",  "greg",  "nsubj", "uticle",  "protect" ],
    );

my %counts;
foreach my $rowref (@all_matches)
{
    push @$rowref, lc($rowref->[4]);
    $counts{$rowref->[6]}++;
}

@all_matches = sort { $counts{$b->[6]} <=> $counts{$a->[6]} || $a->[6] cmp $b->[6]
                    } @all_matches;

my $i = 0;
foreach my $rowref (@all_matches)
{
    $i++;
    print "$i";
    printf " %-9s", $_ foreach (@$rowref);
    print "\n";
}

Выход:

1 chpt12_1  sent. 54  bob       nsubj     celLs     protect   cells    
2 chpt34_1  sent. 1   dave      nsubj     cElls     protect   cells    
3 chpt35_1  sent. 2   eli       nsubj     cells     protect   cells    
4 chpt10_2  sent. 2   alice     nsubj     animAls   protect   animals  
5 chpt38_1  sent. 1   fred      nsubj     Animals   protect   animals  
6 chpt25_4  sent. 47  carol     nsubj     plAnts    protect   plants   
7 chpt54_1  sent. 1   greg      nsubj     uticle    protect   uticle   

Answer 2

Попробуйте это:

my @all_matches = (["chpt10_2", "sent. 2", "alice", "nsubj", "animals", "protect"],
        ["chpt12_1", "sent. 54", "bob", "nsubj", "cells", "protect"],
        ["chpt25_4", "sent. 47", "carol", "nsubj", "plants", "protect"],
        ["chpt34_1", "sent. 1", "dave", "nsubj", "cells", "protect"],
        ["chpt35_1", "sent. 2", "eli", "nsubj", "cells", "protect"],
        ["chpt38_1", "sent. 1", "fred", "nsubj", "animals", "protect"],
        ["chpt54_1", "sent. 1", "greg", "nsubj", "uticle", "protect"]
        );

my %wordcount;

foreach my $row (@all_matches) {
        $wordcount{$row->[4]}++;
}

my @sorted = sort { $wordcount{$b->[4]} <=> $wordcount{$a->[4]}  } @all_matches;