/********************************** START APLIKACE **********************************/ /* ######################################################### ######################################################### ### ### ### ### ### --------------------------- ### ### lzw-compressor-cz.pl v1.0 ### ### ... vytvoril JK ... ### ### --------------------------- ### ### ### ### ### ### POPIS: ### ### ### ### Jednoducha aplikace pro kompresi ASCII textu ### ### ze vstupu nebo textoveho souboru do LZW kodu. ### ### ### ### ### ######################################################### ######################################################### */ /************************ Start programu ... ************************/ % start - vstupni bod programu start:- nl, nl, write('----------------------------------------'), nl, write('Vitejte v aplikaci lzw-compressor-cz.pl!'), nl, write('----------------------------------------'), nl, nl, write('Chcete jako vstup zvolit soubor? (ano/ne) '), read(Odpoved), coTed(Odpoved), % vola coTed/1 s odpovedi na otazku vyse nl. % pomoc - odkaze na pomoc na internetovych strankach pomoc:- nl, nl, write('Pro start aplikace napiste prikaz: start.'), nl, nl, write('Pro vice informaci prosim navstivte URL adresu:'), nl, write('----------------------------------------------'), nl, write('http://home.pf.jcu.cz/'), write(~), write('krhanj00/lgp/app'), nl, write('----------------------------------------------'), nl, nl. /*********************************** Vstupni data od uzivatele ... ***********************************/ % coTed(Odpoved) - rozhodne, jestli uzivatel zadal ano ci ne. Odpoved je odpoved od uzivatele, jestli chce kodovat text v souboru nebo jenom vstupni text. coTed(Odpoved):- Odpoved = 'ano', !, nl, write('Zadejte jmeno souboru (relativni cesta uvnitr jednoduchych uvozovek zakoncena teckou - napriklad: ''text.txt''.) '), nl, read(JmenoSouboru), nl, see(JmenoSouboru), read(Text), seen, write('Vstupni text ze souboru: '), nl, nahratSoubor(JmenoSouboru), % vola nahratSoubor/1 kde JmenoSouboru je jmeno souboru pro kodovani nl, zacniKompresi(Text). % vola zacniKompresi/1 kde Text bude kompresovan do LZW kodu coTed(Odpoved):- nl, write('Zadejte text pro kompresi (text musi byt uvnitr jednoduchych uvozovek a zakoncen teckou - napriklad: ''ahoj ahoj''.) '), nl, read(Text), nl, zacniKompresi(Text). % vola makeCompression/1 kde Text bude kompresovan do LZW kodu /****************************** Cteni dat ze souboru ... ******************************/ % nahratSoubor(JmenoSouboru) - cte znaky ze souboru, kde JmenoSouboru je jmeno souboru nahratSoubor(JmenoSouboru):- see(JmenoSouboru), % zmeni vstupni zarizeni z klavesnice na soubor repeat, % smycka repeat cte vsechny znaky ze souboru dokud neni konec souboru get0(ASCIIZnak), % get0/1 - ziska znak z proudu, ale pouze ASCII kod pro znak not pomocnyVypis(ASCIIZnak), % pomocnyVypis/1 - vypise obsah souboru na obrazovku ASCIIZnak = (-1), % pokud je konec souboru, ukoncime smycku repeat !, % riznem repeat seen. % navratime vstupni zarizeni % pomocnyVypis(ASCIIZnak) - tiskne znaky na obrazovku a ASCIIZnak je znak co bude tisten pomocnyVypis(ASCIIZnak):- char(ASCIIZnak), % jestlize je ASCIIZnak opravdu znak z ASCII tabulky znaku !, % pak name(Znak,[ASCIIZnak]), % name/2 - prevedeme ASCIIZnak na klasicky Znak write(Znak). % a vypiseme Znak na obrazovku /************************ Motor komprese ... ************************/ % zacniKompresi(Text) - Text je vstupni text pro kompresi. Konvertuje text na ASCII znaky, vytvori slovnik a spusti motor komprese. Jestlize je to neuspesne, znici slovnik a vycisti tak pamet. zacniKompresi(Text):- textNaASCIIZnaky(Text,Znaky), % textNaASCIIZnaky/2 - konvertuje text na seznam znaku vytvorSlovnik, % vytvorSlovnik - vytvori slovnik - viz nize nl, write('LZW kod pro vstupni text: '), nl, motor(Znaky,128), % motor/2 - spusti motor komprese. 128 je cislo, od ktereho se zacinaji pocitat nove polozky slovniku. !. % pouze zeleny rez zacniKompresi(Text):- retractall(nahrad(_,_)). % retractall/1 - vymaze vsechny polozky ze slovniku - vycisti se tak i pamet % motor(Znaky,I) - REKURZE - hlavni cast teto aplikace. Znaky je seznam znaku, ktery konvertujeme do LZW kodu. I je promena pro inkrementaci klice pro hodnotu. Datovy typ je integer. motor([],I):-!. % zastaveni rekurze motor(Znaky,I):- findall(Cislo,podseznam(Znaky,Cislo),Seznam), % findall/3 - najde vsechny podseznamy/2 a jejich Cisla ulozi do Seznamu maximum(Kod,Seznam), % maximum/2 - z tohoto Seznamu najdeme nejvyssi kod write(Kod), % vytiskneme kod na obrazovku write('-'), nahrad(Kod,Hodnota), % nahrad/2 - zjisti Hodnotu naseho Kodu spojeni(Hodnota,NoveZnaky,Znaky), % spojeni/3 - odstrani Hodnotu (seznam znaku) ze Znaku (cely seznam znaku) pridejKodHodnotu(Hodnota,Znaky,Vysledek), % pridejKodHodnotu/3 - pripoji novy znak k nasi Hodnote assertz(nahrad(I,Vysledek)), % assertz/1 - nova Hodnota dostane novy kod a nova Hodnota je pridana na konec programu I1 is I + 1, % inkrementace I o jednicku motor(NoveZnaky,I1). % opet volame motor/2, ale nyni s novymi znaky - NoveZnaky, a novym I -> REKURZE /*************************** Utility pro motor ... ***************************/ % textNaASCIIZnaky(Text,Znaky) - konvertuje text na znaky, kde Text je vstup a Znaky vystup textNaASCIIZnaky(Text,Znaky):- atom_chars(Text,ASCIIZnaky), % konvertuje text na ASCII hodnoty znaku aSCIIZnakyNaZnaky(ASCIIZnaky,Znaky). % konvertuje seznam ASCII hodnot znaku na klasicke Znaky % aSCIIZnakyNaZnaky(Vstup,Vystup) - REKURZE - konvertuje ASCII hodnoty znaku na klasicke znaky aSCIIZnakyNaZnaky([],[]):-!. % zastaveni rekurze aSCIIZnakyNaZnaky([H|T],[H1|T1]):- atom_chars(H1,[H]), % konvertuje prvni polozku seznamu na znak aSCIIZnakyNaZnaky(T,T1). % opet volame aSCIIZnakyNaZnaky/2 -> REKURZE % pridejKodHodnotu(Hodnota,Znaky,Vysledek) - vytvori hodnotu pro novou polozku slovniku, kde Hodnota je posledni hodnota, Znaky je cely text a Vysledek je nova polozka. pridejKodHodnotu(Hodnota,Znaky,Vysledek):- spojeni(Hodnota,[Hlava|TeloZanku],Znaky), % rozdeli Znaky podle Hodnoty a zjisti prvni znak Hodnotou seznamu pridejNaKonec(Hlava,Hodnota,Vysledek). % pridejNaKonec/3 - "prvni znak" vlozime na konec Hodnoty seznamu a ziskame novou polozku slovniku (Vysledek). /**************************** Utility pro seznam ... ****************************/ % pridejNaKonec(Polozka,ZdrojovySeznam,VyslednySeznam) - REKURZE - prida Polozku na konec ZdrojovehoSeznamu a sestavy VyslednySeznam. pridejNaKonec(X,[],[X]). % zastaveni rekurze pridejNaKonec(X,[H|T],[H|T1]):- pridejNaKonec(X,T,T1). % opet volame pridejNaKonec/3 -> REKURZE % spojeni(PrvniCastCelehoSeznamu,DruhaCastCelehoSeznamu,CelySeznam) - REKURZE - rozdeli cely seznam na prvni a druhou cast spojeni([],L,L). % zastaveni rekurze spojeni([X|L1],L2,[X|L3]):- spojeni(L1,L2,L3). % opet volame spojeni/3 -> REKURZE % maximum(NejvyssiPolozkaVSeznamu,Seznam) - zjisti nevyssi polozku ze Seznamu pomoci bubbleSortu - viz nize maximum(X,L):- bubbleSort(L,[X|_]). % bubbleSort(Seznam,SerazenySeznam) - REKURZE - seradi seznam (od nejvyssi po nejnizsi) bubbleSort(L,SortedL) :- append(L0,[X,Y|T],L), % append/3 - rozdeli nebo spoji seznam Y > X, % a jestlize Y > X !, % riznem -> IF - THEN append(L0,[Y,X|T],L1), % append/3 - rozdeli nebo spoji seznam bubbleSort(L1,SortedL). % opet volame bubbleSort/2 -> REKURZE bubbleSort(SortedL,SortedL). % zastaveni rekurze - jestlize je seznam jiz serazeny seznam % podseznam(Znaky,Kod) - zjisti, jestli zacatek seznamu Znaku odpovida polozce ve slovniku podseznam([V|_],C):- nahrad(C,[V]). podseznam([V,W|_],C):- nahrad(C,[V,W]). podseznam([V,W,X|_],C):- nahrad(C,[V,W,X]). podseznam([V,W,X,Y|_],C):- nahrad(C,[V,W,X,Y]). podseznam([V,W,X,Y,Z|_],C):- nahrad(C,[V,W,X,Y,Z]). podseznam([V,W,X,Y,Z,A|_],C):- nahrad(C,[V,W,X,Y,Z,A]). podseznam([V,W,X,Y,Z,A,B|_],C):- nahrad(C,[V,W,X,Y,Z,A,B]). /***************** Slovnik ... *****************/ % vytvorSlovnik - pomoci assertz/1 vytvori nove polozky slovniku vytvorSlovnik:- % NEKTERE ZNAKY NEPOUZIJEME /* assertz(nahrad(0,[''])), assertz(nahrad(1,['?'])), assertz(nahrad(2,['?'])), assertz(nahrad(3,['?'])), assertz(nahrad(4,['?'])), assertz(nahrad(5,['?'])), assertz(nahrad(6,['?'])), assertz(nahrad(7,['?'])), assertz(nahrad(8,['?'])), assertz(nahrad(9,['?'])), assertz(nahrad(10,['?'])), assertz(nahrad(11,['?'])), assertz(nahrad(12,['?'])), assertz(nahrad(13,['?'])), assertz(nahrad(14,['?'])), assertz(nahrad(15,['¤'])), assertz(nahrad(16,['?'])), assertz(nahrad(17,['?'])), assertz(nahrad(18,['?'])), assertz(nahrad(19,['?'])), assertz(nahrad(20,['¶'])), assertz(nahrad(21,['§'])), assertz(nahrad(22,['?'])), assertz(nahrad(23,['?'])), assertz(nahrad(24,['?'])), assertz(nahrad(25,['?'])), assertz(nahrad(26,['?'])), assertz(nahrad(27,['?'])), assertz(nahrad(28,['?'])), assertz(nahrad(29,['?'])), assertz(nahrad(30,['?'])), assertz(nahrad(31,['?'])), */ assertz(nahrad(32,[' '])), assertz(nahrad(33,['!'])), assertz(nahrad(34,['"'])), assertz(nahrad(35,['#'])), assertz(nahrad(36,['$'])), assertz(nahrad(37,['%'])), assertz(nahrad(38,['&'])), assertz(nahrad(39,[''''])), assertz(nahrad(40,['('])), assertz(nahrad(41,[')'])), assertz(nahrad(42,['*'])), assertz(nahrad(43,['+'])), assertz(nahrad(44,[','])), assertz(nahrad(45,['-'])), assertz(nahrad(46,['.'])), assertz(nahrad(47,['/'])), assertz(nahrad(48,['0'])), assertz(nahrad(49,['1'])), assertz(nahrad(50,['2'])), assertz(nahrad(51,['3'])), assertz(nahrad(52,['4'])), assertz(nahrad(53,['5'])), assertz(nahrad(54,['6'])), assertz(nahrad(55,['7'])), assertz(nahrad(56,['8'])), assertz(nahrad(57,['9'])), assertz(nahrad(58,[':'])), assertz(nahrad(59,[';'])), assertz(nahrad(60,['<'])), assertz(nahrad(61,['='])), assertz(nahrad(62,['>'])), assertz(nahrad(63,['?'])), assertz(nahrad(64,['@'])), assertz(nahrad(65,['A'])), assertz(nahrad(66,['B'])), assertz(nahrad(67,['C'])), assertz(nahrad(68,['D'])), assertz(nahrad(69,['E'])), assertz(nahrad(70,['F'])), assertz(nahrad(71,['G'])), assertz(nahrad(72,['H'])), assertz(nahrad(73,['I'])), assertz(nahrad(74,['J'])), assertz(nahrad(75,['K'])), assertz(nahrad(76,['L'])), assertz(nahrad(77,['M'])), assertz(nahrad(78,['N'])), assertz(nahrad(79,['O'])), assertz(nahrad(80,['P'])), assertz(nahrad(81,['Q'])), assertz(nahrad(82,['R'])), assertz(nahrad(83,['S'])), assertz(nahrad(84,['T'])), assertz(nahrad(85,['U'])), assertz(nahrad(86,['V'])), assertz(nahrad(87,['W'])), assertz(nahrad(88,['X'])), assertz(nahrad(89,['Y'])), assertz(nahrad(90,['Z'])), assertz(nahrad(91,['['])), assertz(nahrad(92,['\'])), assertz(nahrad(93,[']'])), assertz(nahrad(94,['^'])), assertz(nahrad(95,['_'])), assertz(nahrad(96,['`'])), assertz(nahrad(97,['a'])), assertz(nahrad(98,['b'])), assertz(nahrad(99,['c'])), assertz(nahrad(100,['d'])), assertz(nahrad(101,['e'])), assertz(nahrad(102,['f'])), assertz(nahrad(103,['g'])), assertz(nahrad(104,['h'])), assertz(nahrad(105,['i'])), assertz(nahrad(106,['j'])), assertz(nahrad(107,['k'])), assertz(nahrad(108,['l'])), assertz(nahrad(109,['m'])), assertz(nahrad(110,['n'])), assertz(nahrad(111,['o'])), assertz(nahrad(112,['p'])), assertz(nahrad(113,['q'])), assertz(nahrad(114,['r'])), assertz(nahrad(115,['s'])), assertz(nahrad(116,['t'])), assertz(nahrad(117,['u'])), assertz(nahrad(118,['v'])), assertz(nahrad(119,['w'])), assertz(nahrad(120,['x'])), assertz(nahrad(121,['y'])), assertz(nahrad(122,['z'])), assertz(nahrad(123,['{'])), assertz(nahrad(124,['|'])), assertz(nahrad(125,['}'])), assertz(nahrad(126,[~])), assertz(nahrad(127,['¦'])). /*********************************** KONEC APLIKACE ***********************************/