Cod sursa(job #1024903)

Utilizator hungntnktpHungntnktp hungntnktp Data 9 noiembrie 2013 12:17:20
Problema Descompuneri Scor 30
Compilator fpc Status done
Runda Arhiva de probleme Marime 2.81 kb
program DESC;
const
        inp='desc.in';
        oup='desc.out';
        max=160000;
var
        f:text;
        Dp:array[1..max,1..400] of int64;
        Check:array[1..max,1..400] of boolean;
        res:array[1..1000] of longint;
        N,K,Cres,Num:int64;
(*              *)
procedure nhap;
begin
        assign(f,inp);  reset(f);
        readln(f,n,k);
        close(f);
end;
(*              *)
function Dpsearch(s,k:int64):int64;
var     i:longint;
        res:int64;
begin
        if k=1 then
                begin
                        if (k<=400) and (s<=160000) then Dp[s,k]:=1;
                        exit(1);
                end;
        if s=1 then
                begin
                        if (k<=400) and (s<=160000) then Dp[s,k]:=1;
                        exit(1);
                end;
        if (k<=400) and (s<=160000) and check[s,k] then exit(Dp[s,k]);
        res:=0;
        for i:=k to trunc(sqrt(s)) do if s mod i = 0 then
                begin
                        Res:=res+Dpsearch(s div i,i);
                end;
        Res:=Res+1;
        if (k<=400) and (s<=160000) then Dp[s,k]:=res;
        if (k<=400) and (s<=160000) then check[s,k]:=true;
        exit(res);
end;
(*              *)
procedure tinh;
var     s,p,c:int64;
        i,j:longint;
        ok:boolean;
begin
        Cres:=Dpsearch(n,2);
        s:=n;
        j:=2;
        p:=k;
        repeat
                ok:=false;
                for i:=j to trunc(sqrt(s)) do if s mod i=0 then
                        begin
                                c:=Dpsearch(s div i,i);
                                if p>c then
                                        begin
                                                p:=p-c;
                                        end
                                else
                                        begin
                                                inc(num);
                                                res[num]:=i;
                                                s:=s div i;
                                                j:=i;
                                                ok:=true;
                                                break;
                                        end;
                        end;
                if not ok then
                        begin
                                inc(num);
                                Res[num]:=s;
                                s:=s div s;
                        end;
        until s=1;
end;
(*              *)
procedure xuat;
var     i:longint;
begin
        assign(f,oup);  rewrite(f);
        writeln(f,cres);
        for i:=1 to num do write(f,res[i],' ');
        close(f);
end;
(*              *)
BEGIN
        nhap;
        tinh;
        xuat;
END.