96 lines
2.2 KiB
Raku
Executable File
96 lines
2.2 KiB
Raku
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;
|
|
#
|
|
######
|
|
|
|
@input = <>;
|
|
|
|
#$max = 0;
|
|
|
|
#for $m (@input) {
|
|
# $m =~ /(\w+);.*$/;
|
|
# if (length($1) > $max) {
|
|
# $max = length($1);
|
|
# }
|
|
#}
|
|
|
|
$n = 1; #$max;
|
|
|
|
$go = 1;
|
|
|
|
while ($n<7) {
|
|
|
|
my %prefiksy;
|
|
my $sumy;
|
|
|
|
$go = 0;
|
|
for $m (@input) {
|
|
if ($m =~ /^(\w{$n})\w*;(.*)$/) {
|
|
$go = 1;
|
|
$prefiksy{$1.";".$2}++;
|
|
$sumy{$1}++;
|
|
}
|
|
}
|
|
|
|
print "\n";
|
|
|
|
for $prefiks (keys %prefiksy) {
|
|
$prefiks =~ /^(.*);(.*)$/;
|
|
$p = $prefiksy{$prefiks} / $sumy{$1};
|
|
$p *= 1000; #wartosc w promilach
|
|
|
|
if ($p <= $MIN_PROB) {
|
|
next;
|
|
}
|
|
|
|
#if ($p == 1000) {
|
|
# $p--;
|
|
#}
|
|
|
|
$p = 1000 - $p; #odwrotnosc
|
|
# $rev = reverse($1);
|
|
# opakowujemy znak '-' znakami [] ;)
|
|
$opis = $2;
|
|
$opis =~ s/-/\[-\]/;
|
|
|
|
printf "%s~%.0f;%s\n", $1, $p, $opis;
|
|
}
|
|
|
|
$n++;
|
|
|
|
}
|