Laboratorium 11: Praca nad zadaniem zaliczeniowym 3. Gramatyki, drzewa

{**
 * Program symulujacy wyprowadzenie slowa za pomoca gramatyki bezkontekstowej.
 *
 * Obsluguje gramatyki w postaci normalnej Chomsky'ego, czyli takie, ktorych
 * produkcje maja po prawej stronie albo dwa symbole pomocnicze albo jeden
 * koncowy. Za symbole pomocnicze uznaje wielkie litery a za koncowe male
 * litery.
 *
 * Program wczytuje z wejscia ciag wierszy z produkcjami gramatyki, zakonczony
 * wierszem pustym. Miedzy lewa a prawa strona oczekuje znakow '->'.
 * Przyjmuje, ze aksjomatem jest symbol po lewej stronie pierwszej produkcji.
 * Po wczytaniu gramatyki, symuluje wyprowadzenie slowa, dajac uzytkownikowi
 * mozliwosc wyboru produkcji dla pierwszego od lewej symbolu pomocniczego.
 * Produkcje wskazywane sa przez wpisanie prawej strony.
 *
 * Poprawnosc danych jest sprawdzana. W przypadku wykrycia bledu, na wyjscie
 * diagnostyczne wypisywany jest komunikat a wiersz danych pobierany jest
 * ponownie.
 *
 * autor: Artur Zaroda <zaroda@mimuw.edu.pl>
 * wersja: 2.0
 * data: 12 listopada 2014
 *}
program wyprowadzenie;
 
const
    {* Maksymalna dlugosc wyprowadzanego slowa *}
    MAX_ROZMIAR = 1000;
 
type
    {* Symbole pomocnicze *}
    Pomocniczy = 'A' .. 'Z';
 
    {* Symbole koncowe *}
    Koncowy = 'a' .. 'z';
 
    {**
     * Reprezentacja gramatyki.
     *
     * "aksjomat" to symbol poczatkowy
     *
     * "naPomocnicze" jest reprezentacja produkcji z symbolami pomocniczymi po
     * prawej stronie. "naPomocnicze[A, B, C]" to prawda, gdy istnieje
     * produkcja A->BC
     *
     * "naKoncowy" jest reprezentacja produkcji z symbolem koncowym.
     * "naKoncowy[A, x]" to prawda, gdy istnieje produkcja A->x
     *}
    Gramatyka = record
        aksjomat : Pomocniczy;
        naPomocnicze : array [Pomocniczy, Pomocniczy, Pomocniczy] of Boolean;
        naKoncowy : array [Pomocniczy, Koncowy] of Boolean
    end;
 
    {**
     * Reprezentacja wyprowadzanego slowa, zlozonego z symboli pomocniczych
     * i koncowych.
     *
     * "ileKoncowych" do liczba symboli koncowych
     *
     * "ilePomocniczych" to liczba symboli pomocniczych
     *
     * "symbole" to tablica, w ktorej pierwszych "ileKoncowych" pozycji
     * zajmuja symbole koncowe a ostatnich "ilePomocniczych" symbole
     * pomocnicze
     *}
    Slowo = record
        ileKoncowych, ilePomocniczych : Integer;
        symbole : array [1 .. MAX_ROZMIAR] of Char
    end;
 
{* Sprawdza, czy znak "c" reprezentuje symbol pomocniczy *}
function jestPomocniczym(c : Char) : Boolean;
begin
    jestPomocniczym := (low(Pomocniczy) <= c) and (c <= high(Pomocniczy))
end;
 
{* Sprawdza, czy znak "c" reprezentuje symbol koncowy *}
function jestKoncowym(c : Char) : Boolean;
begin
    jestKoncowym := (low(Koncowy) <= c) and (c <= high(Koncowy))
end;
 
{* Wypisuje na wyjscie diagnostyczne komunikat "k" o bledzie w danych "s" *}
procedure wypiszKomunikat(const k, s : String);
begin
    writeln(stderr, k, ': ''', s, '''')
end;
 
{**
 * Wczytuje z wejscia gramatyke i zapisuje na "g".
 *
 * W przypadku wykrycia bledu, prosi uzytkownika o ponowne wpisanie produkcji.
 *}
procedure wczytajGramatyke(var g : Gramatyka);
var p, q, r : Pomocniczy;
    k : Koncowy;
    s : String;
    pierwsza, ok : Boolean;
begin
    with g do begin
        { czyscimy tablice produkcji }
        for p := low(Pomocniczy) to high(Pomocniczy) do begin
            for q := low(Pomocniczy) to high(Pomocniczy) do
                for r := low(Pomocniczy) to high(Pomocniczy) do
                    naPomocnicze[p, q, r] := false;
            for k := low(Koncowy) to high(Koncowy) do
                naKoncowy[p, k] := false
        end;
        readln(s);
        pierwsza := true;
        while (length(s) <> 0) or pierwsza do begin
            { nie pozwalamy na opuszczenie petli, jesli nie bylo zadnej
              produkcji, bo nie wiedzielibysmy, co jest aksjomatem }
            ok := false;
            if length(s) = 0 then
                wypiszKomunikat('Oczekiwany niepusty wiersz, a nie', s)
            else if (length(s) <> 4) and (length(s) <> 5) then
                wypiszKomunikat('Nieprawidlowa dlugosc produkcji', s)
            else if not jestPomocniczym(s[1]) then
                wypiszKomunikat('Bledny symbol po lewej stronie produkcji', s)
            else if (s[2] <> '-') or (s[3] <> '>') then
                wypiszKomunikat('Brak strzalki w produkcji', s)
            else if length(s) = 4 then
                if not jestKoncowym(s[4]) then
                    wypiszKomunikat('Oczekiwany symbol koncowy w produkcji', s)
                else
                    ok := true
            else if not jestPomocniczym(s[4]) or not jestPomocniczym(s[5]) then
                wypiszKomunikat('Oczekiwane symbole pomocnicze w produkcji', s)
            else
                ok := true;
            if ok then begin
                if pierwsza then begin
                    aksjomat := s[1]; { ten symbol uznajemy za poczatkowy }
                    pierwsza := false
                end;
                if length(s) = 4 then
                    naKoncowy[s[1], s[4]] := true
                else begin
                    assert(length(s) = 5);
                    naPomocnicze[s[1], s[4], s[5]] := true
                end
            end;
            readln(s)
        end
    end
end;
 
{* Do slowa "s" dopisuje symbol koncowy "k" *}
procedure dodajKoncowy(var s : Slowo; k : Koncowy);
begin
    with s do begin
        assert(ilePomocniczych + ileKoncowych <= MAX_ROZMIAR);
        inc(ileKoncowych);
        symbole[ileKoncowych] := k
    end
end;
 
{* Ze slowa "s" usuwa pierwszy symbol pomocniczy i zapisuje na "p" *}
procedure usunPomocniczy(var s : Slowo; var p : Pomocniczy);
begin
    with s do begin
        assert(ilePomocniczych > 0);
        dec(ilePomocniczych);
        p := symbole[high(symbole) - ilePomocniczych]
    end
end;
 
{* Do slowa "s" dopisuje symbol "p" jako pierwszy z pomocniczych *}
procedure dodajPomocniczy(var s : Slowo; p : Pomocniczy);
begin
    with s do begin
        assert(ilePomocniczych + ileKoncowych <= MAX_ROZMIAR);
        symbole[high(symbole) - ilePomocniczych] := p; { pomocnicze na koncu }
        inc(ilePomocniczych)
    end
end;
 
{* Wypisuje produkcje dla symbolu "a" w gramatyce "g" *}
procedure wypiszOpcje(a : Pomocniczy; const g : Gramatyka);
var p, q : Pomocniczy;
    k : Koncowy;
    pierwszyRaz : Boolean;
begin
    with g do begin
        write('(', a, '->');
        pierwszyRaz := true; { jeszcze nie bylo zadnej produkcji }
        for p := low(Pomocniczy) to high(Pomocniczy) do
            for q := low(Pomocniczy) to high(Pomocniczy) do
                if naPomocnicze[a, p, q] then begin
                    if pierwszyRaz then
                        pierwszyRaz := false
                    else
                        write('|');
                    write(p, q)
                end;
        for k := low(Koncowy) to high(Koncowy) do
            if naKoncowy[a, k] then begin
                if pierwszyRaz then
                    pierwszyRaz := false
                else
                    write('|');
                write(k)
            end;
        write('): ')
    end
end;
 
{* Wypisuje slowo "s" *}
procedure wypiszSlowo(const s : Slowo);
var i : Integer;
begin
    with s do begin
        for i := 1 to ileKoncowych do
            write(symbole[i]);
        for i := high(symbole) - ilePomocniczych + 1 to high(symbole) do
            write(symbole[i]);
        writeln
    end
end;
 
{* Tworzy slowo puste *}
procedure inicjujPuste(var s : Slowo);
begin
    s.ilePomocniczych := 0;
    s.ileKoncowych := 0
end;
 
{*
 * W slowie "s" stosuje produkcje o prawej stronie "p".
 *
 * Przed wywolaniem procedury, pierwszy od lewej symbol pomocniczy zostal juz
 * usuniety ze slowa "s".
 *}
procedure zastosujProdukcje(var s : Slowo; const p : String);
begin
    if length(p) = 1 then
        dodajKoncowy(s, p[1])
    else begin
        assert(length(p) = 2);
        dodajPomocniczy(s, p[2]);
        dodajPomocniczy(s, p[1])
    end
end;
 
{* Sprawdza, czy w slowie "s" sa same symbole koncowe *}
function brakPomocniczych(const s : Slowo) : Boolean;
begin
    brakPomocniczych := (s.ilePomocniczych = 0)
end;
 
{**
 * Wczytuje z wejscia prawa strone produkcji gramatyki "g" dla symbolu "a"
 * i zapisuje na "p".
 *
 * W przypadku wykrycia bledu, prosi uzytkownika o ponowne wprowadzenie
 * produkcji.
 *}
procedure wybierzProdukcje(var p : String; a : Pomocniczy;
        const g : Gramatyka);
var ok : Boolean;
    s : String;
begin
    ok := false;
    repeat
        wypiszOpcje(a, g);
        readln(s);
        if (length(s) <> 1) and (length(s) <> 2) then
            wypiszKomunikat('Nieprawidlowa dlugosc produkcji', s)
        else if length(s) = 1 then
            if not jestKoncowym(s[1]) then
                wypiszKomunikat('To nie jest symbol koncowy', s)
            else if not g.naKoncowy[a, s[1]] then
                wypiszKomunikat('Brak produkcji z prawa strona', s)
            else
                ok := true
        else if not jestPomocniczym(s[1]) or not jestPomocniczym(s[2]) then
            wypiszKomunikat('Powinny byc dwa symbole pomocnicze', s)
        else if not g.naPomocnicze[a, s[1], s[2]] then
            wypiszKomunikat('Brak produkcji z prawa strona', s)
        else
            ok := true
    until ok;
    p := s
end;
 
{* Wczytuje gramatyke i symuluje wyprowadzenie slowa *}
procedure glowna;
var wybor : String;
    symulowana : Gramatyka;
    wyprowadzane : Slowo;
    aktualny : Pomocniczy;
begin
    wczytajGramatyke(symulowana);
    inicjujPuste(wyprowadzane);
    dodajPomocniczy(wyprowadzane, symulowana.aksjomat);
    wypiszSlowo(wyprowadzane);
    while not brakPomocniczych(wyprowadzane) do begin
        usunPomocniczy(wyprowadzane, aktualny);
        wybierzProdukcje(wybor, aktualny, symulowana);
        zastosujProdukcje(wyprowadzane, wybor);
        wypiszSlowo(wyprowadzane)
    end
end;
 
begin
    glowna
end.

program znaki;
 
const
    PUSTE = '-';
 
type
    Drzewo = ^Wezel;
    Wezel  = record
        w : Char;
        lsyn, psyn : Drzewo
    end;
 
var d : Drzewo;
 
procedure wczytaj(var d : Drzewo);
var c : Char;
begin
    assert(not eoln);
    read(c);
    if c = PUSTE then
        d := nil
    else begin
        new(d);
        d^.w := c;
        wczytaj(d^.lsyn);
        wczytaj(d^.psyn)
    end
end;
 
procedure wypisz(d : Drzewo);
begin
    if d = nil then
        write(PUSTE)
    else begin
        write(d^.w);
        wypisz(d^.lsyn);
        wypisz(d^.psyn)
    end
end;
 
procedure usun(d : Drzewo);
begin
    if d <> nil then begin
        usun(d^.lsyn);
        usun(d^.psyn);
        dispose(d)
    end
end;
 
begin
    wczytaj(d);
    assert(Eoln);
    readln;
    wypisz(d);
    writeln;
    usun(d)
end.