IPB
ЛогинПароль:

> Прочтите прежде чем задавать вопрос!

1. Заголовок темы должен быть информативным. В противном случае тема удаляется ...
2. Все тексты программ должны помещаться в теги [code=pas] ... [/code], либо быть опубликованы на нашем PasteBin в режиме вечного хранения.
3. Прежде чем задавать вопрос, см. "FAQ", если там не нашли ответа, воспользуйтесь ПОИСКОМ, возможно такую задачу уже решали!
4. Не предлагайте свои решения на других языках, кроме Паскаля (исключение - только с согласия модератора).
5. НЕ используйте форум для личного общения, все что не относится к обсуждению темы - на PM!
6. Одна тема - один вопрос (задача)
7. Проверяйте программы перед тем, как разместить их на форуме!!!
8. Спрашивайте и отвечайте четко и по существу!!!

> Покритекуйте,укажите на ошибки.., процедуры для работы со стеком.
сообщение
Сообщение #1


Бывалый
***

Группа: Пользователи
Сообщений: 222
Пол: Мужской
Реальное имя: Andrew

Репутация: -  0  +


ЗА 1 день попытался освоить стек,и написать под него процедуры ,вот что получилось..
Единственное что не могу реализовать это :
Нормальное создание стека ,без "нулевого" элемента.(была проблема с ограничением стека,и последующией проверкой на переполнение,пришлось идти обходными путями)
Добавление сразу нескольких элементов.
Думаю завтра все осилить..или попытатся хотябы.
вот,осудите по все строгости,хочу нормально заботать стеки..
Program stekT;   {Created and Tested By Andrewshkovskii}
uses crt;
type
StekType=integer;
L1 = ^stack;
Stack = record
inf:StekType;
link:l1;
end;
var
top:L1;
m:StekType;
el:StekType;
maxE:integer;
procedure DelFStek(var top:l1); {Удаляет первый элемент стэка,использовать для ввода стека(ввод до элемента 0)}
var
k:l1;
m:StekType;
begin
if top=nil then
writeln('Stek is empty')
else
begin
m:=top^.inf;
k:=top;
Top:=top^.link;
dispose(k);
end;
end;

function EmptyStek(top:l1):boolean; (*проверка на пустоту стэка*)
begin
EmptyStek:=(top=nil);
end;
function StekOver(top:l1;maxe:integer):boolean; (*проверка на переполнение стэка *)
var
j:Integer;
k:l1;
begin
j:=0;
k:=top;
if NOT (EmptyStek (k)) then
while k<>Nil do
begin
j:=j+1;
k:=k^.link;
end;
StekOver:=(j>=maxe);
end;

procedure NewStek(top:l1); (**создание пустого стэка *)
begin
top:=nil;
end;
procedure InputStek(var top:l1;var El:StekType); (*добавление элемента в стек*)
var
k:l1;
i:integer;
begin
new(k);
k^.inf:=El;
if not (StekOver(top,maxe)) then
begin
k^.link:=Top;
Top:=k
end
else
begin
writeln;
writeln('Stek perepolnen!');
end;
end;

procedure BStek(var Top:l1); (*создание стэка с элементами с вводом элементов*)
var
k:l1;
i:integer;
el:StekType;
begin
top:=Nil;
repeat
clrscr;
writeln('Vvedite maks 4islo elementov steka(minimum 2)');
readln(MaxE);
if (MaxE<=0) then
begin
writeln('Vi vveli 0 ili otricatelnoe zna4enie kol-va elementov v steke!');
writeln('Eto ne dopystimo!Povtorite vvod!');
writeln('Press any key...');
readkey;
end;
until MaxE>0;
writeln('Vvedite elementi steka');
Writeln('Koncom vvoda yavlyaetsya element 0');
while el<>0 do
begin
readln(el);
inputstek(top,el);
end;
end;

procedure StekView(var top:l1); (*просмотр стэка*)
var
K:l1;
begin
if Top = nil then
writeln('Stek Pyst dlya prosmotra!')
else
begin
k:=top;
writeln('Elementi steka');
while k<>nil do
begin
writeln(k^.inf);
K:=k^.link;
end;
end;
end;

procedure StekDel(var top:L1); (*Удаление элемента стэка*)
var
k:L1;
i,DelVal,m:integer;
begin
If top = nil then
writeln('Stek Pyst Dlya ydaleniya')
else
begin
repeat
writeln('Skolko elementov ydalit iz STEKA(!!) ?');
readln(DelVal);
if DelVal > MaxE then
begin
writeln('Kol-vo elementov k ydaleniu bolshe kol-va elementov v steke!');
writeln('Povtorite Vvod!');
writeln('Press any key...');
readkey;
end;
until DelVal<MaxE;
for i:=1 to DelVal do
begin
m:=top^.inf;
k:=top;
Top:=Top^.Link;
Dispose(k);
end;
end;
end;


begin
clrscr;
NewStek(top);
BStek(top);
DelFStek(top);
StekView(top);
writeln('Vvedite element dlya dobavleniaya');
readln(el);
InputStek(top,el);
StekView(top);
StekDel(top);
StekView(top);
readkey;
end.


вот..первый опыт
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 

Сообщений в этой теме


 Ответить  Открыть новую тему 
1 чел. читают эту тему (гостей: 1, скрытых пользователей: 0)
Пользователей: 0

 





- Текстовая версия 23.11.2025 3:27
500Gb HDD, 6Gb RAM, 2 Cores, 7 EUR в месяц — такие хостинги правда бывают
Связь с администрацией: bu_gen в домене octagram.name