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

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

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

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


Новичок
*

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

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


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

Вот что собственно есть:
Код
uses crt;
type
    pnode=^node;
    node=record
            data:integer;
            next:pnode;
    end;
Procedure Init(var p,u:pnode); {создание главного списка}
          var
             i:integer;
          begin
               new(u);
               u^.next:=nil;
               p:=u;
               Write('Spisok:');
               for i:=1 to 15 do
                   begin
                        new(p^.next);
                        p:=p^.next;
                        p^.next:=nil;
                        p^.data:=random(30)-5;
                   end;
          end;
Procedure Out(p,u:pnode);              {Вывод}
          begin
               p:=u^.next;
               while p<>nil do
                      begin
                           write(p^.data:4);
                           p:=p^.next;
                      end;
               writeln;
          end;
var
   p,u:pnode;
begin
     clrscr;
     Init(p,u);
     Out(p,u);
     readkey;
end.


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


Гость






Только процедуры Init для решения задачи недостаточно... Тебе как минимум еще понадобится процедура AddItem, которая добавляет один элемент в "хвост" списка (такие процедуры уже выкладывались, см. в Поиске про списки).

А потом - создаешь 2 новых списка (first и second), и пробегаешь по всему изначальному списку:

pt := p; { <--- Чтобы не потерять указатель P, вдруг еще понадобится }
while pt <> nil do begin
if pt^.data >= 0 then AddItem(first, pt^.data)
else AddItem(second, pt^.data);

pt := pt^.next
end;
 К началу страницы 
+ Ответить 
сообщение
Сообщение #3


Новичок
*

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

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


Проблема, не могу понять как делать.
Процедура add выглядит у меня так:
Код
Procedure Add(var p:pnode; k:integer);
          begin
               new(p^.next);
               p:=p^.next;
               p^.next:=nil;
               p^.data:=k;
          end;

остальное :
Код
Procedure Spisok1{(var u:pnode)};{с ним проблема, может неправильно сделал}
var p1:pnode;
          begin
               write('Spisok1:');
               new(u);
               u^.next:=nil;
               p1:=u;
               new(p1^.next);
               p1:=p1^.next;
               p1^.next:=nil;
               p1^.data:=?; {что тут поставить?}
          end;
Procedure Sort(var u:pnode); {собственно процедура распределения}
          begin
               while u<>nil do begin
                     if u^.data>=0 then add(spisok1,u^.data); u:=u^.next;end; {пытаюсь вставить хотя б в один список - не получается, пишет ошибку}
          end;

Видимо часть кода у меня бред, что исправить?
P.S. раньше со списками вообще не работал, это моя первая задача.

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


Гость






Смотри, что делаем:

uses crt;
type
pnode = ^node;
node = record
data: integer;
next: pnode;
end;

{ 1. добавляем элемент в конец списка }
procedure Add(var p: pnode; k: integer);
var pp, new_p: pnode;
begin
{ работаем с копией указателя, чтоб не испортить }
pp := p;
{ пробегаем по списку до тех пор, пока pp^.next ненулевое - т.о. ищем последний элемент }
while (pp <> nil) and (pp^.next <> nil) do begin
pp := pp^.next;
end;

{ новый элемент и его заполнение }
new(new_p);
new_p^.next := nil;
new_p^.data := k;

{
pp = nil может быть только, если p = nil. Тогда просто возвращаем новый элемент,
иначе - добавляем (поле next последнего элемента теперь указывает на новый)
}
if pp = nil then p := new_p
else pp^.next := new_p;
end;

{ 2. Инициализация исходного списка }
procedure Init(var p: pnode);
var
i: integer;
begin
{
без всяких выкрутасов - просто добавляем 15 новых значений.
Add сама разберется, какое первое, а какое- последующее
}
p := nil;
for i := 1 to 15 do
Add(p, integer(Random(30) - 10));
end;

{ 3. Печать списка - тут все просто }
Procedure Print(p: pnode);
begin
while p <> nil do begin
write(p^.data:4);
p:=p^.next;
end;
writeln;
end;

var
p, first, second: pnode;
pp: pnode;
begin
clrscr;
randomize;
Init(p);
Print(p);

{
Ну, а это - собственно - решение задачи:
раскидываем положительные и отрицательные по разным спискам
}
first := nil; second := nil;

pp := p;
while pp <> nil do begin
if pp^.data >= 0 then Add(first, pp^.data)
else Add(second, pp^.data);

pp := pp^.next;
end;
Print(first);
Print(second);

readkey;
end.

Не забывай по окончании работы удалить теперь уже все 3 списка...
 К началу страницы 
+ Ответить 
сообщение
Сообщение #5


Новичок
*

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

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


Огромное спасибо! Теперь работа со списками стала более-менее понятна.
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 

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

 





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