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

Сообщений в этой теме
habi   Задача на двумерный список   12.05.2008 23:51
volvo   Чтоб найти последний положительный элемент (ведь и…   13.05.2008 0:31
habi   Вопрос решён, пришлось ввести ещё пару указателей,…   14.05.2008 3:10
volvo   :no1: Если задача только в том, что написано в пе…   14.05.2008 3:33
habi   Нашёлся баг Если список состоит из элементов типа…   18.05.2008 16:17
volvo   Значит, смотри, вот твое задание, но без украшател…   18.05.2008 18:04
habi   Спасибо.Разберусь, но если рюшечки это вывод значе…   18.05.2008 18:14
habi   Не смог разобраться, как сделать проверку на кол-в…   18.05.2008 20:44
volvo   Ну вот расскажи мне, я тебе код привел для чего? Д…   18.05.2008 21:18
habi   Спасибо за разъяснение по показателям. Я разобралс…   18.05.2008 21:30
habi   Всё-таки я не могу в этом коде выделить группу. В…   19.05.2008 0:28
habi   Только сейчас заметил мелкий баг =( Программа уда…   20.05.2008 20:58
volvo   А сейчас я сделаю нечто такое, чего от меня вряд л…   20.05.2008 21:29
habi   Спасибо, ты правильно понял мысль. Но наш препод п…   20.05.2008 21:35
volvo   Ну, тогда извращайся другими методами... Я ж не пр…   20.05.2008 21:39
habi   Согласен с тобой, но наш преподователь категоричес…   20.05.2008 21:42
volvo   Извращенец... Держи: var start, finish: ukaz; …   20.05.2008 21:53
habi   Что в версии с лейблами, что с ввайлами....то имее…   21.05.2008 0:14
volvo   Ну, блин... Присвой изначально Count := 1, а не 0.…   21.05.2008 0:23
habi   ух как всё просто) а я отлаживал + два условия нап…   21.05.2008 0:32


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

 





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