прога написана,вроде алгоритм правильный но где то ошибки и недочеты
Program stek_1;
type
Telem =integer;
ukaz = ^zweno;
zweno =record
ELem: Telem;
next:ukaz;
end;
stek=ukaz;
var ust,ust1,ust2,ust3,g,g1,g2,g3:ukaz;
a,EL,EL1,EL2,EL3:Telem;
min1,min2,min3:integer;
procedure wstek(var ust:stek; Nelem:Telem);
var g:ukaz;
begin
New(g);
g^.Next:=ust;ust:=g{?}
end;
procedure Isstek (var ust:stek; var a:Telem);
var g:ukaz;
begin
if ust =nil then
writeln('попытка выбора из пустого стека ')
else
begin
a:=ust^.Elem;
g:=ust;
ust:=ust^.next; dispose(g)
end ;
end;
Function outstak (var dukaz:ukaz):Telem; {?}
var EL:ukaz;
begin
outstak:=dukaz^.Elem;
EL:=dukaz;
dukaz:=dukaz^.next;
dispose(EL);
end;
BEGIN
ust1:=nil;ust2:=nil;ust3:nil;
writeln('введите элементы стека ч/з пробел, 0 и enter завершает ввод ');
read (EL1);
while EL1<=>0 do
begin
wstek(ust1,EL1);
read(EL2);
end;
writeln;
writeln(введите элементы стека ч/з пробел, 0 и enter завершает ввод');
read (EL2);
while EL2<>0 do
begin
wstek(ust2,EL2);
read(EL2);
end;
writeln;
writeln('введите элементы стека ч/з пробел, 0 и enter завершает ввод');
read (EL3);
while EL3<>0 do
begin
wstek(ust3,EL3);
read(EL3);
end;
writeln;
min1:=outstak(g1);
while g1<>nil do begin
EL1:=Outstak(g1);
if(EL1<>min1)then min1:EL1;
end;
min2:=outstak(g2);
while g2<>nil do begin
EL2:=Outstak(g2);
if(EL2<>min2)then min2:EL2;
end;
min3:=outstak(g3);
while g3<>nil do begin
EL3:=Outstak(g3);
if(EL3<>min3)then min3:EL3;
end;
if (min1<=min2)then
begin
while (g2<>nil) and (g3<>nil) do
begin EL2:=outstak(g2);
EL3:=outstak(g3);
end{?}
if (EL2>EL3) then
begin
while ust1<>nil do
begin
Isstek(ust1,EL1);
wstek(ust2,EL2);
end{?}
writeln;
while ust2<>nil do
begin
Isstek(ust2,EL2);
write(EL2,' ');
end;
writeln;
end;
else
begin
while ust1<>nil do
begin
Isstek(ust1,EL1);
wstek(ust3,EL3);
end{?}
writeln;
while ust3<>nil do
begin
Isstek(ust3,EL3);
write(EL3,' ');
end;
writeln;
end;
else
begin
EL1:=outstak(g1);
EL3:=outstak(g3);
end{?}
if (EL1>=EL3) then
begin
while ust2<>nil do
begin
Isstek(ust2,EL2);
wstek(ust1,EL1);
end{?}
writeln;
while ust1<>nil do
begin
Isstek(ust1,EL1);
write(EL1,' ');
end;
writeln;
end;
else
begin
while ust2<>nil do
begin
Isstek(ust2,EL2);
wstek(ust3,EL3);
end{?}
writeln;
while ust3<>nil do
begin
Isstek(ust3,EL3);
write(EL3,' ');
end;
writeln;
end;
end;end;
if (min1>=min3)and(min2>=min3) then
begin
while (g1<>nil) and (g2<>nil) do
begin EL1:=outstak(g1);
EL2:=outstak(g2);
end{?}
if (EL1>EL2) then
begin
while ust3<>nil do
begin
Isstek(ust3,EL3);
wstek(ust1,EL1);
end{?}
writeln;
while ust1<>nil do
begin
Isstek(ust1,EL1);
write(EL1,' ');
end;
writeln;
end;
else
begin
while ust3<>nil do
begin
Isstek(ust3,EL3);
wstek(ust2,EL2);
end{?}
writeln;
while ust2<>nil do
begin
Isstek(ust2,EL2);
write(EL2,' ');
end;
writeln;
end;
end;
end.
или вот файл сам
Сообщение отредактировано: pheonix -