Версия для печати темы

Нажмите сюда для просмотра этой темы в обычном формате

Форум «Всё о Паскале» _ Задачи _ Линейный двунаправленный список

Автор: daZe1 5.01.2008 6:48

Задача такова:
задан массив из 40 случайных элементов, переписать из массива в линейный двунаправленный список чётные элементы массива, добавить в начало списка среднее арифметическое элементов списка и в конец добавить среднее геометрическое элементов списка.

В принципе решить я ее смог...

Program list;
uses crt;

type
TPList= ^TList;

TList= record
Data: real;
Next: TPList;
Prev: TPList;
end;

const
n=40; {эт так, чтоб проверять легче было ))}

var
Head, Curr, PrevEl: TPList;
i, kol: byte;
SrAr, SrGeom, sum, prod: real;
ElArr: array [1..n] of real;


procedure Add_el; {добавляет очередную запись в список}
begin
if i=2 then
begin
new(Head);
Head^.Data:= ElArr[i];
PrevEl:=Head;
end
else
begin
new(Curr);
Curr^.Data:=ElArr[i];
Curr^.Prev:=PrevEl;
PrevEl^.Next:=Curr;
PrevEl:=Curr;
end;
end;

procedure Add_SrAr; {добавляет в начало среднее арифметическое}
begin
new(Curr);
Curr^.Data:=SrAr;
Curr^.Next:=Head;
Head^.Prev:=Curr;
Head:=Curr;
end;

procedure Add_SrGeom; {и, соответственно, среднее пропорцианальное}
begin
new(Curr);
Curr^.Data:=SrGeom;
Curr^.Prev:=PrevEl;
PrevEl^.Next:=Curr;
PrevEl:=Curr;
end;

procedure Main;
begin
randomize;
for i:=1 to n do ElArr[i]:=random;

sum:=0; prod:=1;
for i:=1 to n do
if not odd(i) then
begin
Add_el;
sum:=sum+ElArr[i];
prod:=prod*ElArr[i];
inc(kol);
end;

SrAr:=sum/kol;
Add_SrAr;
SrGeom:=sqrt(prod);
Add_SrGeom;
end;


begin
clrscr;
Main
end.
проверял...вроде работает... но для меня тема списков, динамических переменных и т.д. новая, поэтому если кто найдет ошибки - напишите, плиз, буду благодарен!!!

Автор: volvo 5.01.2008 7:03

Цитата
переписать из массива в линейный двунаправленный список чётные элементы массива
Ага, и ты описываешь массив вещественных чисел, да? Как определяешь их четность (с учетом того, что Random выдает числа в интервале 0..1)? Или речь об элементах с четными индексами?

Цитата
проверял...вроде работает.
Как ты проверял? В отладчике? Сделал бы вывод на экран, все стало бы проще...

Кстати, ты память выделил, а освобождать кто будет? При прогоне под FPC имеем:
Цитата
Heap dump ...
22 memory blocks allocated : 352/352
0 memory blocks freed : 0/0
22 unfreed memory blocks : 352

Автор: daZe1 6.01.2008 5:16

Я написал процедуру вывода:

procedure WriteList;
var
List: text;
begin
Assign(List, 'List.list');
rewrite(List);

Curr:= Head;
repeat
write(List, Curr^.Data:0:3, ' ');
Curr:=Curr^.Next;
until Curr=NIL;

close(List);
end;
проверял с ее же использованием....

под четными элементами имеются в виду элементы с четными индексами.

еще нашел свой касяк....среднее геометрическое надо было искать по формуле SrGeom:=exp((1/kol) * ln(prod).
Цитата
Кстати, ты память выделил, а освобождать кто будет?
А освобождать надо в самом конце???

Автор: volvo 6.01.2008 6:22

Цитата
А освобождать надо в самом конце???
Да...

Но перед этим я бы все-таки порекомендовал тебе немного подкорректировать программу. Не привыкай работать через глобальные переменные. У процедур могут быть параметры - пользуйся этим. Смотри:

Program list;
uses crt;

type
TPList= ^TList;
TList = record
Data: real;
Next: TPList;
Prev: TPList;
end;

const
n = 10;

{ Процедура добавляющая value в начало списка L }
procedure AddFirst(var L: TPList; value: real);
var curr: TPList;
begin
new(curr);
curr^.data := value;
curr^.prev := nil;
curr^.next := L;

if L <> nil then begin
L^.prev := curr;
L := curr;
end;
end;

{ Процедура добавляющая value в конец списка L }
procedure AddLast(var L: TPlist; value: real);
var curr, tail: TPList;
begin

new(curr);
curr^.data := value;
curr^.prev := nil;
curr^.next := nil;

if L = nil then L := curr
else begin
tail := L;
while tail^.next <> nil do tail := tail^.next;
tail^.next := curr;
curr^.prev := tail;
end;

end;

var
Head: TPList;

procedure WriteList;
var curr: TPList;
begin
Curr:= Head;
repeat
write(Curr^.Data:0:3, ' ');
Curr:=Curr^.Next;
until Curr=NIL;
writeln;
end;


procedure Main;
{ Все переменные - локальные }
var
i, kol: integer;
ElArr: array [1..n] of real;
SrAr, SrGeom, sum, prod: real;

begin
randomize;
for i:=1 to n do ElArr[i]:=random;

sum:=0; prod:=1;
for i:=1 to n do
if not odd(i) then
begin
AddLast(Head, ElArr[i]);

sum:=sum+ElArr[i];
prod:=prod*ElArr[i];
inc(kol);
end;

writelist;

SrAr:=sum/kol;
AddFirst(Head, SrAr);
SrGeom:=exp((1/kol) * ln(prod));
AddLast(Head, SrGeom);

writelist;
end;


begin
clrscr;
Main;
{ Здесь добавишь код освобождения памяти }
end.

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

Автор: daZe1 8.01.2008 6:02

procedure AddFirst(var L: TPList; value: real);
var curr: TPList;
begin
new(curr);
curr^.data := value;
curr^.prev := nil;
curr^.next := L;

if L <> nil then begin
L^.prev := curr;
L := curr;
end;
end;

if L <> nil then begin
а это условие для универсальности??? ведь в качаестве фактического параметра в функцию возвращается указатель на первый узел, а он в любом случае не пустой...

и еще вопрос по поводу освобождения памяти... освобождать надо только те динамические структуры, на которые память выделялась при помощи new()???

Автор: volvo 8.01.2008 19:24

Цитата
ведь в качаестве фактического параметра в функцию возвращается указатель на первый узел, а он в любом случае не пустой...
При добавлении первого элемента в список он как раз пустой...

Цитата
освобождать надо только те динамические структуры, на которые память выделялась при помощи new()???
Да, именно их и надо освобождать...

Автор: daZe1 9.01.2008 5:15

Цитата

При добавлении первого элемента в список он как раз пустой...


Но новые элементы добавляются в конец! Я пробовал прогонять... это условие выполняется, т.е. L <> nil... или это условие на случай,если список будет создаваться добавлением в начало???

Автор: volvo 9.01.2008 5:24

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

Автор: daZe1 9.01.2008 5:37

Ясно, спасибо!!! smile.gif
Вроде более или менее разобрался))