Network Flow...

program problem;
var
en,et,ec,eu,ep,ex:Array[0..250000] of longint;
dis:array[0..1000] of longint;
v:array[0..1000] of boolean;
i,j,k,n,m,w,cost,l:longint;
a,b,ans,left,right:longint;

function min(a,b:longint):longint;
begin
if a<b then min:=a else min:=b
end;

procedure addedge(s,t,c,u,k:longint);
begin
   inc(l);
   en[l]:=en[s];
   en[s]:=l;
   et[l]:=t;
   ec[l]:=c;
   eu[l]:=u;
   ep[l]:=l+k;
end;

procedure build(s,t,u,c:longint);
begin
   addedge(s,t,c,u,1);
   addedge(t,s,-c,0,-1);
end;

function aug(no,m:longint):longint;
var
i,d:longint;
begin
   if no=n then
      begin
      inc(cost,m*dis[1]);
      exit;
      end;
   v[no]:=true;
   i:=ex[no];
   while i<>0 do
      begin
      if (eu[i]>0)and not v[et[i]] and(dis[et[i]]+ec[i]=dis[no]) then
         begin
         d:=aug(et[i],min(m,eu[i]));
         if d>0 then
          begin
          dec(eu[i],d);
          inc(eu[ep[i]],d);
          ex[no]:=i;
          exit(d);
          end;
         end;
      i:=en[i];
      end;
   ex[no]:=i;
   exit(0);
end;

function modlabel:boolean;
var
d,i,j:longint;
begin
   d:=maxlongint;
   for i:=1 to n do
      if v[i] then
         begin
         j:=en[i];
         while j<>0 do
          begin
          if (eu[j]>0)and not v[et[j]] and(ec[j]-dis[i]+dis[et[j]]<d) then
             d:=ec[j]-dis[i]+dis[et[j]];
          j:=en[j]
          end;
         end;
   if d=maxlongint then exit(true);
   for i:=1 to n do
      if v[i] then
         begin
         v[i]:=false;
         inc(dis[i],d);
         end;
   exit(false);
end;

function work:longint;
var i:longint;
begin
cost:=0;
repeat
   for i:=1 to n do ex[i]:=en[i];
   while aug(1,maxlongint)>0 do
      fillchar(v,sizeof(v),0);
until modlabel;
work:=cost;
end;

function solve(x,d:longint):longint;
var i,k,t,p,last,cost,lk:longint;
begin
fillchar(en,sizeof(en),0);
fillchar(dis,sizeof(dis),0);
k:=0; n:=2; t:=x; p:=0;
while x<>0 do
   begin
   k:=k+x mod 10;
   x:=x div 10;
   inc(p);
   end;
n:=1; x:=t; l:=k+p+1; last:=1; cost:=1; lk:=0;
while x<>0 do
   begin
   k:=x mod 10;
   for i:=1 to k do
      begin
      inc(n);
      build(last,n,1,-cost);
      build(n,last+k+1,1,0);
      end;
   cost:=cost*10;
   inc(n);
   if last<>1 then
      begin
      if lk<k then
         build(1,last,k-lk,0);
      if k<lk then
         build(last,n,lk-k,0);
      end;
   last:=n; x:=x div 10;
   if lk<k then lk:=k;
   end;
build(1,n,1,d);
solve:=-work;
end;

begin
readln(a,b);
left:=1; right:=1000000000;
while right-left>15000 do
   begin
   ans:=(left+right)shr 1;
   if solve(ans,b)>a then
      right:=ans
   else left:=ans;
   end;
for i:=left to right do
   if solve(i,b)=a then
      begin
      writeln(i);
      halt;
      end;
end.

funny...

=)

:D
Accepted! It Works!!!

Edited by author 24.09.2012 17:13

yes so fun