Cod sursa(job #188404)

Utilizator cezar305Mr. Noname cezar305 Data 8 mai 2008 10:26:46
Problema Descompuneri Scor 100
Compilator fpc Status done
Runda Arhiva de probleme Marime 2.67 kb
var k,i,j,x,nd,f,a,b,st:longint;
    n,aux,nn,t:int64;
    d:array[0..3000] of int64;
    v:array[0..3000,0..3000] of longint;

procedure qsort(ls,ld:longint);
var i,j:longint;
begin
  i:=ls;j:=ld;
  while true do begin
    while (d[i]<=d[j])and(i<>j) do inc(i);
    if i=j then break;
    aux:=d[i];d[i]:=d[j];d[j]:=aux;dec(j);
    while (d[i]<=d[j])and(i<>j) do dec(j);
    if i=j then break;
    aux:=d[i];d[i]:=d[j];d[j]:=aux;inc(i);
  end;
  if j-1>ls then qsort(ls,j-1);
  if j+1<ld then qsort(j+1,ld);
end;


function cauta(t:int64;l,r:longint):longint;
var m:longint;
begin
while l<=r do
        begin
        m:=(l+r) div 2;
        if d[m]=t then
                begin
                cauta:=m;
                exit;
                end;
        if t<d[m] then
                r:=m-1
        else
                l:=m+1;
        end;
end;


begin
assign(input,'desc.in');reset(input);
assign(output,'desc.out');rewrite(output);
readln(n,k);
for i:=1 to trunc(sqrt(n)) do
        begin
        if n mod i=0 then
                begin
                if i<>1 then
                        begin
                        inc(nd);
                        d[nd]:=i;
                        end;
                if i<>n div i then
                        begin
                        inc(nd);
                        d[nd]:=n div i;
                        end;
                end;
        end;
qsort(1,nd);
v[1][1]:=1;
for i:=2 to nd do
        begin
        v[i][i]:=1;
        for j:=i-1 downto 1 do
                begin
                v[i][j]:=v[i][j+1];
                if d[i] mod d[j]=0 then
                        begin
                        x:=cauta(d[i] div d[j],1,nd);
                        v[i][j]:=v[i][j]+v[x][j];
                        end;
                end;
        end;
writeln(v[nd][1]);
t:=nd;
nn:=n;
st:=1;
while nn>1 do
        begin
        i:=1;
        while i<=nd do
                begin
                if nn mod d[i]=0 then
                begin
                t:=nn div d[i];
                if t=1 then
                        begin
                        write(d[i],' ');
                        nn:=1;
                        break;
                        end;
                x:=cauta(t,1,nd);
                if v[x][i]<k then
                        k:=k-v[x][i]
                else
                        begin
                        write(d[i],' ');
                        nn:=nn div d[i];
                        dec(i);
                        end;
                end;
                inc(i);
                end;
        end;
close(input);close(output);
end.