Условие: вводится последовательность натуральных чисел и создаётся из неё список. Длина последовательности n. Обеспечить с помощью списка вычисление сумм и произведений вида:
1) x1*xn + x2*xn-1 + ... + xn*x1
2)(x1+xn)*(x2+xn-1)* ... *(xn+x1)
собственно, идея у меня такая: создается еще один список(такой же, как первый), и в цикле перемножаются 1,2,3...(пока не дойдет до nil) X из первого списка на последний X из второго списка(каждый раз последний Х удаляется соответственно). все вспомогательные процедуры вроде работают, но вот сумму никак не могу посчитать! если кого-то заинтересует, подскажите, пожалуйста! заранее спасибо.
volvo
4.12.2005 11:10
alex-it, списки односвязные, или двухсвязные... И, если можно, покажи, как ты пытался делать, вместе с реализацией списков...
alex-it
4.12.2005 13:59
вроде в условии не оговаривается, так что по идее можно делать как угодно... я пытался делать с односвязными
Код
type pn=^mark; mark=record a:integer; next:pn; end; mas_i=array[1..100] of integer;
{Здесь создается простой массив из натуральных чисел} procedure input(var n:integer; var mas:mas_i); var i:integer; begin Write('Input the size of massive: '); readln(n); for i:=1 to n do begin mas[i]:=Random(5)+1; end; write('Ishodnaya posledovatelnost: '); for i:=1 to n do write(mas[i], ' '); writeln(''); end;
{Здесь создается список} procedure add(var lp:pn; n:integer; mas:mas_i); var p:pn; i:integer; begin for i:=1 to n do if mas[i]<>0 then begin new(p); p^.a:=mas[i]; p^.next:=lp; lp:=p; end; end;
{Функция возвращает последний элемент списка} function getlast(p:pn):pn; begin if (p<>nil) then begin while (p^.next<>nil) do p:=p^.next; getlast:=p; end else getlast:=nil; end;
{Функция возвращает предпоследний элемент списка} function getprelast(p:pn):pn; var p1:pn; begin if (p<>nil) then begin p1:=p; repeat p:=p1; if (p^.next<>nil) then p1:=p^.next; until (p1^.next=nil); getprelast:=p; end else getprelast:=nil; end;
{В этой процедуре происходит удаление последнего элемента списка} procedure getdell(var p:pn); var p1:pn; begin if (p<>nil) then if (p^.next=nil) then begin p1:=p; p:=p^.next; dispose(p1); end else begin p1:=getprelast(p); dispose(p1^.next); p1^.next:=nil; end; end;
{Здесь происходит вычисление суммы(1). Собственно, здесь и проблема. При таком варианте программа просто вылетает.} procedure summ(lp:pn; sum:integer); var ls,p:pn; begin new(ls); ls:=lp; sum:=0; while (lp<>nil) do begin p:=getlast(ls); sum:=sum+(lp^.a)*(p^.a); lp:=lp^.next; getdell(ls); end; writeln('Summa ravna ', sum); end;
Дож
4.12.2005 14:07
alex-it, зачем здесь эта строка?
Код
ls:=lp;
Наверно ты хотел сделать так: ls^:=lp^;
volvo
4.12.2005 14:28
alex-it, Ну, а вот так первое задание реализуется с двухсвязными списками:
type
pn=^mark;
mark=record
data: integer;
prev, next:pn;
end;
mas_i=array[1..100] of integer;
procedure input(var n:integer; var mas:mas_i);
var
i:integer;
beginwrite('Input the size of array: '); readln(n);
write('initial sequence: ');
for i:=1to n dobegin
mas[i]:=Random(5)+1;
write(mas[i]:4);
end;
writeln;
end;
procedure print_list(first: pn);
beginwhile first <> nildobeginwrite(first^.data:4);
first := first^.next
end;
writeln;
end;
procedure make_list(var mas: mas_i;
var first, last: pn);
var
i: integer;
p: pn;
begin
first := nil; last := nil;
i := 1;
while mas[i] <> 0dobegin
new(p);
p^.data := mas[i];
p^.next := nil;
p^.prev := last;
if first = nilthen first := p
else last^.next := p;
last := p;
inc(i);
end;
end;
function get_s(first, last: pn): integer;
var s: integer;
begin
s := 0;
while (first <> nil) and (last <> nil) dobegin
s := s + first^.data * last^.data;
first := first^.next;
last := last^.prev;
end;
get_s := s;
end;
var
first, last: pn;
n: integer;
arr: mas_i;
begin
fillchar(arr, sizeof(arr), 0);
input(n, arr);
make_list(arr, first, last);
print_list(first);
writeln('sum = ', get_s(first, last));
end.
Выбирай, изобретать велосипед дальше, или решать саму задачу...
alex-it
4.12.2005 16:40
спасибо за помощь! действительно, так гораздо проще.
Это текстовая версия — только основной контент. Для просмотра полной версии этой страницы, пожалуйста, нажмите сюда.