Problema al generar primos en Delphi

[[nlsgarcia]]

Club Delphi,

Los siguientes programas son un Compendio de Cribas de Generación de Números Primos implementadas en Delphi:

Criba de Eratóstenes:

Código Delphi [-]
program GeneratorPrimeNumbers;

{
Cálculo de Números Primos por el Algoritmo: Criba de Eratóstenes (Versión 2).
}

uses
  Windows, SysUtils, Classes, Dialogs;

var
   Limit, RLimit : Integer;
   i, j: Integer;
   Numbers: TBits;
   F : TextFile;
   NumberPrime : Integer;
   TI, TF: TDateTime;
   Mnsj : String;

begin

   repeat
      try
         Limit := StrToInt(InputBox('Generador de Números Primos',
                                    'Número Primo Máximo a Calcular:', '1000'));
      except
         Limit := 0;
      end;
   until (Limit >= 2) and (Limit <= 2147483615);

   TI := Now;

   try

      Numbers := TBits.Create;
      Numbers.Size := Limit+1;
      RLimit := Trunc(Sqrt(Limit));
      NumberPrime := 0;

      for i := 2 to RLimit do
         if not Numbers[i] then
            for j := i to (Limit div i) do
               Numbers[i*j] := True;

      FileMode := fmOpenWrite;
      AssignFile(F, 'NumberPrime.txt');
      Rewrite(F);

      for i := 2 to Limit do
         if not Numbers[i] then
         begin
            // Writeln(F, Format('%.10d',[i]));
            Writeln(F, i);
            Inc(NumberPrime);
         end;

   finally

      Numbers.Free;
      CloseFile(F);

   end;

   TF := Now - TI;

   ThousandSeparator := '.';
   DecimalSeparator := ',';

   Mnsj := Format('Con el Número %s como Límite, Se Generaron %s Números Primos en %s',
                 [FormatFloat('#,###,###,###,##0',Limit),
                  FormatFloat('#,###,###,###,##0',NumberPrime),
                  FormatDateTime('hh:mm:ss:zzz', TF)
                 ]);

   MessageBox(0, PChar(Mnsj), 'Algoritmo: Criba de Eratóstenes', MB_OK + MB_ICONINFORMATION);

end.

Criba de Atkin:

Código Delphi [-]
program GeneratorPrimeNumbers;

{
Cálculo de Números Primos por el Algoritmo: Criba de Atkin Optimizada
}

uses
  Windows, SysUtils, Classes, Dialogs;

var
   Limit, RLimit : LongWord;
   i, j : Integer;
   n,k : LongWord;
   R1 : LongWord;
   R2 : LongWord;
   xStepsize : LongWord;
   y_limit : LongWord;
   s, min_y, yy : LongWord;

   Numbers : TBits;
   F : TextFile;
   NumberPrime : LongWord;
   TI, TF : TDateTime;
   Msg : String;

begin

   repeat
      try
         Limit := StrToInt(InputBox('Generador de Números Primos',
                                    'Número Primo Máximo a Calcular:', '1000'));
      except
         Limit := 0;
      end;
   until (Limit >= 2) and (Limit <= 2147483615);

   TI := Now;

   Numbers := TBits.Create;

   try

      Numbers.Size := Limit+1;
      RLimit := Trunc(Sqrt(Limit));
      NumberPrime := 0;

      // Inicio del cálculo de 3x^2 + y^2
      xStepsize := 3;
      y_limit := 0;
      n := 0;
      R1 := Trunc(Sqrt((Limit - 1) / 3));

      i := 0;
      while (i < 12 * R1) do
      begin
         xStepsize := xStepsize + i;
         y_limit := 12 * Trunc(Sqrt(Limit - xStepsize)) - 36;
         n := xStepsize + 16;
         j := -12;
         while(j < y_limit + 1) do
         begin
            n := n + j;
            Numbers[n] := not Numbers[n];
            Inc(j,72);
         end;

         n := xStepsize + 4;

         j := 12;
         while (j < y_limit + 1) do
         begin
            n := n + j;
            Numbers[n] := not Numbers[n];
            inc(j,72);
         end;
         inc(i,24);
      end;
      // Fin del cálculo de 3x^2 + y^2

      // Inicio del cálculo de 4x^2 + y^2
      xStepsize := 0;
      R1 := 8 * Trunc(Sqrt((Limit - 1) / 4)) + 4;

      i := 4;
      while (i < R1) do
      begin
         xStepsize := xStepsize + i;
         n := xStepsize + 1;

         if (xStepsize mod 3 <> 0) then
         begin
            R2 := 4 * Trunc(Sqrt(Limit - xStepsize)) - 3;
            j := 0;
            while (j < R2) do
            begin
               n := n + j;
               Numbers[n] := not Numbers[n];
               Inc(j,8);
            end;
         end
         else
         begin
            y_limit := 12 * Trunc(Sqrt(Limit - xStepsize)) - 36;
            n := xStepsize + 25;
            j := -24;
            while (j < y_limit + 1) do
            begin
               n := n + j;
               Numbers[n] := not Numbers[n];
               Inc(j,72);
            end;

            n := xStepsize + 1;

            j := 24;
            while (j < y_limit + 1) do
            begin
               n := n + j;
               Numbers[n] := not Numbers[n];
               inc(j,72);
            end;
         end;
         inc(i, 8);
      end;
      // Fin del cálculo de 4x^2 + y^2

      // Inicio del cálculo de 3x^2 - y^2
      xStepsize := 1;
      R1 := Trunc(Sqrt(Limit/2))+1;

      i := 3;
      while (i < R1) do
      begin
         xStepsize := xStepsize + (4 * i - 4);
         n := 3 * xStepsize;
         s := 4;
         if (n > Limit) then
         begin
            min_y := (Trunc(Sqrt(n - Limit)) shr 2) shl 2;
            yy := min_y * min_y;
            n := n - yy;
            s := 4 * min_y + 4;
         end
         else
            s := 4;

         j := s;
         while (j < 4 * i) do
         begin
            n := n - j;
            if (n <= Limit) and (n mod 12 = 11) then
               Numbers[n] := not Numbers[n];
            Inc(j,8);
         end;
         inc(i,2);
      end;

      xStepsize := 0;
      i := 2;
      while (i < R1) do
      begin
         xStepsize := xStepsize + (4 * i - 4);
         n := 3 * xStepsize;
         s := 0;
         if (n > Limit) then
         begin
            min_y := ((Trunc(Sqrt(n - Limit)) shr 2) shl 2) - 1;
            yy := min_y * min_y;
            n := n - yy;
            s := 4 * min_y + 4;
         end
         else
         begin
            n := n - 1;
            s := 0;
         end;

         j := s;
         while(j < 4 * i) do
         begin
            n := n - j;
            if (n <= Limit) and (n mod 12 = 11) then
               Numbers[n] := not Numbers[n];
            inc(j,8);
         end;
         inc(i,2);
      end;
      // Fin del cálculo de 3x^2 - y^2

      i := 5;
      while (i <= RLimit+1) do
      begin
         if Numbers[i] then
         begin
            k := i*i;
            while (k < Limit) do
            begin
               Numbers[k] := False;
               Inc(k,i*i);
            end;
         end;
         Inc(i,2);
      end;

      FileMode := fmOpenWrite;
      AssignFile(F, 'NumberPrime.txt');
      Rewrite(F);

      Numbers[2] := True;
      Numbers[3] := True;

      for i := 2 to Limit do
         if Numbers[i] then
         begin
            Writeln(F, i);
            Inc(NumberPrime);
         end;

   finally

      Numbers.Free;
      CloseFile(F);

   end;

   TF := Now - TI;

   ThousandSeparator := '.';
   DecimalSeparator := ',';

   Msg := Format('Con el Número %s como Límite, Se Generaron %s Números Primos en %s',
                 [FormatFloat('#,###,###,###,##0',Limit),
                  FormatFloat('#,###,###,###,##0',NumberPrime),
                  FormatDateTime('hh:mm:ss:zzz', TF)
                 ]);

   MessageBox(0, PChar(Msg), 'Algoritmo: Criba de Atkin', MB_OK + MB_ICONINFORMATION);

end.

Criba de Sundaram:

Código Delphi [-]
program GeneratorPrimeNumbers;

{
Cálculo de Números Primos por el Algoritmo: Criba de Sundaram
}

uses
  Windows, SysUtils, Classes, Dialogs;

var
   Limit, RLimit : LongWord;
   i, j, k : LongWord;
   Numbers: TBits;
   F : TextFile;
   NumberPrime : LongWord;
   TI, TF: TDateTime;
   Mnsj : String;
   maxVal : LongWord;
   denominator : LongWord;
   Prime : LongWord;

begin

   repeat
      try
         Limit := StrToInt(InputBox('Generador de Números Primos',
                                    'Número Primo Máximo a Calcular:', '1000'));
      except
         Limit := 0;
      end;
   until (Limit >= 2) and (Limit <= 2147483615);

   TI := Now;

   try

      Numbers := TBits.Create;
      k := Limit div 2;
      Numbers.Size := k + 1;
      NumberPrime := 0;

      maxVal := 0;
      denominator := 0;

      i := 1;
      while(i < k) do
      begin
         denominator := (i shl 1) + 1;
         maxVal := (k - i) div denominator;
         j := i;
         while(j <= maxVal) do
         begin
            Numbers[i + j * denominator] := True;
            inc(j);
         end;
         inc(i);
      end;

      FileMode := fmOpenWrite;
      AssignFile(F, 'NumberPrime.txt');
      Rewrite(F);
      Writeln(F, 2);
      Inc(NumberPrime);

      Prime := 0;
      i := 1;
      while(i < k) do
      begin
         if not Numbers[i] then
         begin
            Prime := (i shl 1) + 1;
            Writeln(F, Prime);
            Inc(NumberPrime);
         end;
         inc(i);
      end;

   finally

      Numbers.Free;
      CloseFile(F);

   end;

   TF := Now - TI;

   ThousandSeparator := '.';
   DecimalSeparator := ',';

   Mnsj := Format('Con el Número %s como Límite, Se Generaron %s Números Primos en %s',
                 [FormatFloat('#,###,###,###,##0',Limit),
                  FormatFloat('#,###,###,###,##0',NumberPrime),
                  FormatDateTime('hh:mm:ss:zzz', TF)
                 ]);

   MessageBox(0, PChar(Mnsj), 'Algoritmo: Sieve of Sundaram', MB_OK + MB_ICONINFORMATION);

end.

Todas las anteriores implementaciones permite calcular con el Número 2.147.483.615 como cota límite, un máximo de 105.097.563 Números Primos en tiempos variables, sobre una máquina con un Procesador Phenom II X6 1090T, 4 GB RAM, 3 TB HDD y Windows 7 Profesional x32, como se muestra en la siguiente imagen a continuación:



El tiempo indicado en la imagen para los diferentes algoritmos es el tiempo total de proceso desde que inicia el cálculo hasta que finaliza la generación del archivo de 1.12 GB con los 105.097.563 Números Primos, lo cual implica que la verificación de los números primos: se hace en un tiempo menor al indicado.

Espero sea útil

Nelson.