Решаем задачи Абрамян на Паскале. Param12

Param12. Описать процедуру SortIndex($$A$$, $$N$$, $$I$$), формирующую для вещественного массива $$A$$ размера $$N$$ индексный массив $$I$$. — массив целых чисел того же размера, содержащий номера элементов массива $$A$$ в том порядке, который соответствует возрастанию элементов массива $$A$$ (сам массив $$A$$ при этом не изменяется). Индексный массив $$I$$. является выходным параметром. С помощью этой процедуры создать индексные массивы для массивов $$A$$, $$B$$, $$C$$ размера $$N_A$$, $$N_B$$, $$N_C$$ соответственно.

Решение:

program Param12;

type
 RArray = array[1..10] of Real;
 IArray = array[1..10] of Integer;

var
 A,B,C:RArray;
 Na,Nb,Nc:integer;
 Ia,Ib,Ic:IArray;

Procedure SortIndex(A:RArray; N:integer; var I:IArray);
 var k,k2:integer;
begin
 for k:=1 to M do I[k]:=k;

 for k:=1 to N-1 do
  for k2:=1 to N-k do
   begin
    if A[I[k2]]>A[I[k2+1]] then
     begin
      I[k2]:=I[k2]+I[k2+1];
      I[k2+1]:=I[k2]-I[k2+1];
      I[k2]:=I[k2]-I[k2+1];
     end;
   end;
end;

Procedure EnterArray(var A:RArray; var N:integer);
var i:integer;
begin
 Write('Size:');
 Readln(N);
 for i:=1 to N do
  begin
   Write(i,': ');
   Readln(A[i]);
  end;
end;

Procedure InputArray(var A:IArray; var N:integer);
var i:integer;
begin
 Writeln('---');
 for i:=1 to N do Writeln(i,': ',A[i]);
 Writeln('---');
end;


begin
 EnterArray(A,Na);
 SortIndex(A,Na,Ia);
 InputArray(Ia,Na);

 EnterArray(B,Nb);
 SortIndex(B,Nb,Ib);
 InputArray(Ib,Nb);

 EnterArray(C,Nc);
 SortIndex(C,Nc,Ic);
 InputArray(Ic,Nc);
end.

program Param12;

type

RArray = array[1..10] of Real;

IArray = array[1..10] of Integer;

var

A,B,C:RArray;

Na,Nb,Nc:integer;

Ia,Ib,Ic:IArray;

Procedure SortIndex(A:RArray; N:integer; var I:IArray);

var k,k2:integer;

begin

for k:=1 to M do I[k]:=k;

for k:=1 to N-1 do

for k2:=1 to N-k do

begin

if A[I[k2]]>A[I[k2+1]] then

begin

I[k2]:=I[k2]+I[k2+1];

I[k2+1]:=I[k2]-I[k2+1];

I[k2]:=I[k2]-I[k2+1];

end;

Procedure EnterArray(var A:RArray; var N:integer);

var i:integer;

begin

Write('Size:');

Readln(N);

for i:=1 to N do

begin

Write(i,': ');

Readln(A[i]);

end;

Procedure InputArray(var A:IArray; var N:integer);

var i:integer;

begin

Writeln('---');

for i:=1 to N do Writeln(i,': ',A[i]);

Writeln('---');

end;

begin

EnterArray(A,Na);

SortIndex(A,Na,Ia);

InputArray(Ia,Na);

EnterArray(B,Nb);

SortIndex(B,Nb,Ib);

InputArray(Ib,Nb);

EnterArray(C,Nc);

SortIndex(C,Nc,Ic);

InputArray(Ic,Nc);

end.

Другие задачи из раздела Param можно посмотреть здесь.

Комментарии 1

program Param12;//pabc.net

procedure SortIndex(a: array of real; k: array of integer);
begin
  for var i := a.High - 1 downto 0 do
    for var j := 0 to i do
      if a[k[j] - 1] > a[k[j + 1] - 1] then
        Swap(k[j], k[j + 1])
end;

begin
  var n := 5;
  var a := SeqRandomReal(n, 0.0, 99.0)
  .Select(x -> Round(x, 2)).ToArray;
  a.Println;//26.99 56.9 94.12 5.39 35.79
  
  var i := Range(1, n).ToArray;
  SortIndex(a, i);
  i.Println;//4 1 5 2 3
end.

program Param12;//pabc.net

procedure SortIndex(a: array of real; k: array of integer);

for var i := a.High - 1 downto 0 do

for var j := 0 to i do

if a[k[j] - 1] > a[k[j + 1] - 1] then

Swap(k[j], k[j + 1])

var n := 5;

var a := SeqRandomReal(n, 0.0, 99.0)

.Select(x -> Round(x, 2)).ToArray;

a.Println;//26.99 56.9 94.12 5.39 35.79

var i := Range(1, n).ToArray;

SortIndex(a, i);

i.Println;//4 1 5 2 3

Ответить

Решаем задачи Абрамян на Паскале. Param12

Комментарии:

Комментарии 1

Добавить комментарий Отменить ответ