utt/_old/nawszelkiwypadek/tools/gue_dic/stat_pre.pl

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

}