166 lines
3.7 KiB
Perl
Executable File
166 lines
3.7 KiB
Perl
Executable File
#! /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++;
|
|
|
|
}
|