Developing.ru

Код: Выделить всё

program p49;
uses crt;const =10;
var A:array[1..Na] of integer;i,j,k:integer; 
      B:array[1..Nb] of integer;
      C:array[1..Nc] of integer;
     D:array[1..Nd] of integer;
procedure RAB;
begin
clrscr;textcolor(10);gotoxy(20,5);write('Nagmite knopky'); 
readkey;end;
begin
clrscr;
for i:=1  to N do begin
a[i]:=trunc(random*41-20);
end;
  for j:=0  to Na-2 do
  for i:=j+1  to Na-1 do
if (a[i]<a[j] ) then begin 
k:=a[i];
a[i]:=a[j];
a[j]:=k;
end;
for i:=1  to N do begin
write(A[I]:3);
END;writeln( ");

for i:=1  to N do begin
b[i]:=trunc(random*41-20);
end;
   for j:=0  to Nb-2 do
  for i:=j+1  to Nb-1 do
if (b[i]<b[j] ) then begin 
k:=b[i];
b[i]:=b[j];
b[j]:=k;
end;
for i:=1  to N do begin
write(B[I]:3);
END;writeln( ");

for i:=1  to N do begin
c[i]:=trunc(random*41-20);
end;
  for j:=0  to Nc-2 do
  for i:=j+1  to Nc-1 do
if (c[i]<c[j] ) then begin 
k:=c[i];
c[i]:=c[j];
c[j]:=k;
end;
for i:=1  to N do begin
write(C[I]:3);
END;writeln( ");

for i=0 to Na-1 do D[i]:=A[i];
for i=0 to Nb-1 do D[Na-1+i]:=B[i];
for i=0 to Nc-1 do D[Na-1+Nb-1+i]:=C[i];
if (d[i]<d[j] ) then begin 
k:=d[i];
d[i]:=d[j];
d[j]:=k;
end;
write(D[i]:3);
END;writeln( ");
readln;
end;
begin
 rab;
end.

Код: Выделить всё

program p49;
uses crt;
const 
  Na=8;
  Nb=12;
  Nc=16;
  Nd=Na+Nb+Nc;

type
  DArray = array[1..Nd] of integer;

var A : array[1..Na] of integer;
    B : array[1..Nb] of integer;
    C : array[1..Nc] of integer;
    D : DArray;
    ia, ib, ic, id : integer;

    procedure AddOne(var Mas : DArray;
                       K : integer; var i,Mas_index : integer);
    begin
      Mas[Mas_index] := K;
      inc(Mas_index);
      inc(i);
    end;

    function isA_max : boolean ;
    {возращает true - если очердной элемент массива A доступен
     и больше очередных элементов массивов B и C }
    begin
      isA_max := false;
      if (ia>Na) then Exit;
      if (ib<=Nb) then begin
        if (ic<=Nc) then begin
          if (A[ia]>=B[ib]) and (A[ia]>=C[ic]) then isA_max := true
        end
        else begin
          if (A[ia]>=B[ib]) then isA_max := true
        end;
      end
      else
        if (ic<=Nc) then begin
          if (A[ia]>=C[ic]) then isA_max := true
        end
    end;

    function isB_max : boolean ;
    {возращает true - если очердной элемент массива B доступен
     и больше очередных элементов массивов A и C }
    begin
      isB_max := false;
      if (ib>Nb) then Exit;
      if (ia<=Na) then begin
        if (ic<=Nc) then begin
          if (B[ib]>=A[ia]) and (B[ib]>=C[ic]) then isB_max := true
        end
        else begin
          if (B[ib]>=A[ia]) then isB_max := true
        end;
      end
      else
        if (ic<=Nc) then begin
          if (B[ib]>=C[ic]) then isB_max := true
        end
    end;


begin
  {заполним массивы убывающим значениями - просто подряд,
   можно }
  for ia:=1 to Na do A[ia] := Na+1-ia;
  for ib:=1 to Nb do B[ib] := Nb+1-ib;
  for ic:=1 to Nc do C[ic] := Nc+1-ic;

  {выведем элементы массивов на экран}
  WriteLn(' A: ');
  for ia:=1 to Na do Write(A[ia]:3); Writeln;
  WriteLn(' B: ');
  for ib:=1 to Nb do Write(B[ib]:3); Writeln;
  WriteLn(' C: ');
  for ic:=1 to Nc do Write(C[ic]:3); Writeln;

  {собственно заполнение нового массива...}
  ia := 1; ib := 1; ic :=1;
  id := 1;
  while (ia<=Na) or (ib<=Nb) or (ic<=Nc) do
  begin
     if isA_max then AddOne(D, A[ia], ia, id)
     else
       if isB_max then AddOne(D, B[ib], ib, id)
       else AddOne(D, C[ic], ic, id)
  end;


  {выведем элементы массива D на экран}
  Writeln;
  WriteLn(' D: ');
  for id:=1 to Nd do Write(D[id]:3); Writeln;

end.