program ListaJednokierunkowa; 
uses crt; 
type 
   Wskaznik = ^ElementListy; 
   ElementListy = record 
              indeks : integer; 
              nast   : Wskaznik; 
              end; 
 
 
 
procedure Tworzenie(var pocz: Wskaznik); 
var q : Wskaznik; 
    x:integer; 
 
begin 
writeln('Podaj ilosc elementow listy'); 
readln(x); 
while x>0 do 
 begin 
 New(q); 
 q^.indeks:=x; 
 q^.nast:=pocz; 
 pocz:=q; 
 x:=x-1; 
 end; 
end; 
 
procedure Wyswietlanie(var pocz: Wskaznik); 
 var q : Wskaznik; 
 
begin 
   q:=pocz; 
   writeln('Elementy listy:'); 
   while q <> nil do 
   begin 
        WriteLn(q^.indeks); 
        q:=q^.nast; 
   end; 
   writeln; 
   end; 
 
procedure DodawaniePierwszego (var pocz :Wskaznik); 
var 
  q : Wskaznik; 
  x : integer; 
begin 
   writeln('Podaj dane do dodania'); 
   readln(x); 
   New(q); 
   q^.nast:=pocz; 
   pocz:=q; 
   q^.indeks:=x; 
end; 
 
procedure DolaczElement(var pocz: Wskaznik); 
var q,t : Wskaznik; 
    id, dane: integer; 

 
begin 
   writeln('Po ktorym elemencie dodac dane?' ); 
   readln(id); 
   writeln('Podaj dane do dodania'); 
   readln(dane); 
   t:=pocz; 
   while (t <> nil) and (t^.indeks <> id) do 
      t:=t^.nast; 
 
   New(q); 
   q^.indeks:=dane; 
   q^.nast:=t^.nast; 
   t^.nast:=q; 
end; 
 
procedure UsunElement(var pocz: Wskaznik); 
var q,p,t: Wskaznik; 
dane:integer; 
begin 
    writeln('Podaj element do usuniecia'); 
    readln(dane); 
    q:=pocz; 
   while (q <> nil) and (q^.indeks <> dane) do 
     begin 
       p:=q; 
       q:=q^.nast; 
      end; 
   if q = pocz then 
      pocz:=q^.nast 
   else 
      p^.nast:=q^.nast; 
 
   Dispose(q); 
end; 
 
procedure UsunListe(var pocz: Wskaznik); 
var q:Wskaznik; 
 
begin 
 while pocz<>nil do 
 begin 
 q:=pocz; 
 pocz:=pocz^.nast; 
 dispose(q); 
 end; 
 writeln ('lista zostala usunieta'); 
 end; 
 
function PustaLista (var pocz: Wskaznik):boolean; 
begin 
 
  if pocz= nil then writeln ('Lista pusta') 
               else writeln ('Lista nie jest pusta'); 
  PustaLista:=Pocz=Nil; 
end; 
 
 

function DlugoscListy (var pocz: Wskaznik):integer; 
var q: Wskaznik; 
    l: integer; 
BEGIN 
 q:=pocz; 
 l:=0; 
 while q<>nil do 
   begin 
     l:= l+1; 
     q:=q^.nast; 
   end; 
 
 writeln ('Lista ma dlugosc: ',l); 
 DlugoscListy:=l; 
END; 
 
 
procedure Wyszukaj(var pocz: Wskaznik); 
var q: Wskaznik; 
    x: integer; 
    b:boolean; 
Begin 
 writeln('Jakiego elementu szukasz?' ); 
   readln(x); 
   q:=pocz; 
   b:=true; 
   while (q <> nil) and b do 
   if q^.indeks= x then b:= false 
                    else q:=q^.nast; 
   if q = nil then writeln ('Elmentu nie ma w liscie') 
   else writeln ('Element znajduje sie w liscie '); 
end; 
 
var 
glowa: Wskaznik; 
menu:char; 
 
begin 
glowa:=nil; 
clrScr; 
    writeln('1 - Generacja listy'); 
    writeln('2 - Dodawanie po okreslonym'); 
    writeln('3 - Dodawanie pierwszego'); 
    writeln('4 - Usuwanie dowolnego'); 
    writeln('5 - Wsywietlanie listy'); 
    writeln('6 - Czy lista pusta?'); 
    writeln('7 - Jak dluga jest lista?'); 
    writeln('8 - Wyszukiwanie elementu w liscie'); 
    writeln('9 - Usun cala liste'); 
    writeln('0 - KONIEC'); 
    writeln; 
    repeat 
 
    menu:=readkey; 
    case menu of 
     '1': Tworzenie(glowa); 
     '2': DolaczElement(glowa); 
     '3': DodawaniePierwszego(glowa); 

     '4': UsunElement(glowa); 
     '5': Wyswietlanie(glowa); 
     '6': PustaLista (glowa); 
     '7': DlugoscListy (glowa); 
     '8': Wyszukaj (glowa); 
     '9': UsunListe (glowa); 
    end; 
    until menu='0'; 
end. 
 
 

 

W oparciu o powyższy program  napisać procedury: 

1.  Utworzenie  listy: 

a.  w porządku prostym – elementy w liście w kolejności  wstawiania, klucze 

podawane przez użytkownika; 

b.  w porządku niemalejącym –  wstawianie do listy z jednoczesnym sortowaniem; 

c.  dołączanie   na koniec listy elementu  - wersja rekurencyjna procedury; 

2.  Wydrukowanie listy  w kolejności  (wersje rekurencyjne procedur): 

a.  od pierwszego do ostatniego elementu; 

b.  od ostatniego do pierwszego; 

c.  wydrukowanie tylko ostatniego elementu listy;