program delete;
uses CRT;
const n=5;
var St:array [1..n] of integer;
i,m : integer;
procedure input;
begin
writeln('Input in stek');
for i:=1 to n do begin
write('#',i,'= ');
readln(st[i]);
end;
for i:=1 to n do
write(st[i], ' ');
end;
Procedure min;
begin
m:=st[1];
begin
for i:=2 to n do
begin
if (m>st[i]) then
m:=st[i];
end;
writeln('min element: ',m);
readln;
end;
end;
procedure dlt;
begin
for i:=1 to n do
begin
if (m<>st[i]) then
write(st[i], ' ');
end;
readln;
end;
begin
clrscr;
input;
clrscr;
min;
clrscr;
dlt;
end.
Вариант 2
Program xa;
uses
crt;
type
stek=^vs;
vs=record
data:integer;
next:stek;
end;
Procedure printf(a:stek);
begin
writeln;
while a<>nil do
begin
Write(a^.data, ' ');
a:=a^.next;
end;
end;
Procedure delstek(a:stek);
var
b:stek;
begin
if a=nil then
writeln('Ctek nyct')
else
while a<>nil do
begin
b:=a^.next;
dispose(a);
a:=b
end
end;
Procedure delmin(var a:stek);
var
b,c:stek;
min:integer;
begin
min:=a^.data;
b:=a;
c:=b;
while b<>nil do
begin
if b^.data<min then
begin
c:=b;
min:=b^.data
end;
b:=b^.next
end;
if (c=a) and (a^.next=nil) then
begin
delstek(a);
a:=nil
end
else
begin
if c=a then
begin
a:=a^.next;
dispose(c)
end
else
begin
b:=a;
while b^.next <>c do
b:=b^.next;
b^.next:=c^.next;
dispose(c);
end;
end;
end;
var
a,b:stek;
i,n:integer;
begin
repeat
clrscr;
Write('VVedute kolu4ectvo elementov ');
readln(n);
until n>0;
a:=nil;
new(a);
a^.next:=nil;
i:=1;
clrscr;
Write(i, ' -bli element cteka ');
readln(a^.data);
for i:=2 to n do
begin
Write(i, ' -bli element cteka ');
b:=nil;
new(b);
readln(b^.data);
b^.next:=a;
a:=b
end;
printf(a);
delmin(a);
printf(a);
delstek(a);
readln;
end.