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 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #2


Гость






Только вот дело-то в том, что когда отработает первое условие, второе уже НИКОГДА не выполнится. Согласись, сложно найти отрицательный элемент, окруженный двумя одинаковыми, после того, как удалил все отрицательные... Что-то не то с условиями. Пока не внесешь ясность - даже программу смотреть не хочется, потому как не знаешь, что в результате-то требуется.

На данный момент совет один - убрать вообще второе условие. Оно лишнее.
 К началу страницы 
+ Ответить 
сообщение
Сообщение #3





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

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


суть в том что бы удалить за раз все отрицательные элементы которые находяться между одинаковыми :
1 , 2 , -3 , 2 , 4 , 5 , 4 , 6 , -7 , 6 --------- 1 , 2 , 2 , 4 , 5 , 4 , 6 , 6
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #4


Гость






Так вот ты для начала список правильно создай (у тебя ж заполняются только указатели next, а prev-ы остаются нетронутыми, потом, при попытке обращения к ним, будут проблемы в виде неправильной работы на старых компиляторах и вылета программы на новых).

Когда исправишь создание списка (как - можно посмотреть на этом форуме, здесь была Everveit, которая задавала несколько вопросов по двухсвязным кольцевым спискам, и получила на них ответы; можно - начертить список на бумаге, и разобраться, как меняются все указатели при добавлении нового элемента. Это - предпочтительный вариант), тогда вот такая процедура будет работать:

function RemoveItem(var first: List; p: List): List;
begin
if first^.next = first then
begin
FreeMem(first, SizeOf(Tlist));
first := nil; RemoveItem := nil; exit;
end;

RemoveItem := p^.next;

p^.prev^.next := p^.next;
p^.next^.prev := p^.prev;
if p = first then first := p^.next;
FreeMem(p, SizeOf(Tlist));
p := nil;
end;


procedure Process(var first: List);
var p: List;
begin
if first = nil then Writeln('<empty>')
else begin
p := first;
repeat
if (p^.data < 0) and (p^.next^.data = p^.prev^.data) then
begin
p := RemoveItem(first, p);
end
else p := p^.next;
until p = first;
end;
end;


Кстати, печать списка можно сделать гораздо красивее:
procedure Print(first: List);
var p: List;
begin
if first = nil then Writeln('<empty>')
else begin
p := first;
repeat
write(p^.data:4); p := p^.next;
until p = first;
end;
writeln;
end;
Заметь, никаких отдельных печатаний первого элемента. Он - такой же, как и все остальные, и незачем его выделять, и работать с ним по-другому
 К началу страницы 
+ Ответить 
сообщение
Сообщение #5





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

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


уважаемый volvo, спасибо большое за совет, я разобрался и в итоге написал новую процедуру для создания списка и теперь функция для удаления элемента ,которую написали вы, и она работает - УРА!
но я все же что то напутал в создании списка, почему то постоянно первый элемент списка всегда присваевает ноль и я чет не могу сообразить почему, вот так выглядит процедура :

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:=tmp^.next;
tmp1^.prev:=tmp;
tmp1^.next^.prev := tmp1;
tmp^.next:= tmp1;
tmp1^.data:=znach1;
end;
end;


не могли бы вы глянуть что я не так написал?
спасибо

Добавлено через 4 мин.
я на всякий пожарный еще прикрепил всю программу

Сообщение отредактировано: ikorstenxl -


Прикрепленные файлы
Прикрепленный файл  KURSOVAY.PAS ( 4.72 килобайт ) Кол-во скачиваний: 284
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #6


Гость






Вот именно потому, что ты не работаешь с полем Prev (ну объясни мне, зачем бежать по всему списку от First вперед, если можно одним движением назад получить тот же указатель?), оно и заполняется некорректно. Смотри:

procedure AddElem(var first: List; value: TInf);
var p: List;
begin
Getmem(p, SizeOf(TList)); { <--- Это делается ВСЕГДА, вот и делаем это снаружи от If }
p^.data := value;

if first = nil then begin
{
Первый элемент списка? Указываем "вперед" и "назад" на самого себя и
запоминаем только что созданный элемент как первый
}
p^.next := p;
p^.prev := p;
first := p;
end
else begin
{
Ах, уже не первый? Тогда действовать надо по-другому:
1) поскольку добавляем в "конец" списка (перед элементом first), то
новый элемент next-ом указывает на "голову" списка, а prev-ом - туда,
куда раньше указывал prev "головы"

2) не забываем и про "бывший последний" элемент. (first^.prev который).
Его поле next должно указывать куда? Правильно, на добавляемый элемент,
иначе связи порушатся и при обходе списка будет бред.

3) ну, и про то, что "голова" списка должна теперь указывать prev-ом на новый
элемент, он ведь находится в списке ПЕРЕД "головой" - тоже не забываем...
}
p^.next := first;
p^.prev := first^.prev;
first^.prev^.next := p;
first^.prev := p;
end;

end;

Еще раз: берешь несколько листов бумаги и карандаш, чертишь на них списки и меняешь связи, пока не поймешь и не будет от зубов отлетать, что и как и почему именно в этом порядке (сменишь порядок пунктов 1, 2, 3 - будут проблемы)... Иначе так и будешь путаться в кольцевых списках.
 К началу страницы 
+ Ответить 
сообщение
Сообщение #7





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

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


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

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

 





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