Проверьте пж-та, правильно ли работает?=) Я с этой системой никогда не сталкивался, поэтому...
Но вроде всё правильно выполняет...
Program Johnson_method;
Uses Crt;
Const r=30;
Var n,i,Min_j,Min_i,Temp_1,Temp_2:Integer;
ch:Char;
isChange:Boolean;
A:Array [0..100,0..100] of Integer;
Begin
Repeat
ClrScr;
Randomize;
WriteLn('');
WriteLn;
WriteLn('Write a number of details');
ReadLn(n);
WriteLn;
WriteLn('Time:');
Write('A: ');
For i:=1 to n do begin
A[i,1]:=random®;
Write(A[i,1]:3);
end;
WriteLn;
Write('B: ');
For i:=1 to n do begin
A[i,2]:=random®;
Write(A[i,2]:3);
end;
WriteLn;
{начинается прелбразование}
Repeat
isChange:=False;
For i:=1 to n-1 do begin
Min_i:=A[i,1];
Min_j:=A[i+1,1];
{ WriteLn('Min_i=',Min_i,' Min_j=',Min_j); }
If A[i,1]>A[i+1,2] then Min_i:=A[i+1,2];
If A[i+1,1]>A[i,2] then Min_j:=A[i,2];
{ WriteLn('Min_i=',Min_i,' Min_j=',Min_j); }
If Min_i>Min_j then
begin
Temp_1:=A[i,1];
A[i,1]:=A[i+1,1];
A[i+1,1]:=Temp_1;
Temp_2:=A[i,2];
A[i,2]:=A[i+1,2];
A[i+1,2]:=Temp_2;
isChange:=True;
end;
end;
Until isChange=False;
WriteLn('Yahoo:');{Ответ}
Write('A: ');
For i:=1 to n do Write(A[i,1]:3);
WriteLn;
Write('B: ');
For i:=1 to n do Write(A[i,2]:3);
WriteLn;
WriteLn('If you want to quit press <ESC>, else any key.');
ch:=ReadKey;
Until ord(ch)=27;
END.