utt/_old/nawszelkiwypadek/tools/gue_dic/stat.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;
#
# Znak odzielajacy koncowke od prefiksu
$PREF_SIGN = '_';
######
# Zmienne globalne
# 
# Tablica okreslajaca, ktore prefiksy nalezy uwzlednic
# w wyjsciowym pliku.
# Klucz - ciag znakow prefiks$PREF_SIGNopis.
#  Wartosc: 1 - jezeli nalezy uwzglednic, 0 w przeciwnym przypadku
my %prefs;
#
# maksymalna dlugosc analizowanego prefiksu
my $MAX_PREF = 0;
######

###########################################################
# FUNKCJE

# wczytuje prefiksy do tablicy hashowej
# parametry:
# - nazwa pliku, z ktorego nalezy pobrac prefiksy
#   Plik w formacie:
#   prefiks\topis...\n
sub load_prefs {

    my $file = shift;
    open(IN, $file);

    while (<IN>) {
	$_ =~ /^(\w+)\t([^\t]+)\t/;
	my $key = "$1$PREF_SIGN$2";
	my $len = length($1);
	if ($len > $MAX_PREF) {
	    $MAX_PREF = $len;
	}
	$prefs{$key} = 1;
    }
}

###########################################################

# Jezeli podano parametr to jest to nazwa pliku z prefiksami

if (@ARGV > 0) {
#    print "Laduje prefiksy ($ARGV[0])\n";
    load_prefs(shift);
#     print "Zaladowane:\n";
#     for $key (keys(%prefs)) {
# 	print "$key\t$prefs{$key}\n";
#     }
#     print "++++++++++++++++++++++++++++++++++++++++++++++++++\n";
}

@input = <>;

#$max = 0;

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

$n = 2; #$max; 

$go = 1;

while ($go) {

    my %koncowki;
    my $sumy;
 
    $go = 0;
    for $m (@input) {
	if ($m =~ /(\w{$n});(.*)$/) {
	    $go = 1;
	    my $ending = $1;
	    my $desc = $2;
	    for (my $i=$MAX_PREF; $i>0; $i--) {
		$m =~ /^(\w{$i}).*/;
		my $key = "$1$PREF_SIGN$desc";
		if ($prefs{$key} == 1) {
		    $ending .= "$PREF_SIGN$1";
		    last;
		}
	    }
	    $koncowki{$ending.";".$desc}++;
	    $sumy{$ending}++;
	}
    }

    print "\n";
 
    for $koncowka (keys %koncowki) {
	$koncowka =~ /^(.*);(.*)$/;
	my $ending = $1;
	my $opis = $2;
	$p = $koncowki{$koncowka} / $sumy{$ending};
        $p *= 1000;                     #wartosc w promilach

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

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

        #$p = 1000 - $p;                 #odwrotnosc
	my $old = $2;
	$ending =~ /^(\w+)$PREF_SIGN(\w+)/;

	my $rev = reverse($1);

	if ($2 !~ /^$old$/) {
	    $rev .= "$PREF_SIGN$2";
	}

	# opakowujemy znak '-' znakami [] ;) dla lextools
	$opis =~ s/-/\[-\]/;

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

  $n++;

}