нетипичная задача на списки, сложение и умножение чисел Опции

[alex-it]

Условие: вводится последовательность натуральных чисел и создаётся из неё список. Длина последовательности n. Обеспечить с помощью списка вычисление сумм и произведений вида:

1) x1*xn + x2*xn-1 + ... + xn*x1

2)(x1+xn)*(x2+xn-1)* ... *(xn+x1)

собственно, идея у меня такая: создается еще один список(такой же, как первый), и в цикле перемножаются 1,2,3...(пока не дойдет до nil) X из первого списка на последний X из второго списка(каждый раз последний Х удаляется соответственно). все вспомогательные процедуры вроде работают, но вот сумму никак не могу посчитать! если кого-то заинтересует, подскажите, пожалуйста! заранее спасибо.

[volvo]

alex-it,
списки односвязные, или двухсвязные... И, если можно, покажи, как ты пытался делать, вместе с реализацией списков...

[alex-it]

вроде в условии не оговаривается, так что по идее можно делать как угодно... я пытался делать с односвязными

Код

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;

[Дож]

alex-it, зачем здесь эта строка?

Код

ls:=lp;

Наверно ты хотел сделать так: ls^:=lp^;

[volvo]

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;
begin
  write('Input the size of array: '); readln(n);
  write('initial sequence: ');
  for i:=1 to n do begin
    mas[i]:=Random(5)+1;
    write(mas[i]:4);
  end;
  writeln;
end;

procedure print_list(first: pn);
begin
  while first <> nil do begin
    write(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] <> 0 do begin

    new(p);
    p^.data := mas[i];
    p^.next := nil;
    p^.prev := last;

    if first = nil then 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) do begin
    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]

спасибо за помощь! действительно, так гораздо проще.