% Antti Karttusen vastaus kieliteknologian Prolog-harjoitustyöhön. % Saatu valmiiksi torstaina maaliskuun 23. 2000. % Aloitettu pari päivää sitten. % Idea lyhykäisesti: % % Luen ensin kaikki sanat read_word_count_assoc rutiinilla % Words assosiaatiopuuhun, niin että avaimina on sanat itse % ja arvoina kuinka monta kertaa ko. sana on jo esiintynyt korpuksessa. % Sitten tuotan toisen assosiaatiopuun Words2 swap_keys_and_values % rutiinilla, joka construct_new_key_and_value:ta käyttäen % muodostaa uuden assosiaatiopuun avaimet siten että ne koostuvat % kunkin sanan lopullisesta lukumäärästä korpuksessa (vähennettynä % jostakin tarpeeksi suuresta luvusta, jotta saadaan isot lukumäärät % sorttauksessa alkuun), plus alkuperäisestä sanasta ä<->å konversion % jälkeen, sekä edellämainitusta pieniksi kirjaimiksi konvertoinnin jälkeen. % % Kun avaimet on näin muodostettu, niin sorttaus menee % lukumäärän mukaan laskevasti, sen jälkeen samanlukumääräisten % kohdalla aakkosjärjestyksessä nousevasti, niin että % kapitalisoidut sanat tulevat juuri ennen vastaavia % kapitalisoimattomia sanoja. % % Mainittu ä<->å konversiojippo takaa sen, että ohjelma sorttaa % pelkästään virallista suomalaista 29 kirjaimen aakkostoa (A-Z + ÅÄÖ) % käyttävät aineistot koulussa opitussa järjestyksessä, esimerkiksi: % "Ångström" ennen "Ängström":iä, joka taas tulee ennen "Öljyvuoto":a. % Muita diakriittisia ISO-8859/1 (Latin-1) kirjaimia sisältävät % sanat voivat silti sorttautua toisin kuin odottaisi. % % Uudeksi arvoksi tuohon Words2 assosiaatiopuuhun taas laitetaan % vanha arvo (siis sanojen esiintymislukumäärä) konkatenoituna % vanhalla avaimella (siis itse sanalla), joka lopuksi voidaan % printata ulos sellaisenaan map_assoc meta-predikaatin jokaiselle % Words2-puun arvolle avaimien mukaisessa järjestyksessä kutsumallaan % write_with_ln rutiinilla. % Täten minun ei tarvitse implementoida itse sort-rutiinia, % jollaisia olisikin löytynyt liian helposti samaisesta % Sterlingin ja Shapiron kirjasta kuin sanojenlukurutiinitkin. % Huom: Ohjelma käyttää Scistuksen assoc ja charsio kirjastoja. % Nämä on dokumentoi URLissa: % http://www.sics.se/sicstus/docs/latest/html/sicstus.html % Ohjelma olettaa että korpus käyttää ISO-8859/1 (latin 1) % merkistöä, mutta toimisi luultavasti Unicode-merkistölläkin % koodatun suomalaisen tekstin kanssa, mikäli Sicstuksen % get_code (tai jokin muu) input-rutiini saadaan joidenkin % optioiden asetusten jälkeen palauttamaan luetut Unicode-codepointit % sellaisinaan, eli ainakin alimmat 256 arvoa, jotka on yhtenevät % ISO-8859/1:n kanssa. % Päärutiini. Kutsutaan esimerkiksi count_file('./countsort.pl','/dev/tty'). count_file(SrcFilename,DstFilename) :- use_module(library(assoc)), use_module(library(charsio)), open(SrcFilename,read,Instream), read_word_count_assoc(Instream, Words), swap_keys_and_values(Words,Words2), open(DstFilename,write,Outstream), set_output(Outstream), map_assoc(write_with_ln,Words2), close(Instream), close(Outstream). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Assosiaatiopuiden käsittely %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % incr_assoc: Jos OldAssoc:issa on jo ennestään Key, % niin instantioi NewAssoc jossa sen arvoa on % lisätty yhdellä, muuten instantioi NewAssoc johon % on lisätty ko. Key arvolla 1. incr_assoc(Key,OldAssoc,NewAssoc) :- get_assoc(Key,OldAssoc,OldValue), !, NewValue is OldValue + 1, get_assoc(Key,OldAssoc,OldValue,NewAssoc,NewValue). incr_assoc(Key,OldAssoc,NewAssoc) :- put_assoc(Key,OldAssoc,1,NewAssoc). swap_keys_and_values(OldAssoc,NewAssoc) :- empty_assoc(EmptyAssoc), min_assoc(OldAssoc,FirstKey,FirstVal), construct_new_key_and_value(FirstKey,FirstVal,NewKey,NewValue), put_assoc(NewKey,EmptyAssoc,NewValue,NewAssoc1), swap_keys_and_values(OldAssoc,FirstKey,NewAssoc1,NewAssoc). swap_keys_and_values(OldAssoc,OldKey,NewAssoc1,NewAssoc_z) :- get_next_assoc(OldKey,OldAssoc,Knext,Vnext), !, construct_new_key_and_value(Knext,Vnext,NewKey,NewValue), put_assoc(NewKey,NewAssoc1,NewValue,NewAssoc2), swap_keys_and_values(OldAssoc,Knext,NewAssoc2,NewAssoc_z). % Lopetusehto, jos edellinen ei enää mätsää koska % get_next_assoc kävi jo kaikki OldAssoc:in keyt läpi, % joten instantioi NewAssoc2:een rakennettu uusi % Assoc-struktuuri myös lopulliseen tulokseen (neljäs argumentti). swap_keys_and_values(OldAssoc,OldKey,NewAssoc_z,NewAssoc_z) :- !. % Ko. luku on 999.9999... triljoonaa. Sorttaus toimii oikein % niin kauan kun N1 on pienempi kuin 90 triljoonaa. % sub_from_huge(N1,N2) :- N2 is 999999999999999999999 - N1. % Okei, suuruudenhulluus on suuruudenhulluutta, vähennetään % 12 magnitudia: % Ko. luku on 999.9999... miljoonaa. Sorttaus toimii oikein % niin kauan kun N1 on pienempi kuin 90 miljoonaa. sub_from_huge(N1,N2) :- N2 is 999999999 - N1. % Esimerkiksi: construct_new_key_and_value('Ääliö',5,NewKey,NewVal). % NewKey = '999999994.ååliö.Ååliö', % NewVal = '5 Ääliö' construct_new_key_and_value(OldKey,OldValue,NewKey,NewValue) :- sub_from_huge(OldValue,N), number_codes(N,NCodes), atom_codes(OldKey,Codes), sorting_conversions(Codes,Codes2), upper2lower_codelist(Codes2,Codes3), format_to_chars('~s.~s.~s', [NCodes,Codes3,Codes2], Res4), atom_codes(NewKey,Res4), number_codes(OldValue,Codes4), format_to_chars('~10s ~s', [Codes4,Codes],Res5), atom_codes(NewValue,Res5). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Merkistösääntöjä ja konversiorutiineita. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% iseof(Code) :- Code == -1. isupper(Code) :- Code > 64, Code < 91. islower(Code) :- Code > 96, Code < 123. % ISO-8859/1 ja Unicodessa koodit 215 ja 247 (kerto- ja jakomerkit) % ovat poikkeuksia seuraavalla alueella, mutta unohdan niiden olemassaolon nyt: isdiacritic(Code) :- Code > 191, Code < 256. isletter(Code) :- isupper(Code). isletter(Code) :- islower(Code). isletter(Code) :- isdiacritic(Code). isother(Code) :- \+(isletter(Code)). % Seuraava toimii vain jos lähdemerkki C1 on oikea kirjain, % joko US-Ascii alueella [65. - 90.], [97. - 122.] % tai joku ISO-8859/1:n diakriittisista kirjaimista % alueella [192. - 255.] Mutta näinhän nyt tässä tapauksessa % on, koska kaikki muut merkit skipataan. % Jos C1 on iso kirjain, tee siitä pieni: upper2lower(C1,C2) :- E is C1 mod 64, E < 32, !, C2 is C1 + 32. % Jos C1 on jo valmiiksi pieni kirjain, pidä se sellaisena: upper2lower(C1,C1) :- E is C1 mod 64, E > 31. % Muuta koko merkkijono pieniksi kirjaimiksi: upper2lower_codelist([],[]). upper2lower_codelist([C1|Srclist],[C2|Dstlist]) :- upper2lower(C1,C2), upper2lower_codelist(Srclist,Dstlist). % Koska Å:lla on suurempi ISO-8859/1 Ascii arvo kuin Ä:llä % mutta suomalaisessa aakkostuksessa se kuitenkin tulee % sitä ennen, niin tehdään seuraava jippo: % Uuden assosiaatiopuun avaimia muodostattessa nämä kaksi kirjainta % vaihdetaan päittäin oikean sorttauksen saavuttamiseksi, % mutta arvo-osassa ne jätetään ennalleen. % Käytä cuttia, ettei 196,197,228,229 mätsäisi vielä viimeiseenkiin clauseen. sorting_conv(196,197) :- !. % Ä -> Å sorting_conv(197,196) :- !. % Å -> Ä sorting_conv(228,229) :- !. % ä -> å sorting_conv(229,228) :- !. % å -> ä sorting_conv(C,C). % Loput pysyvät niin kuin ovatkin. sorting_conversions([],[]). sorting_conversions([C1|Srclist],[C2|Dstlist]) :- sorting_conv(C1,C2), sorting_conversions(Srclist,Dstlist). %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Pari kirjoitusrutiinia. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Debuggausta varten... print_words([]) :- nl. print_words([Word|Rest]) :- write(Word), write(' '), print_words(Rest). write_with_ln(X) :- write(X), nl. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% % Sanojen lukurutiinit %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% read_word_count_assoc(Instream,ResultAssoc) :- empty_assoc(EmptyAssoc), get_code(Instream,FirstCode), read_and_count_words(Instream,FirstCode,EmptyAssoc,ResultAssoc). % Tämä on lopetusehto koko read_words luupille. % Eli lopetetaan kun tulee EOF. % Cut ehdon jälkeen, muuten mätsäisi myös isother(Code):een. % (Kauniimmin olisi jos isother ei mätsäisi eoffiin eli -1:seen.) read_and_count_words(Instream,Code,Store,Store) :- iseof(Code), !. % Jos Code on kirjain, lukee seuraavan sanan read_word:illa, % ja jatkaa sitten antaen read_word:in % instantioiman NextCode:n (ensimmäinen ei-kirjain) % Code-argumenttina edelleen toisille read_words clauseille % (jolloin jompikumpi kahdesta jälkimmäisestä read_and_count_words % clausesta mätsää.) read_and_count_words(Instream,Code,OldStore,NewStore) :- isletter(Code), read_word(Instream,Code,Word,NextCode), incr_assoc(Word,OldStore,MidStore), read_and_count_words(Instream,NextCode,MidStore,NewStore). % Tämä clause vain skippaa kaikki ei-kirjaimet Instream:istä: read_and_count_words(Instream,Code,OldStore,NewStore) :- isother(Code), get_code(Instream,NextCode), read_and_count_words(Instream,NextCode,OldStore,NewStore). % Seuraavat rutiinit on napattu melko suoraan kirjasta % "The Art of Prolog" by Leon Sterling and Ehud Shapiro. % The MIT Press, ISBN 0-262-19338-8, sivulta 217. % Lisäsin kommentoinnin. Huomaa, että luen sanat nyt % assosiaatiopuuhun read_and_count_words rutiinilla, % en listaan allaolevalla read_word_list rutiinilla. read_word_list(Instream,Words) :- get_code(Instream,FirstCode), read_words(Instream,FirstCode,Words). % Tämä on lopetusehto koko read_words luupille. % Eli lopetetaan kun tulee EOF. read_words(Instream,Code,[]) :- iseof(Code), !. % Jos C on kirjain, lukee seuraavan sanan read_word:illa, % (joka tulee kolmanneksi argumentiksi instantioituvan % listan alkuun), ja jatkaa sitten antaen read_word:in % instantioiman NextCode:n (ensimmäinen ei-kirjain) % Code-argumenttina edelleen toisille read_words clauseille % (jolloin jompikumpi kahdesta jälkimmäisestä read_words % clausesta mätsää.) read_words(Instream,Code,[Word|Words]) :- isletter(Code), read_word(Instream,Code,Word,NextCode), read_words(Instream,NextCode,Words). % Tämä clause vain skippaa kaikki ei-kirjaimet Instream:istä, % eikä muuta Words-listaa laisinkaan. read_words(Instream,Code,Words) :- isother(Code), get_code(Instream,NextCode), read_words(Instream,NextCode,Words). % Lukee word_letters:illä listan ascii-koodeja jotka % muodostavat seuraavan sanan, konvertoi sen atomiksi, % ja NextCode:ksi instantioituu ensimmäinen sanan jälkeinen % merkki (joka siis on aina ei-kirjain). read_word(Instream,Code,Word,NextCode) :- word_letters(Instream,Code,Codes,NextCode), atom_codes(Word,Codes). % Skannaa Instream:ista kaikki kirjaimet listaksi % ascii-koodeja (instantioituu kolmanneksi argumentiksi) % ja neljänneksi FinalCode argumentiksi instantioituu % ensimmäinen ei-kirjain joka siis päättää sanan. word_letters(Instream,Code,[Code|Codes],FinalCode) :- isletter(Code), !, get_code(Instream,NextCode), word_letters(Instream,NextCode,Codes,FinalCode). % Lopetusehto sananluvulle: kun tulee ensimmäinen % ei-kirjain, niin ylläkutsutussa clausessa FinalCode:n % arvoksi instantioituu ko. sanan päättävä ei-kirjain, % ja Codes-listan arvoksi instantioituu tyhjä lista. word_letters(Instream,Code,[],Code) :- isother(Code). % Eipä muuta, loppu.