Линейный двунаправленный список Опции

[daZe1]

Задача такова:
задан массив из 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]

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

Да...

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

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.

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