utt/nawszelkiwypadek/tools/gue_dic/stat.pl

#! /usr/bin/perl

use locale;

######################################################
# na wej<65>ciu znajduje si<73> plik zawieraj<61>cy linie     #
# postaci:                                           #
# slowo;opis                                         #
#                                                    #
# na wyj<79>ciu ma si<73> znale<6C><65> plik zawieraj<61>cy linie:  #
# ko<6B>c<EFBFBD>wka(rev);prawdopodobie<69>stwo;opis              #
# gdzie:                                             #
# - ko<6B>c<EFBFBD>wka(rev) jest ko<6B>c<EFBFBD>wk<77> wyrazu zapisan<61>      #
#   w odwrotnej kolejno<6E>ci, dla ka<6B>dego wyrazu       #
#   w s<>owniku wypisujemy ko<6B>c<EFBFBD>wki o d<>ugo<67>ciach     #
#   od 1 do d<>ugo<67>ci wyrazu,                         #
# - prawdopodobie<69>stwo jest prawdopodobie<69>stwem      #
#   wyst<73>pienia danego opisu dla danej ko<6B>c<EFBFBD>wki      #
#   (obliczonym na podstwie statystycznej analizy    #
#   s<>ownika), np: 250 oznacza, ze opis popjawia sie #
#   1 raz na 4 wyst<73>pienia ko<6B>c<EFBFBD>wki.                 #
#   Zapisana zostaje odwrotno<6E><6F> prawdopodobie<69>stwa   #
#   aby scie<69>ka najbardziej prawdopodobna mia<69>a      #
#   najmniejszy koszt.                               #
######################################################

######
#STALE
#
# Jak bardzo prawdopodobna musi by<62> dana <20>cie<69>ka, aby
# bra<72> j<> pod uwag<61>? (w promilach)
$MIN_PROB = 0;
#
# Maksymalna ilo<6C><6F> powt<77>rze<7A> danej ko<6B>c<EFBFBD>wki (brane od
# najbardziej prawdopodbnej w d<><64>
$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++;

}