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

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

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

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


Новичок
*

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

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


Задача такова:
задан массив из 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.
проверял...вроде работает... но для меня тема списков, динамических переменных и т.д. новая, поэтому если кто найдет ошибки - напишите, плиз, буду благодарен!!!
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #2


Гость






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

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

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


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


Новичок
*

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

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


Я написал процедуру вывода:
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).
Цитата
Кстати, ты память выделил, а освобождать кто будет?
А освобождать надо в самом конце???
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #4


Гость






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

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

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.

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


Новичок
*

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

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


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 -
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #6


Гость






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

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


Новичок
*

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

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


Цитата

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


Но новые элементы добавляются в конец! Я пробовал прогонять... это условие выполняется, т.е. L <> nil... или это условие на случай,если список будет создаваться добавлением в начало???
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #8


Гость






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


Новичок
*

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

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


Ясно, спасибо!!! smile.gif
Вроде более или менее разобрался))
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 

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

 





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