Staonův svět - Grep

Update – tak se mi nevynhula chyba. Opravil jsem rovnou dvě.

Tak po osmi letech na mě zase padl Pascal. Bože, jak já tenhle jazyk nesnáším :) Abych si ho trochu oživil, pustil jsem se do jedné úlohy, kterou dělala jiná paralelka jako úkol na cvičeních. Pokud sem zajde nějaký matfyzák, který si neví rady, může se inspirovat. Netvrdím ovšem, že by to byl naprosto čistý ukázkový program. Jen jsem snažil si oživit Pascal a nijak jsem se s programem nepáral :)

Oprava

V programu byly dvě chyby: jedna v generování přechodové funkce, druhá chyba byla způsobena zrychleným vyhodnocováním boolských výrazů ve funkci zpracujPracovni. Program na této stránce už je opravený a je ke stažení opravený zdroják.

Zadání

Zadání sem nebudu opisovat, najdete ho na stránkách cvičícího pana Hrušky. Pokud by sem někdo zavítal v době, kdy už tahle stránka nebude platná, uložil jsem HTML zadání i do taru, který naleznete na spodku stránky.

Řešení

V programu jsem implementoval algoritmus, tak jak je popsaný v zadání. Jen ne úplně přímočaře. Udržuji si pouze pole příznaků použití pozice (tzn. křížky popsané v algoritmu), zatímco tečky si udržuji ve dvou samostatných zásobnících: jeden zásobník je pro tečky, které jsou před znaky – konečný – a druhý pro tečky, které jsou před řídícími znaky regulárního výrazu – pracovní. Jeden krok hlavního algoritmu vypadá pak následovně:

  1. Vynuluj pole příznaků použití (křížky).
  2. Překopíruj tečky z konečného zásobníku do pracovního zásobníku.
  3. Dokud není pracovní zásobník prázdný opakuj kroky 4 až 9.
  4. Vyber tečkupracovního zásobníku. Zjisti všechny pozice, kam se tečka může posunout.
  5. Pokud se tečka přesouvá do pozice na konci výrazu, nikam ji neukládej a ohlaš dosažení konce.
  6. Pokud se tečka přesouvá do pozice, která ma nastavený příznak použití, nic nikam neukládej.
  7. Pokud se tečka přesouvá do pozice před znakem, ulož ji do konečného zásobníku.
  8. Pokud se tečka přesouvá do pozice před řídícím znakem výrazu, ulož ji do pracovního zásobníku.
  9. V obou případech do pole příznaků použití (křížky) nastav příznak.

Musím smutně konstatovat, že nejsem tak dobrý, jako pan Hruška. Oproti jeho dvěma hodinám mi to trvalo napsat čtyři hodiny a má to o zhruba 200 řádek navíc :))

Zdrojový kód

Program jsem psal ve Free Pascalu na Linuxu. Výsledný Pascalský zdroják pak vypadá následovně.

  1. const
  2.   MAX_EXPR = 50;
  3.   EXPR_FILE = 'vyraz.txt';
  4.   INPUT_FILE = 'vstup.txt';
  5.   OUTPUT_FILE = 'my_vystup.txt';
  6.  
  7. type
  8.   { prechodova funkce tecek (prvni hodnota v radce je pocet polozek
  9.     v dane radce) }
  10.   ODelta = array [1..MAX_EXPR + 1, 0..MAX_EXPR + 1] of integer;
  11.   { iterator pro pruchod seznamem prechodu }
  12.   OIterator = record
  13.     radka: integer;
  14.     sloupec: integer;
  15.   end;
  16.   { priznaky pouzitych mist }
  17.   OKrizky = array [1..MAX_EXPR + 1] of boolean;
  18.   { zasobnik }
  19.   OStack = record
  20.     zasobnik: array [1..MAX_EXPR + 1] of integer;
  21.     vrchol: integer{ prvni volna pozice }
  22.   end;
  23.  
  24.   { status reseni ulohy }
  25.   OStatus = record
  26.     vyraz: string;    { regularni vyraz }
  27.     delka: integer;   { delka regularniho vyrazu }
  28.     delta: ODelta;    { prechodova funkce tecek }
  29.     krizky: OKrizky;  { priznaky pouziti pozice }
  30.     konecne: OStack;  { pozice tecek, ktere jsou pred znakem nebo otaznikem,
  31.                         tzn. konecne do dalsiho kroku retezce }
  32.     pracovni: OStack; { pozice tecek, ktere se posouvaji jeste pred dalsim
  33.                         nactenim znaku }
  34.     { zpracovavany retezec }
  35.     retezec: string;
  36.     strlen: integer;
  37.   end;
  38.  
  39. {==================================================
  40.         OPERACE SE ZASOBNIKEM
  41. ==================================================}
  42. procedure stackInit(var stack: OStack);
  43. begin
  44.   stack.vrchol := 1;
  45. end;
  46.  
  47. function stackIsEmpty(var stack: OStack): boolean;
  48. begin
  49.   stackIsEmpty := stack.vrchol = 1;
  50. end;
  51.  
  52. procedure stackPush(var stack: OStack; value: integer);
  53. begin
  54.   stack.zasobnik[stack.vrchol] := value;
  55.   inc(stack.vrchol);
  56. end;
  57.  
  58. function stackPop(var stack: OStack): integer;
  59. var
  60.   val: integer;
  61. begin
  62.   val := stack.zasobnik[stack.vrchol - 1];
  63.   dec(stack.vrchol);
  64.   stackPop := val;
  65. end;
  66.  
  67. {==================================================
  68.         OPERACE S KRIZKY
  69. ==================================================}
  70. procedure krizkyNull(var krizky: OKrizky; delka: integer);
  71. var
  72.   i: integer;
  73. begin
  74.   for i := 1 to delka do
  75.     krizky[i] := FALSE;
  76. end;
  77.  
  78. function krizkyIsSet(var krizky: OKrizky; index: integer): boolean;
  79. begin
  80.   krizkyIsSet := krizky[index];
  81. end;
  82.  
  83. procedure krizkySet(var krizky: OKrizky; index: integer);
  84. begin
  85.   krizky[index] := TRUE;
  86. end;
  87.  
  88. {==================================================
  89.         OPERACE S DELTOU
  90. ==================================================}
  91. procedure deltaInit(var delta: ODelta; delka: integer);
  92. var
  93.   i: integer;
  94. begin
  95.   { vynuluji seznamy prechodu - tzn. kazdemu seznamu nastavim
  96.     nulovou delku }
  97.   for i := 1 to delka do
  98.     delta[i, 0] := 0;
  99. end;
  100.  
  101. procedure deltaFirst(var delta: ODelta; radka: integer; var iterator: OIterator);
  102. begin
  103.   iterator.radka := radka;
  104.   if delta[radka, 0] > 0 then
  105.     iterator.sloupec := 1
  106.   else
  107.     iterator.sloupec := -1
  108. end;
  109.  
  110. function iteratorIsValid(iterator: OIterator): boolean;
  111. begin
  112.   iteratorIsValid := iterator.sloupec > 0;
  113. end;
  114.  
  115. procedure deltaNext(var delta: ODelta; var iterator: OIterator);
  116. begin
  117.   if iterator.sloupec < delta[iterator.radka, 0] then
  118.     iterator.sloupec := iterator.sloupec + 1
  119.   else
  120.     iterator.sloupec := -1
  121. end;
  122.  
  123. function deltaGet(var delta: ODelta; var iterator: OIterator): integer;
  124. begin
  125.   deltaGet := delta[iterator.radka, iterator.sloupec];
  126. end;
  127.  
  128. procedure deltaSet(var delta: ODelta; radka: integer; prechod: integer);
  129. begin
  130.   delta[radka, 0] := delta[radka, 0] + 1;
  131.   delta[radka, delta[radka, 0]] := prechod;
  132. end;
  133.  
  134. {==================================================
  135.         VYPOCET PRECHODOVE FUNKCE
  136. ==================================================}
  137. { -- leva normalni zavorka }
  138. procedure computePointLB(i: integer; var status: OStatus);
  139. var
  140.   j: integer;
  141.   vyvazeni: integer;
  142.  
  143. begin
  144.   {posun za zavorku}
  145.   deltaSet(status.delta, i, i + 1);
  146.   {posun na konec zavorky}
  147.   vyvazeni := 1; j := i + 1;
  148.   while vyvazeni > 0 do
  149.   begin
  150.     if status.vyraz[j] = '(' then inc(vyvazeni)
  151.     else
  152.       if status.vyraz[j] = ')' then dec(vyvazeni);
  153.     j := j + 1;
  154.   end;
  155.   j := j + 1; {preskocim hvezdicku}
  156.   deltaSet(status.delta, i, j);
  157. end;
  158.  
  159. { -- leva slozena zavorka }
  160. procedure computePointLCB(i: integer; var status: OStatus);
  161. var
  162.   j, vyvazeni: integer;
  163. begin
  164.   deltaSet(status.delta, i, i + 1);   {posun za zavorku}
  165.  
  166.   vyvazeni := 1; j := i + 1;
  167.   while(vyvazeni > 0) do
  168.   begin
  169.     case status.vyraz[j] of
  170.       '{': inc(vyvazeni);
  171.       '}': dec(vyvazeni);
  172.       '|': if vyvazeni = 1 then deltaSet(status.delta, i, j + 1);
  173.     end;
  174.     j := j + 1;
  175.   end;
  176. end;
  177.  
  178. { -- prava normalni zavorka }
  179. procedure computePointRB(i: integer; var status: OStatus);
  180. var
  181.   j, vyvazeni: integer;
  182. begin
  183.   { posun za zavorku a hvezdicku }
  184.   deltaSet(status.delta, i, i + 2);
  185.  
  186.   {posun na zacatek zavorky }
  187.   vyvazeni := 1; j := i - 1;
  188.   while(vyvazeni > 0) do
  189.   begin
  190.     case status.vyraz[j] of
  191.       ')': inc(vyvazeni);
  192.       '(': dec(vyvazeni);
  193.     end;
  194.     j := j - 1;
  195.   end;
  196.   deltaSet(status.delta, i, j + 2);
  197. end;
  198.  
  199. { -- prava slozena zavorka a tecka pred svislitkem }
  200. procedure computePointRCB(i: integer; var status: OStatus);
  201. var
  202.   j, vyvazeni: integer;
  203. begin
  204.   {najdu koncovou zavorku}
  205.   vyvazeni := 1; j := i;
  206.   while(vyvazeni > 0) do
  207.   begin
  208.     case status.vyraz[j] of
  209.       '{': inc(vyvazeni);
  210.       '}': dec(vyvazeni);
  211.     end;
  212.     j := j + 1;
  213.  
  214.   end;
  215.   deltaSet(status.delta, i, j);
  216. end;
  217.  
  218. { -- normalni znak, nebo otaznik }
  219. procedure computePointChar(i: integer; var status: OStatus);
  220. begin
  221.   deltaSet(status.delta, i, i + 1);
  222. end;
  223.  
  224. procedure computeTransition(index: integer; var status: OStatus);
  225. begin
  226.   { ten zku*veny Pascal nema default vetev caseu, takze
  227.     musim vnorovat ify }
  228.   if status.vyraz[index] = '(' then
  229.     computePointLB(index, status)
  230.   else
  231.   begin
  232.     if status.vyraz[index] = '{' then
  233.       computePointLCB(index, status)
  234.     else
  235.     begin
  236.       if status.vyraz[index] = ')' then
  237.         computePointRB(index, status)
  238.       else
  239.       begin
  240.         if (status.vyraz[index] = '}') or (status.vyraz[index] = '|') then
  241.           computePointRCB(index, status)
  242.         else
  243.         begin
  244.           { hvezdicku ignoruji, tu uz preskakuji pri vytvareni delty }
  245.           if status.vyraz[index] <> '*' then
  246.             computePointChar(index, status)
  247.         end
  248.       end
  249.     end
  250.   end
  251. end;
  252.  
  253. procedure computeDelta(var status: OStatus);
  254. var
  255.   i: integer;
  256. begin
  257.   { zinicializuji deltu }
  258.   deltaInit(status.delta, status.delka);
  259.   {pro kazdou moznou pozici tecky si spocitam prechodovou funkci
  260.    - vynechavam koncovou tecku, protoze ta znamena konec a dal se
  261.    z ni neskace. }
  262.   for i := 1 to status.delka do
  263.     computeTransition(i, status);
  264. end;
  265.  
  266. {==================================================
  267.         VLASTNI ZPRACOVANI RETEZCE
  268. ==================================================}
  269. { test, zda jsem pred nejakym ridicim znakem }
  270. function jePracovni(var status: OStatus; tecka: integer): boolean;
  271. begin
  272.   if (status.vyraz[tecka] = '(') or (status.vyraz[tecka] = '{')
  273.        or (status.vyraz[tecka] = ')') or (status.vyraz[tecka] = '}')
  274.        or (status.vyraz[tecka] = '*') or (status.vyraz[tecka] = '|') then
  275.     jePracovni := TRUE
  276.   else
  277.     jePracovni := FALSE
  278. end;
  279.  
  280. { vraci TRUE pokud je tecka pred znakem, ktery odpovida zadanemu }
  281. function srovnani(var status: OStatus; tecka: integer; znak: char): boolean;
  282. begin
  283.   srovnani := (status.vyraz[tecka] = '?') or (status.vyraz[tecka] = znak);
  284. end;
  285.  
  286. { Vlozi tecku do prislusneho zasobniku. Vraci TRUE, pokud tecka dosla
  287.   na konec reg. vyrazu. }
  288. function nastavTecku(var status: OStatus; tecka: integer): boolean;
  289. begin
  290.   if tecka > status.delka then
  291.     nastavTecku := TRUE     { -- konec vyrazu }
  292.   else
  293.   begin
  294.     { -- pokud uz je krizek nastaveny, tecku zahodim }
  295.     if not krizkyIsSet(status.krizky, tecka) then
  296.     begin
  297.       { -- nastavim krizek, abych si sem nestrkal dalsi tecku }
  298.       krizkySet(status.krizky, tecka);
  299.       if jePracovni(status, tecka) then
  300.         { -- tecka je pred nejakym ridicim znakem, vlozim ji do pracovniho
  301.              zasobniku }
  302.         stackPush(status.pracovni, tecka)
  303.       else
  304.         { -- tecka je pred znakem ci otaznikem, vlozim do konecneho zasobniku }
  305.         stackPush(status.konecne, tecka);
  306.     end;
  307.     nastavTecku := FALSE;
  308.   end;
  309. end;
  310.  
  311. { Prekopiruje vsechny tecky pred znaky do pracovniho zasobniku, aby
  312.   se zpracovaly. }
  313. procedure kopirujTecky(var status: OStatus);
  314. begin
  315.   while not stackIsEmpty(status.konecne) do
  316.     stackPush(status.pracovni, stackPop(status.konecne))
  317. end;
  318.  
  319. { vypocet vsech pracovnich tecek. Vraci TRUE, pokud dosla tecka na konec
  320.   regularniho vyrazu. }
  321. function zpracujPracovni(var status: OStatus; i: integer): boolean;
  322. var
  323.   tecka: integer;
  324.   end_flag: boolean;
  325.   iterator: OIterator;
  326. begin
  327.   end_flag := FALSE;
  328.  
  329.   while not stackIsEmpty(status.pracovni) do
  330.   begin
  331.     tecka := stackPop(status.pracovni);
  332.     if jePracovni(status, tecka) then
  333.     begin
  334.       { -- tecka je pred pracovnim znakem, projdu vsechno z delty a vlozim
  335.            do zasobniku }
  336.       deltaFirst(status.delta, tecka, iterator);
  337.       while iteratorIsValid(iterator) do
  338.       begin
  339.         end_flag := nastavTecku(status, deltaGet(status.delta, iterator)) or end_flag;
  340.         deltaNext(status.delta, iterator);
  341.       end;
  342.     end
  343.     else
  344.     begin
  345.       { -- tecka je pred znakem, srovnam }
  346.       if srovnani(status, tecka, status.retezec[i]) then
  347.         end_flag := nastavTecku(status, tecka + 1) or end_flag;
  348.     end;
  349.   end;
  350.   zpracujPracovni := end_flag;
  351. end;
  352.  
  353. { Hlavni telo algoritmu. Vraci TRUE, pokud byl retezec prijat, jinak FALSE }
  354. function hlavni_telo(var status: OStatus): boolean;
  355. var
  356.   i: integer;
  357.   end_flag: boolean;
  358. begin
  359.   for i := 1 to status.strlen do
  360.   begin
  361.     { -- prenesu tecky do pracovniho zasobniku }
  362.     kopirujTecky(status);
  363.     { -- smazu krizky }
  364.     krizkyNull(status.krizky, status.delka);
  365.     { -- dokud mam tecky na pracovnim zasobniku, tak pracuji }
  366.     end_flag := zpracujPracovni(status, i);
  367.     { -- dosli jsme na konec. To me ale zajima jen na konci retezce }
  368.     if i < status.strlen then end_flag := FALSE;
  369.   end;
  370.  
  371.   hlavni_telo := end_flag;
  372. end;
  373.  
  374. function start(var status: OStatus): boolean;
  375. begin
  376.   { -- inicializace zasobniku }
  377.   stackInit(status.pracovni);
  378.   stackInit(status.konecne);
  379.   { -- vlozim pocatecni tecku }
  380.   krizkyNull(status.krizky, status.delka);
  381.   if nastavTecku(status, 1) then
  382.     start := TRUE
  383.   else
  384.   begin
  385.     { -- zpracuji vsechny tecky pred zavorkami jeste pred tim, nez zacnu cist
  386.          prvni znak. }
  387.     if zpracujPracovni(status, 1) and (status.strlen = 0) then
  388.       start := TRUE
  389.     else
  390.       { -- vyvolam hlavni telo algoritmu, tzn. zacnu cist znak po znaku
  391.            vstupniho retezce a srovnavam s regularnim vyrazem. }
  392.       start := hlavni_telo(status);
  393.   end;
  394. end;

Zbytek programu už není nijak zajímavý, je to jen vstup ze souborů a výstup do souborů.

Soubory ke stažení

Kompletní zdroják ke stažení včetně HTML se zadáním je zde. Pokud se najde pár dalších magorů jako já, kteří píší Pascal v geditu, překládají v řádce a ladí v gdb nebo v DDD, možná se jim bude hodit definiční soubor pro zvýrazňování syntaxe pro GtkSourceview.

Staon | 23.11.2005 St 20:54 | <<< trvalý odkaz >>> | tisk | 6 komentářů

Komentáře k textu

Rss komentářů tohoto textu

[1] reaguj
ZuSka 17.11.2005 Čt 13:38

uzasne :D

[2] reaguj
Jimi mejl web 17.11.2005 Čt 13:38

Pascal zboznujeeem :-))) Ale ty programujes tak.. tak.. tak programatorsky :D velke/male pismena v premennych, kopec funkcii, potom sa v tom clovek ako ja nevyzna :D Ale inak rozhodne gratulujem… ak je k comu :D

[3] reaguj
Staon mejl web 17.11.2005 Čt 14:21

[1] ZuSka : jj, já jsem si myslel, že ty to oceníš ;))

[2] Jimi : Oh, děkuji. Nějak programátorsky bych programovat chtěl :)) Gratulovat asi není příliš k čemu. Právě jsem zvládl úlohu pro prváky, což by asi pro inženýra výpočetní techniky neměl být problém… :-D

[4] reaguj
miira web 17.11.2005 Čt 19:06

Pascal vypadá děsně nebezpečně :] Ale ono pro takovýho lamera jako já vypadá děsně nebezpečně všechno :D

[5] reaguj
dawon web 24.11.2005 Čt 08:54

to je nádhera :)

[6] reaguj
Staon mejl web 26.11.2005 So 01:32

[5] dawon : viď. Že mám ten zdrojákhezky vybarvený? ;))

Přidej komentář!

  Gravatar povolen.

Příspěvěk je formátován Texy! syntaxí. Není povoleno HTML, odkazy se převádějí automaticky.
Autor stránek Staonův svět se jmenuje?
Odpověd: Cornelius Latipus Staon

Autor vzhledu: Staon. Stránky jsou postaveny na redakčním systému RS2 (verze RC2).