Нужен совет: найти быстрый способ вычисления по формуле (1 сек)

type vector=array [1..1000] of byte;
type TBytes=Set of byte;
procedure SimpleNum(var a:vector;num:integer;c:TBytes);
var i,j,k,l,m,n:integer;
begin
j:=2;
while(num<>1) do begin
while (num mod j=0) do   begin
if (num mod j=0) and (j in c) then      begin
inc(a[j]);
num:=num div j;
                                        end
 
 
                      end;
                       inc(j);
                end;
 
end;
 
function Stepen(i:byte;p:byte):longint;
var pres:longint;
begin
pres:=1;
while p<>0 do begin
pres:=pres*i;
dec(p);
end;
Stepen:=pres;
end;
 
var i,j,n,k:integer;
res:longint;
mastop:vector;
maslow:vector;
Mn:TBytes;
begin
Mn:=[2,3,5,7,11,13,17,19,23,29,31,37,41,43,47,53,57,59];
res:=1;
readln(n,k);
 
for i:=n-k+1 to n do
SimpleNum(mastop,i,Mn);
 
for i:=2 to k do
SimpleNum(maslow,i,Mn);
 
for i:=1 to 60 do
mastop[i]:=mastop[i]-maslow[i];
 
for i:=1 to 60 do
res:=res*Stepen(i,mastop[i]);
 
writeln(res);
 
 
 
 
 
end.

procedure StrMul(var n: String; m: Word);
const Digits=['0'..'9'];
var
  i, c: Word;
  s: String;
begin
  c:=0;
  for i:=Length(n) downto 1 do
    if n[i] in Digits then begin
      c:=c+(Ord(n[i])-Ord('0'))*m;
      n[i]:=Chr(Ord('0')+c mod 10);
      c:=c div 10;
    end;
  if c>0 then begin
    Str(c,s); Insert(s,n,2-Ord(s[1] in Digits));
  end;
end;
const
  nmax=120;
  p: array [1..4] of Integer = (2,3,5,7);
var
  v: array [2..nmax] of Integer;
  n, k, nn, i, j: Integer;
  s: String[20];
  r: Int64 = 1;
begin
  FillChar(v,SizeOf(v),#0);
  ReadLn(n,k);
  if n-k>k then k:=n-k;
  for i:=k+1 to n do begin
    nn:=i;
    for j:=1 to 4 do
      while nn mod p[j]=0 do begin
        Inc(v[p[j]]); nn:=nn div p[j];
      end;
    if nn>0 then Inc(v[nn]);
  end;
  for i:=2 to n-k do begin
    nn:=i;
    for j:=1 to 4 do
      while nn mod p[j]=0 do begin
        Dec(v[p[j]]); nn:=nn div p[j];
      end;
    if nn>0 then Dec(v[nn]);
  end;
  for i:=nmax downto 2 do
    while (v[i]>0) and (r*i>r) do begin
      r:=r*i; Dec(v[i]);
    end;
  Str(r,s);
  for i:=nmax downto 2 do
    while v[i]>0 do begin
      StrMul(s,i); Dec(v[i]);
    end;
  WriteLn(s);
end.