source: nawszelkiwypadek/tools/gue_dic/stat.pl @ 6b3be72

help
Last change on this file since 6b3be72 was f1563c0, checked in by obrebski <obrebski@…>, 17 years ago

git-svn-id: svn://atos.wmid.amu.edu.pl/utt@3 e293616e-ec6a-49c2-aa92-f4a8b91c5d16

  • Property mode set to 100755
File size: 3.7 KB
Line 
1#! /usr/bin/perl
2
3use locale;
4
5######################################################
6# na wej¶ciu znajduje siê plik zawieraj±cy linie     #
7# postaci:                                           #
8# slowo;opis                                         #
9#                                                    #
10# na wyj¶ciu ma siê znaleŒæ plik zawieraj±cy linie:  #
11# koñcówka(rev);prawdopodobieñstwo;opis              #
12# gdzie:                                             #
13# - koñcówka(rev) jest koñcówk± wyrazu zapisan±      #
14#   w odwrotnej kolejno¶ci, dla ka¿dego wyrazu       #
15#   w s³owniku wypisujemy koñcówki o d³ugo¶ciach     #
16#   od 1 do d³ugo¶ci wyrazu,                         #
17# - prawdopodobieñstwo jest prawdopodobieñstwem      #
18#   wyst±pienia danego opisu dla danej koñcówki      #
19#   (obliczonym na podstwie statystycznej analizy    #
20#   s³ownika), np: 250 oznacza, ze opis popjawia sie #
21#   1 raz na 4 wyst±pienia koñcówki.                 #
22#   Zapisana zostaje odwrotno¶æ prawdopodobieñstwa   #
23#   aby scie¿ka najbardziej prawdopodobna mia³a      #
24#   najmniejszy koszt.                               #
25######################################################
26
27######
28#STALE
29#
30# Jak bardzo prawdopodobna musi byæ dana ¶cie¿ka, aby
31# braæ j± pod uwagê? (w promilach)
32$MIN_PROB = 0;
33#
34# Maksymalna ilo¶æ powtórzeñ danej koñcówki (brane od
35# najbardziej prawdopodbnej w dó³
36$MAX_PATH = 10;
37#
38# Znak odzielajacy koncowke od prefiksu
39$PREF_SIGN = '_';
40######
41# Zmienne globalne
42#
43# Tablica okreslajaca, ktore prefiksy nalezy uwzlednic
44# w wyjsciowym pliku.
45# Klucz - ciag znakow prefiks$PREF_SIGNopis.
46#  Wartosc: 1 - jezeli nalezy uwzglednic, 0 w przeciwnym przypadku
47my %prefs;
48#
49# maksymalna dlugosc analizowanego prefiksu
50my $MAX_PREF = 0;
51######
52
53###########################################################
54# FUNKCJE
55
56# wczytuje prefiksy do tablicy hashowej
57# parametry:
58# - nazwa pliku, z ktorego nalezy pobrac prefiksy
59#   Plik w formacie:
60#   prefiks\topis...\n
61sub load_prefs {
62
63    my $file = shift;
64    open(IN, $file);
65
66    while (<IN>) {
67        $_ =~ /^(\w+)\t([^\t]+)\t/;
68        my $key = "$1$PREF_SIGN$2";
69        my $len = length($1);
70        if ($len > $MAX_PREF) {
71            $MAX_PREF = $len;
72        }
73        $prefs{$key} = 1;
74    }
75}
76
77###########################################################
78
79# Jezeli podano parametr to jest to nazwa pliku z prefiksami
80
81if (@ARGV > 0) {
82#    print "Laduje prefiksy ($ARGV[0])\n";
83    load_prefs(shift);
84#     print "Zaladowane:\n";
85#     for $key (keys(%prefs)) {
86#       print "$key\t$prefs{$key}\n";
87#     }
88#     print "++++++++++++++++++++++++++++++++++++++++++++++++++\n";
89}
90
91@input = <>;
92
93#$max = 0;
94
95#for $m (@input) {
96#    $m =~ /(\w+);.*$/;
97#    if (length($1) > $max) {
98#       $max = length($1);
99#    }
100#}
101
102$n = 2; #$max;
103
104$go = 1;
105
106while ($go) {
107
108    my %koncowki;
109    my $sumy;
110 
111    $go = 0;
112    for $m (@input) {
113        if ($m =~ /(\w{$n});(.*)$/) {
114            $go = 1;
115            my $ending = $1;
116            my $desc = $2;
117            for (my $i=$MAX_PREF; $i>0; $i--) {
118                $m =~ /^(\w{$i}).*/;
119                my $key = "$1$PREF_SIGN$desc";
120                if ($prefs{$key} == 1) {
121                    $ending .= "$PREF_SIGN$1";
122                    last;
123                }
124            }
125            $koncowki{$ending.";".$desc}++;
126            $sumy{$ending}++;
127        }
128    }
129
130    print "\n";
131 
132    for $koncowka (keys %koncowki) {
133        $koncowka =~ /^(.*);(.*)$/;
134        my $ending = $1;
135        my $opis = $2;
136        $p = $koncowki{$koncowka} / $sumy{$ending};
137        $p *= 1000;                     #wartosc w promilach
138
139        if ($p <= $MIN_PROB) {
140            next;
141        }
142
143        #if ($p == 1000) {
144        #    $p--;
145        #}
146
147        #$p = 1000 - $p;                 #odwrotnosc
148        my $old = $2;
149        $ending =~ /^(\w+)$PREF_SIGN(\w+)/;
150
151        my $rev = reverse($1);
152
153        if ($2 !~ /^$old$/) {
154            $rev .= "$PREF_SIGN$2";
155        }
156
157        # opakowujemy znak '-' znakami [] ;) dla lextools
158        $opis =~ s/-/\[-\]/;
159
160        printf "%s~%.0f;%s\n", $rev, $p, $opis;
161    }
162
163  $n++;
164
165}
Note: See TracBrowser for help on using the repository browser.