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

[PacMan]

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

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

 

[MrSTEP]

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

 

[Mr.Програмист]

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

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.

 

[Vladimir_S]

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

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

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

 

[Vladimir_S]

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

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.

 

[Mr.Програмист]

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

 

[Vladimir_S]

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

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

 

[PacMan]

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