source: nawszelkiwypadek/tools/gue_dic/stat_pre.pl @ 4216369

#! /usr/bin/perl

use locale;

######################################################
# na wej¶ciu znajduje siê plik zawieraj±cy linie     #
# postaci:                                           #
# slowo;opis                                         #
#                                                    #
# na wyj¶ciu ma siê znaleŒæ plik zawieraj±cy linie:  #
# koñcówka(rev);prawdopodobieñstwo;opis              #
# gdzie:                                             #
# - koñcówka(rev) jest koñcówk± wyrazu zapisan±      #
#   w odwrotnej kolejno¶ci, dla ka¿dego wyrazu       #
#   w s³owniku wypisujemy koñcówki o d³ugo¶ciach     #
#   od 1 do d³ugo¶ci wyrazu,                         #
# - prawdopodobieñstwo jest prawdopodobieñstwem      #
#   wyst±pienia danego opisu dla danej koñcówki      #
#   (obliczonym na podstwie statystycznej analizy    #
#   s³ownika), np: 250 oznacza, ze opis popjawia sie #
#   1 raz na 4 wyst±pienia koñcówki.                 #
#   Zapisana zostaje odwrotno¶æ prawdopodobieñstwa   #
#   aby scie¿ka najbardziej prawdopodobna mia³a      #
#   najmniejszy koszt.                               #
######################################################

######
#STALE
#
# Jak bardzo prawdopodobna musi byæ dana ¶cie¿ka, aby
# braæ j± pod uwagê? (w promilach)
$MIN_PROB = 0;
#
# Maksymalna ilo¶æ powtórzeñ danej koñcówki (brane od
# najbardziej prawdopodbnej w dó³
$MAX_PATH = 10;
#
######

@input = <>;

#$max = 0;

#for $m (@input) {
#    $m =~ /(\w+);.*$/;
#    if (length($1) > $max) {
#       $max = length($1);
#    }
#}

$n = 1; #$max; 

$go = 1;

while ($n<7) {

    my %prefiksy;
    my $sumy;
 
    $go = 0;
    for $m (@input) {
        if ($m =~ /^(\w{$n})\w*;(.*)$/) {
            $go = 1;
            $prefiksy{$1.";".$2}++;
            $sumy{$1}++;
        }
    }

    print "\n";
 
    for $prefiks (keys %prefiksy) {
        $prefiks =~ /^(.*);(.*)$/;
        $p = $prefiksy{$prefiks} / $sumy{$1};
        $p *= 1000;                     #wartosc w promilach

        if ($p <= $MIN_PROB) {
            next;
        }

        #if ($p == 1000) {
        #    $p--;
        #}

        $p = 1000 - $p;                 #odwrotnosc
#       $rev = reverse($1);
        # opakowujemy znak '-' znakami [] ;)
        $opis = $2;
        $opis =~ s/-/\[-\]/;

        printf "%s~%.0f;%s\n", $1, $p, $opis;
    }

  $n++;

}