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

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

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

 
 Ответить  Открыть новую тему 
> Задача на двумерный список
сообщение
Сообщение #1


Новичок
*

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

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


Задача. используя динамические списки, найти в массиве последнию группу положительных элементов, и удалить её.
Проблема: не могу установить указатели конца(вроде установил) и начала последней группы положительных элементов.
Если есть другие предложения по алгоритму, просьба высказать.
Вот набросал за сегодня :

program labа;
uses
crt;
type
ukaz=^mas;
mas=record
chisl:integer;
next:ukaz;
pred:ukaz;
end;
Var
first, tek, tmp, last,listkon,listnach: ukaz;
i,j,n,nach,konec,temp:integer;
{----------------------------------------------------------------------------}
procedure CreateSpisok(n:integer);
Begin
write('Vvedite koli4estvo 4isel massiva->');
readln(n);
new(first);
first^.pred:=nil;
first^.chisl:=random(200)-50;
tek:=first;
for i:=1 to n do
begin
new(tek^.next);
tek^.next^.chisl:=random(200)-50;
tek^.next^.pred:=tek;
write(tek^.chisl:5);
tek:=tek^.next;
end;
tek^.next:=nil;
writeln;
end;
{----------------------------------------------------------------------------}
Function SearchLastPolGroup: ukaz;
var
Pol:ukaz;
begin
Pol:=first;
while (pol^.chisl<=0) and (pol^.next<>nil) do
pol:=pol^.next;
if pol^.chisl>0 then
SearchLastPolGroup:=pol
else
SearchLastPolGroup:=nil;
end;
{----------------------------------------------------------------------------}
Procedure DisposeRec;
var
temp:ukaz;
begin
tek:=first;
repeat
temp:=tek^.next;
tek:=temp;
until tek=nil;

end;
{----------------------------------------------------------------------------}
BEGIN
randomize;
clrscr;
writeln;
writeln('Programma formiruet dinamy spisok, i perenosit ponextniy gruppu pol elementov');
writeln('v nachalo spiske dinam, i zamenaet ego nylami, gruppa eto elementi > 2 shtuk'); writeln;
textcolor(red);
writeln('Svobodnaja pamjat do nachala ',memavail,' kb');
writeln;
CreateSpisok(n);
tek:=first;
i:=1;
while tek^.next<>nil do
begin
if tek^.chisl>0 then
begin
temp:=temp+1;
if temp>=2 then
begin
nach:=i-temp+1;
konec:=i;
listkon:=tek;
end;
end
else
temp:=0;
tek:=tek^.next;
i:=i+1;
end;
{----------------------------------------------------------------------------}
textcolor(blue);
writeln;
writeln('nachalo last pol. group-->',nach:3,' konecec last pol.group-->', konec:3);
writeln('idet perestanovka i obnulenie last pol. group, najmite Enter');
readln;
tek:=first;

for i:=1 to konec-1 do
tek:=tek^.next;
dispose(tek);
for i:=konec downto nach do
begin
temp:=tek^.chisl;
tmp:=tek;
for j:=konec-1 downto 1 do
begin
tmp^.chisl:=tmp^.pred^.chisl;
tmp:=tmp^.pred;
end;
first^.chisl:=temp;
end;
{----------------------------------------------------------------------------}

listnach:=first;tek:=listnach;
repeat
tmp:=tek^.next;
dispose(tek);
tek:=tmp;
until tek=listkon;
{----------}
writeln;
textcolor(lightblue);
tek:=first;
if SearchLastPolGroup<>nil then
while tek^.next<>nil do
begin
write(tek^.chisl:5);
tek:=tek^.next;
end
else
writeln('pol. grup elementov net');
writeln;
writeln;
writeln('Svobodnaja pamjat v processe ',memavail,' kb');
readln;
DisposeRec;
textcolor(green);
writeln;
writeln('Svobodnaja pamjat posle o4ustku ',memavail,' kb');
readln;
end.

 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #2


Гость






Чтоб найти последний положительный элемент (ведь именно он будет являться концом последней группы, правда?) достаточно пробежать от конца списка назад до тех пор, пока не встретишь положительный элемент или NIL (если NIL - значит выходим из программы, положительных элементов нет)...

А чтоб найти начало этой же группы - от только что найденного указателя (если он ненулевой) - опять же назад, пока элементы положительны (если в результате получишь NIL, значит, начинать удаление с самого начала)... Вот и все...
 К началу страницы 
+ Ответить 
сообщение
Сообщение #3


Новичок
*

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

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


Вопрос решён, пришлось ввести ещё пару указателей,и рассматривать 4 условия нахождения положительной группы в списке.
Спасибо.
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #4


Гость






Цитата
пришлось ввести ещё пару указателей
no1.gif Если задача только в том, что написано в первом посте, то надо не добавлять указатели, а убирать почти все... Ты ж тут столько лишнего делаешь...
 К началу страницы 
+ Ответить 
сообщение
Сообщение #5


Новичок
*

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

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


Нашёлся баг

Если список состоит из элементов типа этих
-+++--+-+++-+
то программа просто зависала.



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


program laba;
uses
crt;
type
ukaz=^mas;
mas=record
chisl:integer;
next:ukaz;
pred:ukaz;
end;
Var
first, listkon , tek, tmp, listnach, last: ukaz;
i,j,n,nach,konec,temp:integer;
{----------------------------------------------------------------------------}
procedure CreateSpisok(n:integer);
Begin
write('Vvedite koli4estvo 4isel massiva, bolse 4->');
readln(n);
new(first);
first^.pred:=nil;
first^.chisl:=random(200)-100;
tek:=first;
for i:=1 to n do
begin
new(tek^.next);
tek^.next^.chisl:=random(200)-100;
tek^.next^.pred:=tek;
write(tek^.chisl:5);
tek:=tek^.next;
end;
tek^.next:=nil;
last:=tek^.pred;
end;
{----------------------------------------------------------------------------}
Function SearchPol: ukaz;
var
Pol:ukaz;
begin
Pol:=first;
while (pol^.chisl<=0) and (pol^.next<>nil) do
pol:=pol^.next;
if pol^.chisl>0 then
searchPol:=pol
else
searchPol:=nil;
end;
{----------------------------------------------------------------------------}
Procedure DisposeRec;
var
temp:ukaz;
begin
tek:=first;
repeat
temp:=tek^.next;
dispose(tek);
tek:=temp;
until tek=nil;

end;
{----------------------------------------------------------------------------}
BEGIN
randomize;
clrscr;
writeln;
writeln('Programma formiruet dinamy spisok, i ydaliet posledniy gruppu pol elementov');
writeln;
textcolor(red);
writeln('Svobodnaja pamjat do nachala ',memavail,' kb');
writeln;
CreateSpisok(n);

tek:=last;
tek^.next:=nil;
while tek^.pred<>nil do
begin
if tek^.chisl>0 then
begin
temp:=temp+1;
if temp=1 then
begin
listkon:=tek;
if listkon=last then listkon:=last;
end
else
begin
if temp>=2 then
begin
repeat
tek:=tek^.pred;
until (tek^.pred^.chisl<0);
listnach:=tek;
break;
end;
end;
end
else
temp:=0;
tek:=tek^.pred;

end;
{----------------------------------------------------------------------------}
writeln; writeln;
writeln('last', last^.chisl);
writeln('first',first^.chisl );
writeln('listnach',listnach^.chisl);
writeln('listkon',listkon^.chisl);
textcolor(blue);
writeln;
writeln('idet udalenie last pol. group, najmite Enter');
readln;
if listkon=last then {esli posled v konce }
while listkon^.chisl>0 do
begin
listkon:=listkon^.pred;
dispose(listkon^.next);
listkon^.next:=nil;
last:=listkon;
end;
if (listnach<>first) and (listkon<>last) then
while listnach^.chisl>0 do {esli posled v seredine}
begin
tmp:=listnach;
listnach^.pred^.next:=listnach^.next;
listnach^.next^.pred:=listnach^.pred;
listnach:=listnach^.next;
dispose(tmp);
end;

if listnach=first then {esli posled v nach }
while listnach^.chisl>0 do
begin
listnach:=listnach^.next;
dispose(listnach^.pred);
listnach^.pred:=nil
end;

{----------------------------------------------------------------------------}

writeln; writeln;
writeln('last', last^.chisl);
writeln('first',first^.chisl );
writeln('listnach',listnach^.chisl);
writeln('listkon',listkon^.chisl);

writeln;
textcolor(lightblue);
tek:=first;
if SearchPol<>nil then
while (tek^.next<>nil) do
begin
write(tek^.chisl:5);
tek:=tek^.next;
end
else
writeln('pol. grup elementov net');
write(last^.chisl:5);
writeln; writeln;
writeln('Svobodnaja pamjat v processe ',memavail,' kb');
readln;
DisposeRec;
textcolor(green);
writeln;
writeln('Svobodnaja pamjat posle o4ustku ',memavail,' kb');
readln;
end.



Проблема: теперь если список вида -++-+-++-, то конец последовательности находит правильно, а начало, нет. Оно выделено жирным.


2volvo: а как это без указателей начала и конца последовательности?

Сообщение отредактировано: habi -
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #6


Гость






Значит, смотри, вот твое задание, но без украшательств:

type
ukaz = ^mas;
mas = record
chisl:integer;
next, pred: ukaz;
end;

procedure create_list(var first, last: ukaz);
var
i, n: integer;
p: ukaz;
begin
write('n = '); readln(n);

first := nil; last := nil;
for i := 1 to n do begin
new(p);
p^.chisl := random(200) - 100;;
p^.next := nil;
p^.pred := last;

if first = nil then first := p
else last^.next := p;

last := p;
end;

end;

procedure delete_list(var start: ukaz);
var T: ukaz;
begin
while start <> nil do begin
T := start;
start := start^.next;
dispose(T);
end;
start := nil;
end;

procedure print(start: ukaz);
begin
while start <> nil do begin
write(start^.chisl:4);
start := start^.next;
end;
writeln;
end;

function has_pred(p: ukaz): boolean;
begin
has_pred := (p <> nil) and (p^.pred <> nil);
end;
function has_next(p: ukaz): boolean;
begin
has_next := (p <> nil) and (p^.next <> nil);
end;

var
start, finish: ukaz;
beg_delete, end_delete, T: ukaz;

begin
create_list(start, finish);
print(start);
{ До этого момента все должно быть ясно - создали список, напечатали... }

{ теперь начинается сам алгоритм: }

{ сначала ищем конец положит. последовательности: от хвоста списка... }
end_delete := finish;
{ ... идем к началу до тех пор, пока не дойдем до nil или не будет найден НЕотриц. элемент }
while (end_delete <> nil) and (end_delete^.chisl < 0) do
end_delete := end_delete^.pred;

{ смотрим, что получилось: если NIL, значит нет полож. элементов, выходим }
if end_delete = nil then writeln('nothing to delete')
else begin
{ а вот раз мы тут, значит, полож. элементы есть. Ищем начало этой последовательности }

{ начинаем от предыд. элемента }
beg_delete := end_delete;
{ пока есть пред. элемент и он положительный ... }
while has_pred(beg_delete) and (beg_delete^.pred^.chisl > 0) do
beg_delete := beg_delete^.pred; { ... продвигаемся назад... }

{ продвижение закончено... Что имеем? }

{
Если мы добрались до элемента, у которого нет предыдущего -
значит это START - начало списка
}
if beg_delete^.pred = nil then begin
beg_delete := start; { <--- это можно бы и не делать, только для иллюстрации, мы и так здесь }
start := end_delete^.next; { Новое начало списка будет ПОСЛЕ end_begin, все остальное удалится }
end;

{ если у начала найденной последовательности есть пред. элемент, это не самое начало списка }
if has_pred(beg_delete) then
beg_delete^.pred^.next := end_delete^.next; { тогда связываем НЕудаляемое начало с концом ... }
if has_next(end_delete) then
end_delete^.next^.pred := beg_delete^.pred; { ... и конец - с началом }

{
а вот теперь окончательно разделяем 2 списка: за посл. удаляемым элементом ставим NIL
и получаем 2 независимых списка: тот который надо удалить - начинается в BEG_DELETE, и
тот, который остатся - начинается (как и прежде) в START...
}
if end_delete <> nil then
end_delete^.next := nil;

delete_list(beg_delete); { удаляем ненужное }
print(start); { печатаем что осталось }
end;

delete_list(start); { и освобождаем память... }
end.
Разберись с тем, как оно работает, прежде чем навешивать "рюшечки", иначе потом опять будет сложнее разобраться...
 К началу страницы 
+ Ответить 
сообщение
Сообщение #7


Новичок
*

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

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


Спасибо.Разберусь, но если рюшечки это вывод значений листкон и листнач и фёрст и ласт, то это для отладки =)
А цвета + кол-во памяти , это всё входит в задание.

Сообщение отредактировано: habi -
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #8


Новичок
*

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

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


Не смог разобраться, как сделать проверку на кол-во элементов в твоём коде.
Группа>2 элементов..


{ ... идем к началу до тех пор, пока не дойдем до nil или не будет найден НЕотриц. элемент, и пока пред. элемент
конца последовательности не будет положительным }
while (end_delete <> nil) and (end_delete^.chisl < 0) and (end_delete^.pred^.chisl > 0) do
end_delete := end_delete^.pred;


Сделал такую проверку, но всё равно что-то не то.

Потом сделал, проверку, не одинаково ли начало и конец. Если он одинаков, то выполняем дальше передвижения..


while (beg_delete=end_delete) and has_pred(beg_delete) and (beg_delete^.pred^.chisl > 0) do

beg_delete := beg_delete^.pred;




Сообщение отредактировано: habi -
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #9


Гость






Ну вот расскажи мне, я тебе код привел для чего? Для того, чтоб ты его перековырял, понаписал тут всякого бреда, и потом сказал, что он не работает (пока все идет именно к этому), или чтоб ты РАЗОБРАЛСЯ, как работает МОЙ код?

Цитата
Не смог разобраться, как сделать проверку на кол-во элементов в твоём коде.
Не имею понятия, ЗАЧЕМ... В условии об этом нет ни слова...
Цитата
Потом сделал, проверку, не одинаково ли начало и конец.
Как сделал, так и убери, ты не имеешь права сравнивать указатели друг с другом, это некорректно... Сравнивать указатели можно только с NIL.

А теперь контрольный вопрос: что не так в коде из поста №6? На каких комбинациях он неправильно работает (меня, заметь, не интересует то, что ты добавил от себя, я говорю о задании, озвученном в первом посте)?
 К началу страницы 
+ Ответить 
сообщение
Сообщение #10


Новичок
*

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

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


Спасибо за разъяснение по показателям.
Я разобрался, как работает твой код, в пошаговом режиме.

В твоём коде некорректно работают комбинации типа, 1 -21 -3 31 32 -2 2
удаляет 2.
Извиняюсь, Я забыл указать, что группа которую надо удалить, это больше 2 положительных элементов.

Реализуй пожалуйста проверку на то является ли положительный элемент end_delete^.chisl группой =) т.е. имеется ли рядом с ним ещё один положительный элемент..

Сообщение отредактировано: habi -
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #11


Новичок
*

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

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


Всё-таки я не могу в этом коде выделить группу.

Всё сделал.

Сообщение отредактировано: habi -
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #12


Новичок
*

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

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


Только сейчас заметил мелкий баг =(

Программа удаляет последнию группу(больше 2 элементов) положительных элементов, помогите найти утечку памяти в 16 кб.
Ну или преобразовать программу volvo, чтобы она искала группу, а не последний положительный элемент..=(

program labA;
uses crt;
type
ukaz=^mas;
mas=record
chisl:integer;
next:ukaz;
pred:ukaz;
end;
Var
first, listkon , tek, tmp, listnach, last: ukaz;
i,j,n,nach,konec,temp:integer;
{----------------------------------------------------------------------------}
procedure CreateSpisok(n:integer);
Begin
write('Vvedite koli4estvo 4isel massiva -->');
readln(n);
new(first);
first^.pred:=nil;
first^.chisl:=random(200)-100;
tek:=first;
for i:=1 to n do
begin
new(tek^.next);
tek^.next^.chisl:=random(200)-100;
tek^.next^.pred:=tek;
write(tek^.chisl:5);
tek:=tek^.next;
end;
tek^.next:=nil;
last:=tek^.pred;
last^.next:=nil;
end;
{----------------------------------------------------------------------------}
Function SearchPol: ukaz;
var
Pol:ukaz;
begin
Pol:=first;
while (pol^.chisl<=0) and (pol^.next<>nil) do
pol:=pol^.next;
if pol^.chisl>0 then
searchPol:=pol
else
searchPol:=nil;
end;
{----------------------------------------------------------------------------}
Procedure DisposeRec;
var
temp:ukaz;
begin
tek:=first;
repeat
temp:=tek^.next;
dispose(tek);
tek:=temp;
until tek=nil;

end;
{----------------------------------------------------------------------------}
begin
randomize;
clrscr;
writeln;
writeln('Programma formiruet dinamy spisok, i ydaliet posledniy gruppu pol elementov');
writeln;
textcolor(red);
writeln('Svobodnaja do nachala ',memavail,' kb');
CreateSpisok(n);
writeln;

listnach:=nil;
listkon:=nil;
tek:=last;
tek^.next:=nil;
while (tek^.pred<>nil) do
begin
if (tek^.chisl>0) and (tek^.pred^.chisl>0) then
begin
temp:=temp+1;
listkon:=tek;
repeat
tek:=tek^.pred;
until (tek^.pred^.chisl<0);
listnach:=tek;
break;
end
else
temp:=0;
tek:=tek^.pred;
end;
writeln;
writeln('Svobodnaja pamjat posla nahojd listnach listkon ',memavail,' kb');
writeln(listnach^.chisl,' <=ListNach ',listkon^.chisl,' <=ListKon') ;

{----------------------------------------------------------------------------}
writeln; writeln;
textcolor(blue);
writeln;
writeln('idet udalenie last pol. group, najmite Enter');
readln;
if listkon=last then {esli posled v konce }
while listkon^.chisl>0 do
begin
listkon:=listkon^.pred;
dispose(listkon^.next);
listkon^.next:=nil;
last:=listkon;
end;
if (listnach<>first) and (listkon<>last) then
while listnach^.chisl>0 do {esli posled v seredine}
begin
tmp:=listnach;
listnach^.pred^.next:=listnach^.next;
listnach^.next^.pred:=listnach^.pred;
listnach:=listnach^.next;
dispose(tmp);
end;

if listnach=first then {esli posled v nach }
while listnach^.chisl>0 do
begin
listnach:=listnach^.next;
dispose(listnach^.pred);
listnach^.pred:=nil;
listnach:=first;
end;

{----------------------------------------------------------------------------}

writeln;
textcolor(lightblue);
tek:=first;
if SearchPol<>nil then
while (tek^.next<>nil) do
begin
write(tek^.chisl:5);
tek:=tek^.next;
end
else
writeln('pol. grup elementov net');
write(last^.chisl:5);
writeln; writeln;
writeln('Svobodnaja pamjat v processe ',memavail,' kb');
readln;
DisposeRec;
textcolor(green);
writeln;
writeln('Svobodnaja pamjat posle o4ustku ',memavail,' kb');
readln;
end.



Сообщение отредактировано: habi -
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #13


Гость






Цитата
Ну или преобразовать программу volvo, чтобы она искала группу, а не последний положительный элемент..=(
А сейчас я сделаю нечто такое, чего от меня вряд ли кто-то ждет wink.gif

Смотри:
var
start, finish: ukaz;
beg_delete, end_delete, T: ukaz;
count: integer;

label
another_one; { <--- Вот это добавляется !!! }

begin
create_list(start, finish);
print(start);

end_delete := finish;

another_one:; { <--- Не забываем !!! }

while (end_delete <> nil) and (end_delete^.chisl < 0) do
end_delete := end_delete^.pred;

if end_delete = nil then writeln('nothing to delete')
else begin
beg_delete := end_delete;

count := 0; { Вот он, счетчик... }
while has_pred(beg_delete) and (beg_delete^.pred^.chisl > 0) do begin
beg_delete := beg_delete^.pred;
inc(count); { Увеличиваем его... }
end;

{
Что же мы ТЕПЕРЬ имеем?
Прежде всего - проверяем счетчик. Если он меньше нужного значения,
то нужно искать все заново, так?
}
if count < 2 then begin
end_delete := beg_delete^.pred; { <--- будем начинать смотреть с элемента, который перед beg_delete }
goto another_one; { <--- !!! А вот это как раз то, чего мало кто ожидает, однако здесь оно оправдано }
end;

{ Ну, а если со счетчиком все в порядке - то продолжаем, как ни в чем ни бывало }
if beg_delete^.pred = nil then begin
beg_delete := start;
start := end_delete^.next;
end;

if has_pred(beg_delete) then
beg_delete^.pred^.next := end_delete^.next;
if has_next(end_delete) then
end_delete^.next^.pred := beg_delete^.pred;

if end_delete <> nil then
end_delete^.next := nil;

delete_list(beg_delete);
print(start);
end;

delete_list(start);
end.


Комментарии были выше, так что я их убрал... К добавленному коду есть пояснение... Тестовый прогон:
   1  -2   3   4   5  -6   7  -8  -9  10
1 -2 -6 7 -8 -9 10
Теперь правильно, или опять что-то не то?
 К началу страницы 
+ Ответить 
сообщение
Сообщение #14


Новичок
*

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

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


Спасибо, ты правильно понял мысль.
Но наш препод против лейблов =)
я в курсовой их уже убрал =(
Сейчас попробую переписать конструкцию через вайл..

п.с. кто модифицировал блок код? я копировать не могу...видел на сайте схоже тематики такую фишку, но над кодом было 2 ссылки, копировать в буфер и распечатать

Сообщение отредактировано: habi -
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #15


Гость






Ну, тогда извращайся другими методами... Я ж не предлагаю тебе Label для организации простого цикла, правда? То, что я написал позволяет убрать сложную конструкцию из If-ов и Repeat/Until-ов, заменив ее одним Goto, в этом случае переход по метке вполне оправдан... Хотя можно попробовать сделать и без метки...

Сообщение отредактировано: volvo -
 К началу страницы 
+ Ответить 
сообщение
Сообщение #16


Новичок
*

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

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


Согласен с тобой, но наш преподователь категорически против лейблов, если есть желание могу показать блоксхему одной процедуры =) там этих вайлов и репит антилов..

п.с. как засечь время выполнения программы?

Сообщение отредактировано: habi -
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #17


Гость






Цитата
наш преподователь категорически против лейблов
Извращенец...

Держи:
var
start, finish: ukaz;
beg_delete, end_delete, T: ukaz;
count: integer;
b_finish: boolean;

begin
create_list(start, finish);
print(start);

end_delete := finish;
repeat
b_finish := true;

while (end_delete <> nil) and (end_delete^.chisl < 0) do
end_delete := end_delete^.pred;

if end_delete = nil then writeln('nothing to delete')
else begin
beg_delete := end_delete;

count := 0;
while has_pred(beg_delete) and (beg_delete^.pred^.chisl > 0) do begin
beg_delete := beg_delete^.pred;
inc(count);
end;

if count >= 2 then begin { Меняем знак !!! }

if beg_delete^.pred = nil then begin
beg_delete := start;
start := end_delete^.next;
end;

if has_pred(beg_delete) then
beg_delete^.pred^.next := end_delete^.next;
if has_next(end_delete) then
end_delete^.next^.pred := beg_delete^.pred;

if end_delete <> nil then
end_delete^.next := nil;

delete_list(beg_delete);
print(start);

end
else begin
end_delete := beg_delete^.pred;
b_finish := false; { Остаемся в цикле Repeat/Until }
end;
end;
until b_finish;

delete_list(start);
end.


Цитата
как засечь время выполнения программы?

Как замерить время выполнения программы?
 К началу страницы 
+ Ответить 
сообщение
Сообщение #18


Новичок
*

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

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


Что в версии с лейблами, что с ввайлами....то имеет баг =)

-1 -9 8 -1 9 8 7 -1 8 9
удаляет на 8 9, а 9 8 7, т.е. максимальную последовательность =)

Противореча всякой логике...

Сообщение отредактировано: habi -
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #19


Гость






Ну, блин... Присвой изначально Count := 1, а не 0...

   1  -2   3   4   5  -6   7  -8   9  10
1 -2 3 4 5 -6 7 -8

   1  -2   3   4   5  -6   7   8  -9  10
1 -2 3 4 5 -6 -9 10
 К началу страницы 
+ Ответить 
сообщение
Сообщение #20


Новичок
*

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

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


ух как всё просто)
а я отлаживал + два условия написал которые работали, только если послед не в конце, спасибо =)
надеюсь больше ничего не найду.

Для работоспособности добавим проверку на последнее число, от него зависит параметр каунт..
if ( finish^.chisl > 0 ) then count:=1 else count:=0;


Сообщение отредактировано: habi -
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 

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

 





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