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

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

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

> Кольцевые Двусвязные Списки
сообщение
Сообщение #1





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

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


ПОМОГИТЕ ПОЖАЛУЙСТА ДОДЕЛАТЬ ПРОГРАММУ.
Вот собственно код :
Program Kursach;
uses
crt;
type
Tinf=integer;
List=^TList;
TList=record
data:TInf;
next : list;
prev : list;
end;

{=====================================Creation of Spisok====================================}
procedure AddElem(var first:List;znach1:TInf);
var
tmp,tmp1:List;
begin
if first=nil then
begin
Getmem(first,SizeOf(TList));
first^.next:=first;
tmp:=first;
end
else
begin
tmp:=first;
while tmp^.next<>first do
tmp:=tmp^.next;
GetMem(tmp1,SizeOf(Tlist));
tmp1^.next:=first;
tmp^.next:=tmp1;
tmp:=tmp1;
end;
tmp^.data:=znach1;
end;

{====================================Printing of Spisok=====================================}
procedure Print(spis1:List);
var
first:List;
begin
if spis1=nil then
begin
writeln('Please add a new element');
exit;
end;
first:=spis1;
Write(spis1^.data, ' ');
spis1:=spis1^.next;
while spis1<>first do
begin
Write(spis1^.data, ' ');
spis1:=spis1^.next;
end;
end;
{==================================Clearing all Spisok======================================}
Procedure FreeStek(spis1:List);
var
tmp,first:List;
begin
if spis1=nil then
exit;
first:=spis1;
tmp:=spis1;
spis1:=spis1^.next;
dispose(tmp);
while spis1<>first do
begin
tmp:=spis1;
spis1:=spis1^.next;
FreeMem(tmp,SizeOf(Tlist));
end;
end;
{===============================================================================
===========}
Procedure DelElem(var spis1:List;tmp:List);
var
tmpi:List;
begin
if tmp=spis1 then
begin
tmpi:=tmp;
while tmpi^.next<>spis1 do
tmpi:=tmpi^.next;
if tmpi=spis1 then
begin
spis1^.next:=nil;
dispose(spis1);
spis1:=nil
end
else
begin
tmpi^.next:=tmp^.next;
spis1:=spis1^.next;
dispose(tmp)
end;
end
else
begin
tmpi:=spis1;
while tmpi^.next<>tmp do
tmpi:=tmpi^.next;
tmpi^.next:=tmp^.next;
dispose(tmp);
end;
end;
{=============================Deleting the element of Spisok===============================}
procedure DelElemZnach(var Spis1:List;znach1:TInf);
var
tmp:List;
begin
tmp:=spis1;


if tmp^.data < 0 then {!!!}
if tmp^.next^.data = tmp^.prev^.data then
begin
DelElem(spis1,tmp);
exit;
end;
tmp:=tmp^.next;
while tmp<>spis1 do
begin


if tmp^.data < 0 then {!!!}
if tmp^.prev^.data = tmp^.next^.data then
begin
DelElem(spis1,tmp);
exit
end;
tmp:=tmp^.next;
end;
end;
{=================================Menu of Program========================================================}
var
SpisNach,
tmpl:List;
znach,a,b:integer;
ch:char;
begin
SpisNach:=nil;
repeat
clrscr;
textcolor(1);
writeln(' ======================================');
writeln(' === ===');
writeln(' === ===');
write(' ===');
TextColor(4);
Write(' WELCOME!!!');
textcolor(1);
writeln(' ===');
writeln(' === ===');
writeln(' === ===');
write(' ===');
TextColor(5);
Write(' "Circle List"');
textcolor(1);
writeln(' ===');
writeln(' === ===');
writeln(' === ===');
writeln(' ======================================');
TextColor(6);
writeln;
writeln;
writeln;
writeln;
Writeln(' Choose the right action :');
TextColor(7);
writeln;
writeln;
Writeln(' 1) Add a new Element .');
writeln;
Writeln(' 2) Show the List .');
writeln;
Writeln(' 3) Delete the Element .');
writeln;
Writeln(' 4) Exit .');
writeln;
ch:=readkey;
case ch of
'1':begin
write('Enter value of new Element : ');
readln(znach);
AddElem(SpisNach,znach);
end;
'2':begin
clrscr;
Print(SpisNach);
readkey;
end;
'3':begin
DelElemZnach(SpisNach);
end;

end;
until ch='4';
freestek(spisnach);
end.



Как вы могли понять программа добавляет новый элемент в кольцевой двусвязный список, выводит на экран список,и чистит его при выходе из программы. еще есть процедура которая удаляет элементы по условию :
1) if tmp^.data < 0 then - то бишь отрицательный элемент списка,
а должно быть два условия :
1)...
2) if tmp^.prev^.data = tmp^.next^.data then - отрицательный элемент который находить между двумя одинаковыми (1 -2 1 - удалить -2).

только вот дело в том что программа ,если только с первым условием , удаляет все отрицательные элементы, а если с двумя условиями то просто не удаляет ни чего.

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

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


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

 





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