#! /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 () { $_ =~ /^(\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++; }