Optimalno iskalno drevo/Implementacija(Mathematica)

Iz MaFiRaWiki

Naloga

"Napiši program, ki prebere besedilo iz datoteke in sestavi optimalno iskalno drevo za k besed z najvišjo frekvenco ponavljanja v besedilu."

Ideja

Program bo iz datoteke prebral besedilo, sestavil seznam vseh besed, ki se pojavijo v besedilu in jih uredil padajoče po frekvencah ponavljanja v besedilu. Nato bomo izbrali prvih k besed in sproti sestavljali optimalno iskalno drevo. Naš cilj je sestaviti tako urejeno dvojiško drevo (pravzaprav slovar), da bo iskanje določene besede čim cenejše. To pomeni, da bodo besede, ki jih bo uporabnik slovarja pogosteje iskal, pri vrhu. Osnovna razlaga postopka za izračun stroškov iskalnega drevesa, ki jih skušamo minimizirati, je tule. Mi bomo namesto izračuna cen po podobnem postopku sestavljali sama drevesa. (Seveda pa bomo lahko na vsakem koraku izračunali tudi njihovo ceno.)

Algoritem

(*Program prebere besedilo iz datoteke*)

BesedeFajla[s_String] := StringCases[Import[s], RegularExpression["\\w+"]];
besedilo = BesedeFajla["C:\\...POT DO DATOTEKE...\\*.txt"];
f[s_] := {First[s], Length[s]};
Frekvence[s_] := Map[f, Split[Sort[s]]];
UrediPoFrekvencah[l_] := Sort[l, #1[[2]] > #2[[2]] &];
kIzbranih[besedilo_, k_] := Sort[Take[UrediPoFrekvencah[Frekvence[besedilo]], k]];

(*To bo naš k:*)
steviloBesed = 50;


(*Besede, ki bodo v slovarju in verjetnost, da jih bomo iskali.*)

besede = Join[kIzbranih[besedilo, steviloBesed][[All, 1]], {{}}];
p := {p1, ...VERJETNOST DA BOMO ISKALI i-TO BESEDO ..., 0}

V primeru na koncu je verjetnost, da bomo iskali i-to besedo, kar sorazmerna njeni frekvenci v besedilu:

p=Join[kIzbranih[besedilo, steviloBesed][[All, -1]], {0}];

Najpomembnejši del je izračun posamezne cene drevesa. Ideja je ista kakor tukaj.

(*izračun cene drevesa*)

pos[a_] := Flatten [Position[besede, a]][[1]];
probab[q_] /; (Depth[q] =!= 1) := Sum[p[[pos[q[[i]]]]], {i, Length[q]}];
probab[a_] /; (Depth[a] == 1) := p[[pos[a]]];
prob[T_] := probab[Flatten[T]];
cena[{}] := 0;
cena[{a_, {}, {}}] := probab[{a}];
cena[T_] /; (Depth[T] =!= 1 && Length[T] =!= 1) := prob[T] +
     cena[T[[2]]] + cena[T[[3]]];
cena[a_] /; (Depth[a] == 1) := probab[a];
cena[{a_}] /; (Depth[a] == 1 && Length[{a}] == 1) := probab[a];


(*Algoritem za sestavljanje optimalnih dreves*)

T[{i_, j_}] := T[i, j];
T[i_, i_] /; (i =!= 0) := {besede[[i]], {}, {}};
T[i_, 0] := {};
T[i_, j_] /; (j < i) := {};
T[i_, j_] /; (j == i + 1) := If[p[[i]] ≤ p[[
          j]], {besede[[j]], besede[[
            i]], {}}, {besede[[i]], {}, besede[[j]]}];
T[i_, j_] /; (i =!= j && i + 1 =!= j) := Module[{},
      For[r = i + 1; naj := {besede[[i]], T[i, i - 1], T[i + 1, j]},
        r < j + 1,
        r++,
        najdrevo[r_] := {besede[[r]], T[i, r - 1], T[r + 1, j]};
        If[cena[naj] ≥ cena[najdrevo[r]], naj = najdrevo[r]]
        ];
      T[i, j] = naj
      ];

Zato, da dobimo res optimalna drevesa, moramo sproti sestaviti vsa druga optimalna poddrevesa, ki jih rabimo v rekurziji:

dim = steviloBesed;
diag[r_] := Table[{i, i + r}, {i, 1, dim - r}];
skup[x_, k_] := Join[x, diag[k]];
urejeno[dim_] := Fold[skup, diag[0], Range[dim - 1]];
ur = urejeno[dim];
i = 1;
While[i < Length[ur] + 1, T[ur[[i]]]; ++i];

(Preden zaženemo slovar moramo pognati While.) Končno optimalno iskalno drevo za k besed:

slovar = T[1, steviloBesed]

Za besedilo iz tega članka in za 50 najpogostejših besed iz njega dobimo sledeč slovar:

{of, {do, {and, {
    a, {}, {}}, {can, {be, {are, {}, {}}, {
      but, {}, {}}}, {computing, {computer, change, {}}, {
          day, {}, {}}}}}, {is, {I, {for, {
        every, {}, {}}, {have, {}, how}}, {in, {}, {}}}, {my, {m, {it, {}, \
{}}, {more, {}, {}}}, {no, {needs, {}, {}}, {not, {}, {}}}}}}, {the, {
          s, {or, {on, {}, one}, {power, {people, {our, {}, {}}, {
            personal, {}, {}}}, {powerful, {}, {}}}}, {
      that, {t, {
        some, {}, {}}, {technology, {}, {}}}, {}}}, {to, {time, {
            The, {}, this}, {times, {}, {}}}, {will, {we, way, {}}, {
          with, {}, years}}}}}

Kot pomoč pri predstavitvi rezultata lahko uporabimo funkcijo za izris drevesa.(Rahlo moramo le spremeniti naš dobljeni rezultat - vstaviti ničle na prva mesta (pod)dreves, ker smo funkcijo za izris drevesa vzeli iz te naloge.)

plotTree[{0, "of", {0, "do", {0, "and
    ", {0, "a", {}, {}}, {0, "can", {0, "be", {
        0, "are", {}, {}}, {0, "but", {}, {}}}, {0, "computing", {
          0, "computer", {0, "
            change", {}, {}}, {}}, {0, "day", {}, {}}}}}, {0, "is", {0, "I
              ", {0, "for", {0, "
          every", {}, {}}, {0, "have", {}, {
            0, "how", {}, {}}}}, {0, "in", {}, {}}}, {0, "my", {0, "m", {
                0, "it", {}, {}}, {0, "more
            ", {}, {}}}, {0, "no", {0, "needs", {}, {}}, {
      0, "not", {}, {}}}}}}, {0, "the", {0, "
          s", {0, "or", {0, "on", {}, {0, "one", {}, {}}}, {0, "power", {0, 
            "people", {0, "our", {}, {}}, {
              0, "personal", {}, {}}}, {0, "powerful", {}, {}}}}, {
            0, "that", {0, "t", {0, "some
        ", {}, {}}, {0, "technology", {}, {}}}, {}}}, {0, "to", {0, "time", {
              0, "The", {}, {0, "this", {}, {}}}, {0, "times", {}, {}}}, {0,
             "will", {0, "we", {0, "way", {}, {}}, {}}, {0, "with
            ", {}, {0, "years", {}, {}}}}}}}]

Image:Slovar1.jpg

Osebna orodja