Stránka sa načítava, prosím čakajte…
© 2005 – 2024 Roman Horváth, všetky práva vyhradené. Dnes je 25. 4. 2024.
Dátum: 15. 4. 2017, pred niekoľkými rokmi, aktualizované: 4. 8. 2020, pred štyrmi 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.PAS4,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.