تابع change مقدار عناصری را که برابر x است به y تغییر می دهد.
تابع lastprev عنصر یکی مانده به آخر را بر می گرداند.
تابع prev عنصر قبلی (نسبت به یک عنصر مشخص) را بر می گرداند.
تابع invert ترتیب عناصر لیست را برعکس می کند.
سایر تابع ها هم اینها هستند :
تابع first اولین عضو لیست را بر می گرداند.
تابع create یک لیست تهی ایجاد می کند.
تابع next عنصر بعدی لیست (نسبت به یک عنصر مشخص) را بر می گرداند.
تابع retrieve مقدار یک عنصر (یک رشته string) را بر می گرداند.
تابع last آخرین عنصر یک لیست را بر می گرداند.
تابع add یک عنصر به انتهای لیست اضافه می کند و آنرا بر می گرداند.
تابع remove یک عنصر مشخص را از لیست حذف می کند و عنصر بعدی (بعد از عنصر حذف شده) را بر می گرداند.
تابع clean تمامی عناصری که یک مقدار مشخص (یک رشته string) را دارند حذف می کند.
تابع cleanup تمامی عناصری که شامل هرگونه مقدار تکراری هستند را از لیست حذف می کند.
تابع print مقادیر کلیه عناصر لیست را به ترتیب چاپ می کند.
کد:
uses crt;
type
list = ^list_item;
item = ^record_item;
list_item = record
start : item;
end;
record_item = record
value : string;
next : item;
end;
var
L : list;
function first (L : list) : item;
begin
first := L^.start;
end;
procedure create (L : list);
begin
L^.start := nil;
end;
function next (L : list; P : item) : item;
begin
next := P^.next;
end;
function prev (L : list; P : item) : item;
var
Q, V : item;
begin
V := nil;
Q := first (L);
if (Q <> nil) and (P <> nil) then
while (next (L, Q) <> nil) and (Q <> P) do
begin
V := Q;
Q := next (L, Q);
end;
prev := V;
end;
function retrieve (L : list; P : item) : string;
begin
retrieve := P^.value;
end;
function lastprev (L : list) : item;
var
P, Q : item;
begin
P := first (L);
Q := nil;
if P <> nil then
while (next (L, P) <> nil) do
begin
Q := P;
P := next (L, P);
end;
lastprev := Q;
end;
function last (L : list) : item;
var
P : item;
begin
P := first (L);
if P <> nil then
while (next (L, P) <> nil) do
P := next (L, P);
last := P;
end;
procedure invert (L : list);
var
P, Q, R : item;
begin
P := first (L);
R := next(L, P);
P^.next := nil;
while (R <> nil) do
begin
Q := next (L, R);
R^.next := first (L);
L^.start := R;
R := Q;
end;
P^.next := nil;
end;
function add (L : list; S : string) : item;
var
newitem : item;
begin
new (newitem);
newitem^.value := S;
newitem^.next := nil;
if first (L) = nil then
L^.start := newitem
else
last (L)^.next := newitem;
add := newitem;
end;
function remove (L : list; P : item) : item;
var
R : item;
begin
R := first (L);
if R <> nil then
if R = P then
begin
L^.start := next (L, P);
remove := first (L);
dispose (P);
end
else
while (next (L, R) <> nil) do
if next (L, R) = P then
begin
R^.next := next (L, P);
remove := next (L, P);
dispose (P);
break;
end
else
R := next (L, R);
end;
procedure change (L : list; X, Y : string);
var
P: item;
begin
P := first (L);
while (P <> nil) do
begin
if X = retrieve (L, P) then
P^.value := Y;
P := next (L, P);
end;
end;
procedure clean (L : list; S : string);
var
P: item;
begin
P := first (L);
while (P <> nil) do
if S = retrieve (L, P) then
P := remove (L, P)
else
P := next (L, P);
end;
procedure cleanup (L : list);
var
P, R : item;
begin
P := first (L);
while (P <> nil) do
begin
R := next (L, P);
while (R <> nil) do
if retrieve (L, P) = retrieve (L, R) then
R := remove (L, R)
else
R := next (L, R);
P := next (L, P);
end;
end;
procedure print (L : list);
var
P : item;
begin
P := first (L);
while (P <> nil) do
begin
write( retrieve (L, P), ' > ');
P := next (L, P);
end;
writeln ('Null');
end;
begin
clrscr;
create (L);
add (L, '1');
add (L, '2');
add (L, '3');
add (L, '2');
add (L, '4');
print (L);
writeln (retrieve(L, lastprev(L)));
writeln (retrieve(L, prev(L, last(L))));
change (L, '2', '5');
print (L);
cleanup (L);
print (L);
invert (L);
print (L);
readkey;
end.
