program xaffmen;
 uses CRT;
 const n=5;
 type matrix1=array[1..n,1..n] of real;
 type matrix2=array[1..n,1..n] of string;
 type mas1=array [1..n] of byte;
 const dano: array [1..n] of real=(0.53, 0.23, 0.13, 0.06, 0.05);
 var a:matrix1; b:matrix2; k,m,i,j,l:byte; num: mas1; sum: real;



 procedure insert (n,k:byte; x:real; col:byte; var a:matrix1; var num: mas1);
  var i1:byte;
  begin
   for i1:=1 to n-col do a[i1,col]:=a[i1,col-1];
   a[n-col+1,col]:=x;
   i1:=n-col;
   while (i1>=1) and (x>a[i1,col]) do begin 
                                                 a[i1+1,col]:=a[i1,col];  
                                                 a[i1,col]:=x; 
                                                 i1:=i1-1;
                                                 end;
   num[col]:=i1+1;
  end;

 procedure return (n,k,col,numr:byte; var b:matrix2);
  var i1,j1:byte; s:string;
  begin
  for i1:=1 to n-col do b[i1,col]:=b[i1,col+1];
  s:=b[numr,col];
  for i1:=numr to n-col do b[i1,col]:=b[i1+1,col];
  b[n-col,col]:=s+'0';  
  b[n-col+1,col]:=s+'1';
  end;

 begin
  {vvod veroiatnostei}
   clrscr;
   k:=n;
    for i:=1 to k do
    for j:=1 to k do
     if j<>1 then a[i,j]:=0
               else a[i,j]:=dano[i];

 {vstavka chisla}
 for j:=1 to k-1 do
  begin
  i:=n+1-j;
  sum:=a[i,j]+a[i-1,j];

  insert (n,k,sum,j+1,a,num);
  end;

  {raspredelenie kodov}
  b[1,k]:='0';
  b[2,k]:='1';
  for j:=k-1 downto 1 do return (n,k,j,num[j+1], b);
 
 {vivod kodov elementov}
  clrscr;
  for i:=1 to n do begin
                       for j:=1 to k do 
                        if a[i,j]>0 then begin textcolor(10);write(a[i,j]:6:2);end
                                     else textcolor (15); 
                      gotoxy(k*6+1,i);
                      for j:=1 to k do write(b[i,j]:6);
                      writeln;
                      end;
  writeln ;

 readkey;
 end.

uses CRT;
const
 n=5;
 dano: array [1..n] of real=(0.53, 0.23, 0.13, 0.06, 0.05);
type
 matrix1=array[1..n,1..n] of real;
 matrix2=array[1..n,1..n] of string;
 matrix3=array[1..n,1..n] of byte;
var
 a:matrix1;
 b:matrix2;
 k,i,j,cl:byte;
 sum: real;
 clr:matrix3;
 s:string;

Begin
 {vvod veroiatnostei}
 clrscr;
 for i:=1 to n do a[i,1]:=dano[i];
 {vvod cveta}
 for i:=1 to n do
  for j:=1 to n-i+1 do
   if (i=n-j+1) and (i<n) then clr[i,j]:=10 else clr[i,j]:=15;
 {formirovanie matrici a bez uporjadochenija}
 for j:=2 to n do
  begin
   for i:=1 to n-j+1 do a[i,j]:=a[i,j-1];
   a[n-j+1,j]:=a[n-j+2,j-1]+a[n-j+1,j-1];
  end;
 {formirovanie matrici b bez uporjadochenija}
 b[1,n]:='0';
 for j:=n-1 downto 1 do
  begin
   for i:=1 to n-j-1 do b[i,j]:=b[i,j+1];
   if a[n-j,j]>a[n-j+1,j] then
    begin
     b[n-j,j]:=b[n-j,j+1]+'0';
     b[n-j+1,j]:=b[n-j,j+1]+'1';
    end else
    begin
     b[n-j,j]:=b[n-j,j+1]+'1';
     b[n-j+1,j]:=b[n-j,j+1]+'0';
    end;
  end;
 {uporjadochenije}
 for j:=1 to n-1 do
  for k:=1 to n-j do
   for i:=1 to n-k do
    if a[i+1,j]>a[i,j] then
     begin
      sum:=a[i,j];
      a[i,j]:=a[i+1,j];
      a[i+1,j]:=sum;
      cl:=clr[i,j];
      clr[i,j]:=clr[i+1,j];
      clr[i+1,j]:=cl;
      s:=b[i,j];
      b[i,j]:=b[i+1,j];
      b[i+1,j]:=s;
     end;
 {vyvod rezultatov}
 for i:=1 to n do
  begin
   for j:=1 to n-i+1 do
    begin
     textcolor(clr[i,j]);
     write(a[i,j]:6:2);
    end;
   for k:=1 to i do write('      ');
   for j:=n downto 1 do
    begin
     textcolor(clr[i,j]);
     write(b[i,j]:6);
    end;
   writeln;
  end;
 ReadKey;
 NormVideo;
End.