Cod sursa(job #188381)

Utilizator cezar305Mr. Noname cezar305 Data 8 mai 2008 09:44:27
Problema Descompuneri Scor 12
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.8 kb
var n,k,i,j,x,nd,f,a,b:longint;
    d:array[1..10000] of longint;
    v:array[1..1000,1..1000] of longint;

procedure qsort(ls,ld:longint);
var i,j,aux: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,l,r:longint):longint;
var m:longint;
begin
m:=(l+r) div 2;
if d[m]=t then
        begin
        cauta:=m;
        exit;
        end;
if l>=r then
        exit;
if t<d[m] then
        cauta:=cauta(t,l,m-1)
else
        cauta:=cauta(t,m+1,r);
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]);
close(input);close(output);
end.