{This works for multiset permutations with recursive structure}
program ex(input,output);
var i,j,k,kk,n,first:integer;
  a,m:array[1..100] of integer;
  available: array[1..100] of integer;    
procedure out;
var i:integer;
begin
  for i:=1 to n do write(a[i]:2);
  {readln;} writeln
end;
procedure swap(i,j:integer);
var w:integer;
begin
  w:=a[i]; a[i]:=a[j]; a[j]:=w;
end;
function minimum(k:integer):integer;
var i,j,temp:integer;
begin
  j:=0; temp:=99;
  {j:=k; temp:=a[k];}
  for i:=k to n do
    if (a[i]<temp) and (a[i]>a[k-1]) then begin
      temp:=a[i]; j:=i
    end;
  minimum:=j;
end;
function count:integer;
var i,c:integer;
begin
  c:=0;
  for i:=1 to kk do if m[i]<>0 then c:=c+1;
  count:=c;
end;
procedure reverse(k:integer);
var i:integer;
begin
  for i:=k to (k+n-1) div 2 do swap(i, n-i+k);
end;
procedure perm(k:integer);
var i,j,c:integer;
begin
  c:=count;
  if k<=n-1 then 
    for i:=1 to c do begin
      m[a[k]]:=m[a[k]]-1;
      perm(k+1);
      m[a[k]]:=m[a[k]]+1;
      if i<>c then begin
        reverse(k+1);
        j:=minimum(k+1);
        if j<>0 then begin 
          swap(k,j); out 
        end
      end
    end
end;
begin {main program}
 write('input kk and ni ');
  readln(kk);
  for i:=1 to kk do read(m[i]);
  readln;
  first:=0;
  for i:=1 to kk do begin
    for j:=1 to m[i] do a[first+j]:=i;
    first:=first+m[i]
  end;
  n:=first;
   out;
   perm(1);
   readln
end.