Технический форум - Количество элементов до первого положительного

Технический форум (http://www.tehnari.ru/)

- Delphi, Kylix and Pascal (http://www.tehnari.ru/f43/)

Количество элементов до первого положительного

Помогите написать программу на паскале.....
Определить одну процедуру, которая считает количество элементов до первого положительного в вещественных массивах x[20], y[20], z[20] и формирует из этих элементов новый массив NEW. Вывести на печать исходные и полученные массивы.

В чем проблема? Задача элементарнейшая..

Вот программа, ишет числа и выводит массив, не процедура наверное (или я не прав)

Код:

var a:array[1..20] of real;

b:array[1..20] of real;

c:array[1..20] of real;

NEW:array[0..100] of real;

i,k:integer;

begin

k:=0;

Writeln('Заполнение массива');

for i:=1 to 20 do

begin

Readln(a[i]);

Writeln('a[',i,']=',a[i]);

end;

for i:=1 to 20 do

begin

Readln(b[i]);

Writeln('b[',i,']=',b[i]);

end;

for i:=1 to 20 do

begin

Readln(c[i]);

Writeln('c[',i,']=',c[i]);

end;

for i:=1 to 20 do

begin

if a[i]<=0

then begin

new[k]:=a[i];

k:=k+1;

end

end;

for i:=1 to 20 do

begin

if b[i]<=0

then begin

new[k]:=b[i];

k:=k+1;

end

end;

for i:=1 to 20 do

begin

if c[i]<=0

then begin new[k]:=c[i];

k:=k+1;

end

end;

for i:=1 to k do

Writeln('NEW[',i,']=',NEW[i]);

for i:=1 to 20 do

begin

Write('a[',i,']=',a[i],' ');

end;

for i:=1 to 20 do

begin

Write('b[',i,']=',b[i],' ');

end;

for i:=1 to 20 do

begin

Write('c[',i,']=',c[i],' ');

end;

readln;

end.

Цитата:

Сообщение от Mr.Програмист (Сообщение 461960)

Вот программа, ишет числа и выводит массив, не процедура наверное (или я не прав)

Ну что же, с одной стороны, конечно, Ваша квалификация, уважаемый MrПрограМист, заметно возросла, и программа в целом составлена структурно правильно, и тем не менее работать она, увы, не будет. Как я вижу, Вы опять проигнорировали требование и мое, и других участников форума, и выложили написанный от руки листинг без трансляции и тестирования.
Знаете, вот я, имея программистский опыт в несколько десятилетий и будучи автором программ, занимающих отнюдь не пол странички, а сотни страниц, такого себе не позволяю - любая программа, которую я выкладываю (за очень редким исключением) мною обязательно транслируется и тщательно тестируется, и только потом появляется здесь. А Вы, чудо-ребенок, как видно, считаете себя выше этого. Так?
А в данной программе ошибка заложена уже в самОй формулировке. Дело в том, что предложенное имя массива "NEW" свидетельствует о безграмотности составителя задачи, поскольку "NEW" - это зарезервированное служебное слово языка Паскаль, и любой транслятор тут же сообщит об ошибке уже на этапе трансляции.
Далее. Вы не дали себе труда как следует внимательно прочитать условие задачи. В условии требуется собрать в новый массив элементы ДО ПЕРВОГО ПОЛОЖИТЕЛЬНОГО, т.е. как только появилось положительное число, обработку исходного массива следует прекратить и перейти к следующему. Или закончить, если это третий из исходных массивов. Вы же сбрасываете в новый массив все отрицательные элементы всех трех исходных массивов. Это не соответствует задаче.
Не говоря уже о безобразной организации ввода-вывода массивов. Если бы Вы сподобились каким-то чудом запустить своё изделие, Вы бы это увидели и, надеюсь, исправили.

Короче говоря, так.
Если я еще раз увижу выложенный неотлаженный сырец, выдаваемый за рабочую программу, пойдете в бан. Причем вечный. Потому что репутация форума мне небезразлична. А Вы подобными действиями ее подрываете.

Ну и уж "раз пошла такая пьянка", придется выложить рабочий (естественно, оттестированный) вариант программы:

Код:

var

 a:array[1..20] of real;

 b:array[1..20] of real;

 c:array[1..20] of real;

 N_E_W:array[0..60] of real;

 i,k:integer;

begin

 k:=0;

 Writeln('Заполнение массивов:');

 for i:=1 to 20 do

  begin

   Write('a[',i:2,']= ');

   Readln(a[i]);

  end;

 for i:=1 to 20 do

  begin

   Write('b[',i:2,']= ');

   Readln(b[i]);

  end;

 for i:=1 to 20 do

  begin

   Write('c[',i:2,']= ');

   Readln(c[i]);

  end;

 i:=0;

 Repeat

  i:=i+1;

  if a[i]<=0 then

   begin

    k:=k+1;

    N_E_W[k]:=a[i];

   end;

 Until (a[i]>0) or (i=20);

 i:=0;

 Repeat

  i:=i+1;

  if b[i]<=0 then

   begin

    k:=k+1;

    N_E_W[k]:=b[i];

   end;

 Until (b[i]>0) or (i=20);

 i:=0;

 Repeat

  i:=i+1;

  if c[i]<=0 then

   begin

    k:=k+1;

    N_E_W[k]:=c[i];

   end;

 Until (c[i]>0) or (i=20);

 WriteLn('Array a:');

 for i:=1 to 20 do

  Write(a[i]:8:2);

 WriteLn;

 WriteLn('Array b:');

 for i:=1 to 20 do

  Write(b[i]:8:2);

 WriteLn;

 WriteLn('Array c:');

 for i:=1 to 20 do

  Write(c[i]:8:2);

 WriteLn;

 WriteLn('Array NEW:');

 for i:=1 to k do

  Write(N_E_W[i]:8:2);

 WriteLn;

 readln;

end.

Хорошо Владимир я перестану писать на Pascal ABC и начну писать на Turbo Pascal 7.1

Цитата:

Сообщение от Mr.Програмист (Сообщение 462461)

Хорошо Владимир я перестану писать на Pascal ABC и начну писать на Turbo Pascal 7.1

Да пишите Вы на чем хотите, только обязательно проводите работу по отладке и тестированию выкладываемой программы. Собственно, это почти единственное к Вам пожелание. Ну и конечно внимательно читайте условия задач, чтобы решение им в точности соответствовало, а не было бы решением "чего-то похожего". Ну и конечно желательно, чтобы программа в качестве экранного сообщения не выдавала перлов типа "Вводим кол-во цифр сумму цифр сумму которых вы которых вы вы хотите найти".
Успехов!

Спасибо вам огромное) Разобраться не мог, я больше по С++