Cod sursa(job #1273981)

Utilizator baolaptrinhbaolaptrinh baolaptrinh Data 23 noiembrie 2014 02:50:37
Problema Descompuneri Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 2.36 kb
const
    tfi='';//desc.inp';
    tfo='';//desc.out';

var
    fi,fo:text;
    n:int64;
    kk,k,top:longint;
    q:array[0..6000] of longint;
    f:array[0..6000,0..6000] of int64;
procedure swap(var x,y:longint);
    var tg:longint;
    begin
        tg:=x;
        x:=y;
        y:=tg;
    end;

procedure sort(l,r:longint);
    var i,j,k:longint;
    begin
        i:=l;
        j:=r;
        k:=q[l+random(r-l+1)];
        repeat
            while q[i]<k do inc(i);
            while q[j]>k do dec(j);
            if i<=j then
                begin
                    swap(q[i],q[j]);
                    inc(i);
                    dec(j);
                end;
        until i>j;
        if i<r then sort(i,r);
        if l<j then sort(l,j);
    end;

procedure truyvet(x,y:longint);
    begin
        if x<y then exit;
        if (f[x,y+1]<kk) and (q[x] mod q[y]=0) then
            begin
                write(fo,q[y],' ');
                kk:=kk-f[x,y+1];
                while (q[k]>q[x] div q[y]) do dec(k);
                truyvet(k,y);
            end
        else
            truyvet(x,y+1);
    end;

procedure xuli;
    var i,j:longint;
    begin
        read(fi,n,kk);
        for i:=1 to trunc(sqrt(n)) do
                if n mod  i=0 then
                    begin
                        inc(top);
                        q[top]:=i;
                        if n div i<>i then
                            begin
                                inc(top);
                                q[top]:=n div i;
                            end;
                    end;
        sort(1,top);
        for i:=1 to top do f[i,i]:=1;
        for i:=2 to top do
            begin
            k:=1;
            for j:=i-1 downto 1 do
                begin
                    f[i,j]:=f[i,j+1];
                    while (k<=i) and (q[k]<q[i] div q[j]) do inc(k);
                    if (k<i) and (q[i] mod q[j]=0) and (q[k]=q[i] div q[j]) then
                        begin
                            f[i,j]:=f[i,j]+f[k,j];
                            inc(k);
                        end;
                end;
            end;
        writeln(fo,f[top,1]);
        k:=top;
        truyvet(top,1);
    end;


begin
    assign(fi,tfi);
    assign(fo,tfo);
    reset(fi);
    rewrite(fo);
    xuli;
    close(fo);
end.