Массивы, Из 2-х третий Опции

[rol5en]

Помогите решить задачку или исправить эту!
Даны два одномерных массива чисел А и В.
Сформировать из них массив С, где к каждому четному элементу А
добавлено сколько раз этот элемент встречается в массиве В.
Короче надо чтобы все эл-ты из массива А передалась массиву С (это
работает), а потом надо чтобы все чётные (i mod 2 = 0) масива С при
совпадении с элементом массива В увеличивались на 1.

Код

UNIT Modul;

Interface
Procedure Reshenie;

Implementation
Uses CRT;
const
N = 100;{MaxLengthArray}
M = N*2;{MaxLengthArrayC}
K = 10; {random(10)}

type
TArray1 = array [1..N] of Real;
TArray2 = array [1..M] of Real;

Procedure Inform;
begin
ClrScr;
Writeln('Programma OK bla-bla');
Writeln;
end;

Procedure VvodMassivov(var lengA,lengB:Integer; var A,B:TArray1);
var i,par:Integer;
    ch:Char;
begin
repeat
  Writeln('Vvedite dlinnu massiva a, ne bolshe ',N);
  Readln(lengA);
  Writeln('Vvedite dlinnu massiva b, ne bolshe ',N);
  Readln(LengB);
  par:=0;
  if (lengA > 0) and (lengA <= N) and (lengB > 0) and (lengB <= N) then
    begin
     Writeln('Vi vveli: dlina massiva A = ',lengA);
     Writeln('          dlina massiva B = ',lengB);
     par:=1;
    end
else
  begin
   Writeln('Eror: Neverno vvedeni dannie');
   Writeln('Povtorit vvod/vidti? Y/N');
   ch:=ReadKey;
   if UpCase(ch) = 'N' then
      exit;
  end;
until par = 1;
randomize;
Writeln('Massive A:');
for i:= 1 to lengA do
     begin
      A[i]:=random(K);
      Write(A[i]:1:0,' ');
     end;
Writeln;
Writeln('Massive B:');
for i:= 1 to lengB do
     begin
      B[i]:=random(K);
      Write(B[i]:1:0,' ');
     end;
end;

Procedure ZapolnitC(lengA,lengB:Integer; A,B:TArray1; var C:TArray2);
var i,j:Integer;
begin
for i:=1 to lengA do
     C[i]:= A[i];
{Tut bla ne rabotaet sto-to}
for i:= 1 to lengA do
   if (i mod 2 = 0) then
     for j:=1 to lengB do
        if C[i] = B[j] then
           C[i]:= C[i] + 1;
end;
Procedure Reshenie;
var A,B:TArray1;
    C:TArray2;
    lengA,lengB,i:Integer;
begin
Inform;
VvodMassivov(lengA,lengB,A,B);
ZapolnitC(lengA,lengB,A,B,C);
Writeln;
Writeln('C');
for i:=1 to lengA do
     Write(C[i]:1:0,' ');
end;
end.

не знаю как сделать в окошке как вы извиняюсь

Сделал в окошке...

Сообщение отредактировано: APAL - 11.12.2005 13:12

[volvo]

rol5en, у тебя как только С[i] первый раз изменилось - уже дальше будет неверно... Надо запоминать это значение и с ним дальше сравнивать:

Код

Procedure ZapolnitC(lengA, lengB: Integer;
  A,B: TArray1; var C: TArray2);
var
  i,j:Integer;
  T: real;
begin
  for i:=1 to lengA do
    C[i]:= A[i];

  for i:= 1 to lengA do
    if (i mod 2 = 0) then begin
     T := C[i]; { <--- Здесь !!! }
     for j:=1 to lengB do
        if T = B[j] then
           C[i]:= C[i] + 1;
   end;

end;

Кстати, почему бы не сделать целые массивы? Или для Real есть другие причины?