TAXID - VOI10 - Mã số thuế
Tác giả: flashmt
Ngôn ngữ: Pascal
const fi='';
maxl=13;
type ar=array[1..maxl,-1..36] of int64;
var n,q:int64;
m,p,x,y,num,dg:longint;
f,g,h:ar;
a,b,c,e:array[1..40] of longint;
d:array[1..10000] of longint;
procedure calc(var f:ar;x:longint);
var i,j:longint;
begin
for j:=0 to x-1 do f[1,j]:=1;
for i:=2 to maxl do
for j:=0 to x-1 do f[i,j]:=f[i-1,j]*x;
end;
procedure conv;
var i:longint; nn:int64;
begin
nn:=n;
while nn>0 do
begin
inc(dg);
b[dg]:=nn mod 36;
nn:=nn div 36;
end;
end;
function check(i,x:longint):boolean;
begin
while i>0 do
begin
if i mod 36>=x then exit(false);
i:=i div 36;
end;
check:=true;
end;
procedure wr(x:longint);
var i,j:longint;
begin
j:=0;
while x>0 do
begin
inc(j);
e[j]:=x mod 36;
x:=x div 36;
end;
for i:=j downto 1 do
if e[i]<10 then write(e[i])
else write(chr(e[i]+87));
writeln;
end;
procedure vet;
var i,j,sl:longint;
begin
sl:=0;
for i:=1 to n do
if check(i,x) and not check(i,y) then
begin
inc(sl);
d[sl]:=i;
end;
if odd(p) then wr(d[q])
else wr(d[sl-q+1]); halt;
end;
procedure rf;
var i,k,r:longint;
begin
read(n,m,p,q);
k:=(m-1) shr 1;
for i:=1 to k do read(c[i]);
r:=(p+1) shr 1;
if r>k then x:=36 else x:=c[r];
if r>1 then y:=c[r-1] else y:=0;
if not odd(p) then conv;
if n<=10000 then vet;
end;
procedure minus;
var i,j:longint; s,t:boolean; oo:int64;
begin
s:=true; t:=true; oo:=100000000; oo:=oo*oo;
for i:=1 to maxl do
for j:=0 to x-1 do
h[i,j]:=f[i,j]-g[i,j];
for i:=1 to maxl do
for j:=0 to x-1 do
begin
if s then h[i,j]:=h[i,j-1]+h[i,j];
if h[i,j]>oo then s:=false;
if t then f[i,j]:=f[i,j-1]+f[i,j];
if f[i,j]>oo then t:=false;
end;
end;
procedure find;
var i,j:longint; kt:boolean; res:int64;
begin
kt:=false; res:=0;
for i:=dg downto 1 do
begin
if kt then
begin
if b[i]>=x then
begin
res:=res+f[i,x-1]; break;
end;
if i>1 then res:=res+f[i,b[i]-1] else res:=res+f[1,b[i]];
end
else
begin
if b[i]>=x then
begin
res:=res+h[i,x-1];
break;
end;
if i>1 then res:=res+h[i,b[i]-1] else res:=res+h[1,b[i]];
if b[i]>=y then kt:=true;
end;
end;
q:=res-q+1;
end;
procedure pr;
var i,j:longint; kt,z:boolean;
begin
calc(f,x);
if y>0 then calc(g,y);
minus;
if not odd(p) then find;
if y=0 then
begin
inc(n); inc(q);
end;
for num:=1 to maxl do
if h[num,x-1]>=n then break;
kt:=false;
for i:=num downto 1 do
begin
for j:=0 to x-1 do
if kt then
begin
if f[i,j]>=q then
begin
a[i]:=j;
q:=q-f[i,j-1];
break;
end;
end
else
begin
if h[i,j]>=q then
begin
a[i]:=j;
q:=q-h[i,j-1];
break;
end;
end;
if j>=y then kt:=true;
end;
z:=false;
for i:=num downto 1 do
begin
if not z and (a[i]=0) then continue;
if a[i]>0 then z:=true;
if a[i]<10 then write(a[i])
else write(chr(a[i]+87));
end;
end;
begin
assign(input,fi); reset(input);
rf;
pr;
close(input);
end.