Stránka sa načítava, prosím čakajte…
© 2005 – 2025 Roman Horváth, všetky práva vyhradené. Dnes je 5. 7. 2025.
Dátum: 15. 4. 2017, pred niekoľkými rokmi, aktualizované: 4. 8. 2020, pred piatimi rokmi
Zdrojový kód programu: ~ program linearny_zoznam; {$mode objfpc} // (tento prepínač zmení režim na ObjFPC, // v ktorom môžeme používať niektoré užitočné // vlastnosti jazyka Free Pascal) (* Aby sme trochu zjednotili terminológiu, zavedieme si… Slovník pojmov ============== (Dynamický) «zoznam» — náš zoznam tvoriaci reťaz dynamických (to jest dynamicky vytváraných) prvkov. «Atribút» (záznamu) – tento termín budeme používať na označenie prvku v rámci údajového typu záznam (record), čiže napr. meno, priezvisko, id osoby, prípadne ďalšie (ktoré v tomto príklade nie sú definované). «Element» (zoznamu) – toto bude termín, ktorým budeme označovať jeden prvok dynamického zoznamu, čiže jeden dynamicky vytvorený záznam – jeden prvok dynamickej reťaze. Aby sme termíny lepšie odlíšili, budeme ich zvýrazňovať francúzskymi úvodzovkami: «zoznam», «atribút», «element». *) type // Údajový typ záznamu o osobe. Record Osoba. Osoba = record meno: string; priezvisko: string; id: string end; // Údajvý typ smerníka na prvok zoznamu osoby – // malo by to byť v zmysle „pointer na EOsoba“ // (čiže PEOsoba), ale skrátili sme to na POsoba: POsoba = ^EOsoba; // Tento typ musíme umiestniť pred «element» osoby, // pretože definícia EOsoba ho potrebuje na // definovanie prvku „dalsia“, ktorý reprezentuje // ďalší «element» (prvok reťaze lineárneho zoznamu). // Údajový typ „element osoby“ — EOsoba. // To bude jeden «element» – prvok dynamického // zoznamu. EOsoba = record tato: Osoba; dalsia: POsoba end; var prvy: POsoba = nil; // Toto bude začiatok zoznamu. // Prvý «element» (prvok) zoznamu. // Táto funkcia vytvorí nový «element» dynamického // zoznamu a pripojí ho na koniec zoznamu. function vytvor_prvok(id: string): POsoba; var dalsi: POsoba; begin if prvy = nil then begin // 1. Vytvorenie nového záznamu – «elementu»: new(prvy); // 2. Naplnenie všetkých „údajových polí“ – // «atribútov» záznamu, teda aspoň tých, ktoré // v tejto fáze môžeme naplniť. Napríklad pri // prvom «atribúte» (tato) poznáme len id: prvy^.tato.id := id; prvy^.dalsia := nil; // ‼Dôležité‼ // 3. Vrátenie „hotového“ objektu («elementu») // na ďalšie spracovanie (prítomnosť tohto // kroku záleží od implementácie (t. j. // spôsobu prevedenia), takže je kvázi // nepovinný. V tejto implementácii je však // kľúčový: result := prvy // Poznámka: Špeciálna premenná result nefunguje // v predvolenom režime kompilátora. Ak ju // chceme používať, musíme prepnúť kompilátor // do iného režimu, napríklad ObjFPC – pozri // prepínač na začiatku zdrojového kódu. end else begin // Nájdeme «element», ktorý už nemá ďalší prvok, // čiže nájdeme koniec reťaze lineárneho // «zoznamu»: dalsi := prvy; while dalsi^.dalsia <> nil do dalsi := dalsi^.dalsia; // Teraz zopakujeme presne to isté, čo pri prvom // prvku, ale namiesto pre „prvy“ to urobíme pre // „dalsi^.dalsia“: new(dalsi^.dalsia); dalsi^.dalsia^.tato.id := id; dalsi^.dalsia^.dalsia := nil; result := dalsi^.dalsia end end; // Táto procedúra vyžiada údaje o «elemente» od // používateľa, použije funkciu vytvor_prvok na // vytvorenie nového «elementu» a uloží do neho // zvyšné «atribúty». procedure pridaj_prvok; var meno, priezvisko, id: string; novy: POsoba; begin write('Zadajte meno: '); readln(meno); write('Zadajte priezvisko: '); readln(priezvisko); write('Zadajte id: '); readln(id); novy := vytvor_prvok(id); novy^.tato.meno := meno; novy^.tato.priezvisko := priezvisko end; // Táto procedúra vypíše len jeden (zadaný) «element». procedure vypis_zaznam(zaznam: POsoba); begin write(zaznam^.tato.id); write(' (', zaznam^.tato.meno, ' '); writeln(zaznam^.tato.priezvisko, ')') end; // Táto procedúra vypíše celý «zoznam». procedure vypis_zoznam; var dalsi: POsoba; begin dalsi := prvy; while dalsi <> nil do begin vypis_zaznam(dalsi); dalsi := dalsi^.dalsia end end; // Táto funkcia nájde «element» «zoznamu» podľa // zadaného id. function najdi_prvok(id: string): POsoba; var dalsi: POsoba; begin dalsi := prvy; while dalsi <> nil do begin if dalsi^.tato.id = id then begin // «element bol nájdený: result := dalsi; exit end; dalsi := dalsi^.dalsia end; result := nil // «element» nebol nájdený end; // Táto procedúra vyžiada zadanie id od používateľa // a použije funkciu najdi_prvok na nájdenie «elementu» // podľa zadanej hodnoty. procedure hladaj_prvok; var id: string; najdeny: POsoba; begin write('Zadajte id prvku na vyhľadanie: '); readln(id); najdeny := najdi_prvok(id); if najdeny = nil then writeln('Hľadaný prvok nebol nájdený.') else begin write('Prvok bol nájdený: '); vypis_zaznam(najdeny) end end; // Táto funkcia vymaže zo «zoznamu» zadaný «element». // Funkcia pre istotu vracia booleovskú hodnotu // zodpovedajúcu informácii o tom, či sa vymazanie // «elementu» skutočne podarilo. (Nikto nevie zaručiť, že // jej zadáme taký «element», ktorý je skutočne // v «zozname».) function vymaz_prvok(vymaz: POsoba): boolean; var dalsi: POsoba; begin // Tento krok slúži buď na zálohovanie prvého // «elementu», ktorý bude v ďalšom kroku vymazaný // (ak je mazaný prvok prvým prvkom), alebo na // začatie vyhľadávania mazaného «elementu» // v «zozname». dalsi := prvy; // Najskôr musíme overiť, či mazaný «element» nie je // prvým prvkom (lebo vtedy postupujeme ináč): if prvy = vymaz then begin // Zvolíme ďalší «element» za prvý a pôvodný // prvý (ktorý je teraz uložený v premennej dalsi) // vymažeme: prvy := prvy^.dalsia; dispose(dalsi); result := true; exit end else begin // V opačnom prípade hľadáme «element» v zozname… while dalsi <> nil do begin // … a keď ho nájdeme, tak ho vymažeme, ale // predtým musíme zabezpečiť správne // prepojenie reťaze («zoznamu»): if dalsi^.dalsia = vymaz then begin // Aby sme zápis nekomplikovali množstvom // striešok a symbolov, môžeme ho // zjednodušiť. «Elementu» dalsi^.dalsia // priradíme «element» vymaz^.dalsia, // pretože tieto dva elementy idú za sebou // (podmienka „dalsi^.dalsia = vymaz“ to // práve overila) a my potrebujeme do // «atribútu» dalsi^.dalsia zapísať ten // «element», ktorý je o dva prvky ďalej, // čo je presne «element» vymaz^.dalsia. dalsi^.dalsia := vymaz^.dalsia; // Potom môžeme vymazať «element» vymaz. dispose(vymaz); result := true; exit end; dalsi := dalsi^.dalsia end end; result := false end; // Táto procedúra vyžiada od používateľa id, pokúsi sa na // základe neho vyhľadať «element» v «zozname». Ak ho // nájde, vymaže ho. procedure odober_prvok; var id: string; mazany: POsoba; begin write('Zadajte id prvku na vymazanie: '); readln(id); mazany := najdi_prvok(id); if mazany = nil then writeln('Hľadaný prvok nebol nájdený.') else begin write('Prvok bol nájdený: '); vypis_zaznam(mazany); if vymaz_prvok(mazany) then writeln('Prvok bol vymazaný.') else writeln('Prvok sa nepodarilo vymazať.') end end; var volba: string; begin // Aby sme nemuseli stále spúšťať a ukončovať túto // miniaplikáciu, použijeme jednoduchú ponuku // príkazov: repeat writeln('N – nový prvok'); writeln('H – hľadaj prvok'); writeln('V – vymaž prvok'); writeln; writeln('K – koniec'); write(': '); readln(volba); if volba <> '' then volba := lowerCase(volba[1]); if volba = 'n' then begin pridaj_prvok; vypis_zoznam; end else if volba = 'h' then begin hladaj_prvok; end else if volba = 'v' then begin odober_prvok; vypis_zoznam; end; writeln until volba = 'k'; writeln('koniec') end. |
Ak zadáte: n Ján Mrkvička 0 n Karol Kapusta 1 n Ladislav Chren 2 n Matej Hraško 3 h 2 h 5 v 2 v 5 k Výstupom programu bude: N – nový prvok H – hľadaj prvok V – vymaž prvok K – koniec : n Zadajte meno: Ján Zadajte priezvisko: Mrkvička Zadajte id: 0 0 (Ján Mrkvička) N – nový prvok H – hľadaj prvok V – vymaž prvok K – koniec : n Zadajte meno: Karol Zadajte priezvisko: Kapusta Zadajte id: 1 0 (Ján Mrkvička) 1 (Karol Kapusta) N – nový prvok H – hľadaj prvok V – vymaž prvok K – koniec : n Zadajte meno: Ladislav Zadajte priezvisko: Chren Zadajte id: 2 0 (Ján Mrkvička) 1 (Karol Kapusta) 2 (Ladislav Chren) N – nový prvok H – hľadaj prvok V – vymaž prvok K – koniec : n Zadajte meno: Matej Zadajte priezvisko: Hraško Zadajte id: 3 0 (Ján Mrkvička) 1 (Karol Kapusta) 2 (Ladislav Chren) 3 (Matej Hraško) N – nový prvok H – hľadaj prvok V – vymaž prvok K – koniec : h Zadajte id prvku na vyhľadanie: 2 Prvok bol nájdený: 2 (Ladislav Chren) N – nový prvok H – hľadaj prvok V – vymaž prvok K – koniec : h Zadajte id prvku na vyhľadanie: 5 Hľadaný prvok nebol nájdený. N – nový prvok H – hľadaj prvok V – vymaž prvok K – koniec : v Zadajte id prvku na vymazanie: 2 Prvok bol nájdený: 2 (Ladislav Chren) Prvok bol vymazaný. 0 (Ján Mrkvička) 1 (Karol Kapusta) 3 (Matej Hraško) N – nový prvok H – hľadaj prvok V – vymaž prvok K – koniec : v Zadajte id prvku na vymazanie: 5 Hľadaný prvok nebol nájdený. 0 (Ján Mrkvička) 1 (Karol Kapusta) 3 (Matej Hraško) N – nový prvok H – hľadaj prvok V – vymaž prvok K – koniec : k koniec |
Zdroje v anglickom jazyku:
- https://www.freepascal.org/docs‑html/rtl/system/new.html
- https://www.freepascal.org/docs‑html/rtl/system/dispose.html
- http://wiki.freepascal.org/Pointer
- https://www.freepascal.org/docs‑html/ref/ref.html#QQ2‑42‑66
- https://www.freepascal.org/docs‑html/ref/refse15.html#x42‑600003.4
Dňa 15. 4. 2017 bola na tejto stránke zverejnená výzva pre študentov v tomto znení: „Program obsahuje jednu relatívne závažnú chybu. Komu sa ju podarí opraviť, získa bonifikačné body za semester.“ Výzva sa skončila dňa 26. 4. 2017. Chybný a opravený program sú nižšie (dostupné s pomocou tlačidiel na zobrazenie a skrytie) a rôzne verzie na prevzatie sú pod nimi.
Zobraziť chybnú verziu Zobraziť opravenú verziu
Riešenie výzvy – Free Pascal (s diakritikou, viac‑platformové) 2,67 kB (2,60 KiB), 26. 4. 2017
Verzia na prevzatie Turbo/Borland Pascal (bez diakritiky) 1,82 kB (1,77 KiB), 15. 4. 2017
Verzia na prevzatie Free Pascal (s diakritikou, viac‑platformové) 2,16 kB (2,11 KiB), 15. 4. 2017
Táto verzia projektu bola až do augusta 2020 sprístupnená len formou nasledujúceho súboru na prevzatie v zozname materiálov:
PROJEKTZ.PAS
4,41 kB (4,30 KiB), 31. 3. 2016
Keďže ide o starší materiál, bol iba formálne presunutý zo zoznamu materiálov do tejto karty a zároveň bol k nemu zverejnený nasledujúci výpis zdrojového kódu:
~
program zaznamy; uses crt; type POsoba = ^EOsoba; { Tuto definiciu ponechame tak ako je, aby sme nadalej mohli pouzivat file of Osoba. } Osoba = record meno: string; vek: integer; end; EOsoba = record tato: Osoba; dalsia: POsoba; end; var osoby: POsoba; i: integer; klaves: char; subor: file of Osoba; dlzka: text; { Textovy subor na ulozenie dlzky pola. } { Idealne by bolo, keby boli vsetky udaje ulozene v jednom subore, ale to by sme nemohli pouzit file of Osoba, proces citania a zapisu by sa skomplikoval. Pri zapise by sme museli zistit pocet zaznamov vopred. } procedure vypis_pomoc; begin writeln('F1 - vypis pomoc'); writeln('F2 - citaj udaje'); writeln('F3 - zapis udaje'); writeln('F4 - vymaz obraz'); writeln('F5 - zadaj udaje'); writeln('F6 - vypis udaje'); writeln('ESC - koniec'); end; procedure pridaj_osobu(nova: Osoba); var novy_zaznam: POsoba; begin { Zjednoduseny pristup: nehladame zakazdym koniec pola, ale posunieme jeho zaciatok do dalsieho prvku - nove zaznamy su vzdy pridavane na zaciatok dynamickeho pola. Vedlajsi efekt - zakazdym, ked znovu nacitame pole zo suboru bude poradie prvkov prevratene oproti tomu ako boli zapisane. } new(novy_zaznam); novy_zaznam^.tato := nova; novy_zaznam^.dalsia := osoby; osoby := novy_zaznam; end; function najdi_osobu(hladana: string): POsoba; var aktualna: POsoba; begin aktualna := osoby; while aktualna <> nil do begin if aktualna^.tato.meno = hladana then break; aktualna := aktualna^.dalsia; { Posun na dalsi zaznam. } end; najdi_osobu := aktualna; end; procedure citaj_udaje; var pocet: integer; zaznam: Osoba; begin pocet := 0; {$I-} assign(dlzka, 'osoby.txt'); reset(dlzka); if ioResult = 0 then begin write('Citam dlzku.'); read(dlzka, pocet); writeln(' Hotovo.'); close(dlzka); end; assign(subor, 'osoby.dat'); reset(subor); if ioResult = 0 then begin write('Citam udaje'); for i := 1 to pocet do begin write('.'); read(subor, zaznam); pridaj_osobu(zaznam); end; writeln(' Hotovo.'); close(subor); end else writeln('Udaje nie je mozne citat.'); {$I+} end; procedure zapis_udaje; var pocet: integer; aktualna: POsoba; begin pocet := 0; {$I-} assign(subor, 'osoby.dat'); rewrite(subor); if ioResult = 0 then begin write('Zapisujem udaje'); aktualna := osoby; while aktualna <> nil do begin write('.'); write(subor, aktualna^.tato); aktualna := aktualna^.dalsia; inc(pocet); end; writeln(' Hotovo.'); close(subor); end else writeln('Udaje nie je mozne zapisat.'); assign(dlzka, 'osoby.txt'); rewrite(dlzka); if ioResult = 0 then begin write('Zapisujem dlzku.'); write(dlzka, pocet); writeln(' Hotovo.'); close(dlzka); end; {$I+} end; procedure zadaj_udaje; var meno: string; vek: integer; hladana: POsoba; nova: Osoba; begin write('Zadaj meno: '); readln(meno); write('Zadaj vek: '); readln(vek); hladana := najdi_osobu(meno); if hladana = nil then begin nova.meno := meno; nova.vek := vek; pridaj_osobu(nova); end else hladana^.tato.vek := vek; end; procedure vypis_udaje; var meno: string; hladana: POsoba; begin write('Zadaj meno: '); readln(meno); hladana := najdi_osobu(meno); if hladana <> nil then begin writeln('Hladana osoba: ', hladana^.tato.meno); writeln('Vek: ', hladana^.tato.vek); end else writeln('Hladana osoba (', meno, ') nie je v zaznamoch.'); end; begin textbackground(7); textcolor(0); clrscr; osoby := nil; vypis_pomoc; repeat klaves := readkey; {write(klaves);} if klaves = #0 then begin klaves := readkey; case klaves of #59: vypis_pomoc; #60: citaj_udaje; #61: zapis_udaje; #62: clrscr; #63: zadaj_udaje; #64: vypis_udaje; else writeln('Rozsireny ASCII: ', ord(klaves)); end end; until klaves = #27; end.
Prosím, zvoľte verziu materiálu.