Factorial hasta 1000

[[seoane]]

Bueno, alguien que crea un programa para no tener que resolver los sudokus a mano , no podía contentarse con el algoritmo anterior.

Así que considerando que que 1000, incluso 10000, nos cabe dentro de una variable de tipo integer, podemos optimizar "un poco" el algoritmo de multiplicación.

Código Delphi [-]
program Fast;

{$APPTYPE CONSOLE}

uses
  SysUtils, Windows;

const
  Lon = 2600;
type
  TSuperLargo = array[0..Lon] of Byte;

function MulSuper(A: TSuperLargo; B: Integer): TSuperLargo;
var
  i,j: integer;
  Ac, Desp, Dig: Integer;
begin
  Desp:= 0;
  FillChar(Result,Sizeof(Result),#0);
  while B > 0 do
  begin
    Dig:= B mod 10;
    B:= B div 10;
    Ac:= 0;
    for i:= 0 to Lon - Desp do
    begin
      j:= Integer(Result[i+Desp]) + (Integer(A[i]) * dig) + Ac;
      Result[i+Desp]:= j mod 10;
      Ac:= j div 10;
    end;
    inc(Desp);
  end;
end;

function SuperToStr(a: TSuperLargo): string;
var
  i: integer;
  flag: Boolean;
begin
  Result:= '';
  flag:= FALSE;
  for i := Lon downto 0 do
  begin
    if flag then
      Result:= Result + IntToStr(a[i])
    else if a[i] > 0 then
    begin
      flag:= TRUE;
      Result:= Result + IntToStr(a[i]);
    end;
  end;
end;

function Factorial(i: integer): String;
var
  j: Integer;
  A: TSuperLargo;
begin
  FillChar(A,Sizeof(A),#0);
  A[0]:= 1;
  for j:= 2 to i do
  begin
    A:= MulSuper(A,j);
  end;
  Result:= SuperToStr(a);
end;

var
  Cont1, Cont2: int64;
  Frec: int64;
begin
  Writeln('Calculando el factorial de 1000 ...');
  Writeln;
  QueryPerformanceFrequency(Frec);
  QueryPerformanceCounter(Cont1);
  Writeln(Factorial(1000));
  QueryPerformanceCounter(Cont2);
  Writeln;
  Writeln;
  Writeln(Format('Se emplearon %d milisegundos',[((Cont2-Cont1) * 1000) div Frec]));
end.

La nueva marca es de tan solo 589 milisegundos

Que a gusto me he quedado

Edito:
El factorial de 10,000 (35,659 cifras) tarda 67,202 milisegundos, poco mas de un minuto.

Si alguien tiene curiosidad de saber cual es que se baje el adjunto