Задача на ссылочные типы данных Опции

[Eskel]

Вот задача:
Используя динамическое размещение последовательности вещественных чисел A1,A2…An, преобразовать исходную последовательность, добавив нулевые элементы после каждого отрицательного.

program Zadacha_1;

type
   ptr=^arr;
   arr=array[1..100] of real;


var
   p:ptr;
   q,i:word;
   v:real;
begin
   new(p);
   writeln('Enter qantity of elements');
   readln(q);
   for i:=1 to q do
   begin
      writeln('Enter value of ',i,' element');
      readln(p^[i]);
   end;
   writeln;
   writeln('The list before processing:');
   for i:=1 to q do
      write(p^[i]:4 :2,', ');
   writeln;
   writeln('The list after processing:');
   {for i:=1 to q do
   begin
      if p^[i]<0 then p^[i+1]:=0;
      write(p^[i]:4 :2,', ');
   end;}
   dispose(p);
   readln;
end.

Помогите, пожалуйста, написать сам цикл по добавлению нулей после отрицательных элементов

Сообщение отредактировано: volvo - 12.01.2009 18:22

[volvo]

   writeln('The list before processing:');
   for i:=1 to q do
      write(p^[i]:4 :2,', ');
   writeln;

   i := q;
   while i > 0 do begin
     if p^[i] < 0 then begin
       for j := q downto i do p^[j + 1] := p^[j];
       p^[i + 1] := 0; inc(q);
     end;
     dec(i);
   end;

   writeln('The list after processing:');
   for i:=1 to q do
      write(p^[i]:4 :2,', ');
   writeln;

, хотя мне кажется, что от тебя требовалось нечто другое: выделить память под Q элементов, потом пройтись по массиву, посчитать, сколько отрицательных введено, выделить память под новый массив, и переписать из старого в новый, включая нули после отрицательных элементов.

[Eskel]

program Zadacha_1;

type
   ptr=^arr;
   arr=array[1..100] of real;


var
   p:ptr;
   q,i,j:word;
   v:real;
begin
   new(p);
   writeln('Enter qantity of elements');
   readln(q);
   for i:=1 to q do
   begin
      writeln('Enter value of ',i,' element');
      readln(p^[i]);
   end;
   writeln;
   writeln('The list before processing:');
   for i:=1 to q do
      write(p^[i]:4 :2,', ');
   writeln;
   i:=q;
   while i>0 do begin
   if p^[i]<0 then begin
   for j:=q downto i do p^[i+1]:=p^[i];
   p^[i+1]:=0; inc(q) end;
   dec(i) end;
   writeln('The list after processing:');
   for i:=1 to q do
   write(p^[i]:4 :2,', ');
   writeln
   dispose(p);
   readln;
end.

Я вот так переделал... Правильно? У меня не работает.

Еще. Покажите, пожалуйста, покажите как сделать эту прогу как вы сказали. Будет 2 варианта

Сообщение отредактировано: volvo - 12.01.2009 19:41

[volvo]

   for j:=q downto i do p^[i+1]:=p^[i];

Я этого не говорил. Смотри внимательнее.

[Eskel]

Спасибо, исправил. Получилось

[volvo]

А вот - тот вариант, о котором я написал выше, с перераспределением памяти:

program Zadacha_1;

type
  ptr = ^arr;
  arr = array[1 .. 1000] of real;

var
   p,pt:ptr;
   q,i,j,count:word;
   v:real;
begin
   writeln('Enter qantity of elements');
   readln(q);

   getmem(p, q * sizeof(real));
   for i:=1 to q do
   begin
      writeln('Enter value of ',i,' element');
      readln(p^[i]);
   end;

   writeln;
   writeln('The list before processing:');
   for i:=1 to q do
      write(p^[i]:4 :2,', ');
   writeln;

   count := 0;
   for i := 1 to q do begin
     if p^[i] < 0 then inc(count);
   end;

   if count > 0 then begin
     getmem(pt, (q + count) * sizeof(real));
     j := 1;
     for i := 1 to q do begin
       pt^[j] := p^[i]; inc(j);
       if p^[i] < 0 then begin
         pt^[j] := 0; inc(j);
       end;
     end;
     freemem(p, q * sizeof(real));
     inc(q, count);
     p := pt;
   end;

   writeln('The list after processing:');
   for i:=1 to q do
   write(p^[i]:4 :2,', ');
   writeln;

   freemem(p, q * sizeof(real));
   readln;
end.