qow 14: prime number dismantling

hi experts,

i am starting a new quest: qow = question of the week :-)
each week i will introduce a new simple? question.

now qow 14

the first working solution will get the points (a graded).

sorry, top 15 experts, you are not allowed to solve this
q, only other can solve this question :-(

well the question is:
in math each positiv integer number is a product of prime numbers, like
   1 = 1 * 1
  21 = 3 * 7
 125 = 5 * 5 * 5
1768 = 2 * 2 * 2 * 13 * 17

a little sample is needed,
which does this dismantling
let say for numbers from 1 to 10000

i provide additional 25 points
for the fastest routine

let see

meikl ;-)
LVL 27
kretzschmarAsked:
Who is Participating?

[Product update] Infrastructure Analysis Tool is now available with Business Accounts.Learn More

x
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

AvonWyssCommented:
{$A+,B-,C+,D+,E-,F-,G+,H+,I-,J+,K-,L+,M-,N+,O+,P+,Q-,R-,S-,T-,U-,V+,W-,X+,Y+,Z1}
{$APPTYPE CONSOLE}

program SplitFactors2;

uses
     SysUtils;

function GetFactor(N: Integer): Integer;
var
     I,M,Act: Integer;
begin
     if N and 1=0 then
          Result:=2
     else begin
          Act:=3;
          I:=4;
          M:=Trunc(Sqrt(N));
          while (Act<=M) and (N mod Act>0) do begin
               Inc(Act,I);
               I:=6-I;
          end;
          if Act>M then // factor found?
               Result:=N
          else
               Result:=Act;
     end;
end;

var
     N,F: Integer;
     S: string;

begin
     N:=StrToInt(ParamStr(1));
     repeat
          F:=GetFactor(N);
          if F=N then begin
               S:=S+IntToStr(F);
               Break;
          end else
               S:=S+IntToStr(F)+' * ';
          N:=N div F;
     until False;
     WriteLn(S);
end.

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
AvonWyssCommented:
Btw, it would be more interesting to have this for values up to 2^30 or so. Because that's when inefficient algorithms will start being slower...
God_AresCommented:
this is my collection of stuff regarding this supbject, your question will be awnserd with the p-row functions p-pow stands for prime-row

() =1
(1) = 2
(0,1) =3
(0,0,1) =5


unit Udw6;

interface

Uses sysutils,math,primes;

Type
    TProw = Array of Byte;
    TNumberRow = Array of Cardinal;
    EFactorizeException = class(Exception);
    TLargeNumber = class
    private
      FNumber : TNumberRow;
    public
      Constructor Create(Number : String);
    end;

Function IsPrime(N: Cardinal): Boolean; register;
Function LargestKnownPrime : Cardinal;
Function NumberToPRow(a : Cardinal):TProw;
Function PRowToString(PRow:TProw):String;
Function IsDevider(Number,devisor:Cardinal):Boolean;
Function PRowToNumber(PRow:TProw):Cardinal;
Function CommonMultiple(a,b:Cardinal):Cardinal;
Function CommonDenominator(a,b:Cardinal):Cardinal;
Function CommonDenominator_1(a,b:Cardinal):Cardinal;
Function Euler(a:Cardinal):Cardinal;



//function CommonDenominator(a,b: Cardinal) : Cardinal;


implementation

function IsPrime(N: Cardinal): Boolean; register;
// test if N is prime, do some small Pseudo Prime test in certain bounds
// copyright (c) 2000 Hagen Reddmann, don't remove
asm
      TEST  EAX,1           // Odd(N) ??
      JNZ   @@1
      CMP   EAX,2           // N == 2 ??
      SETE  AL
      RET
@@1:   CMP   EAX,73           // N  < 73 ??
      JB    @@C
      JE    @@E           // N == 73 ??
      PUSH  ESI
      PUSH  EDI
      PUSH  EBX
      PUSH  EBP
      PUSH  EAX           // save N as Param for @@5
      LEA   EBP,[EAX - 1]    // M == N -1, Exponent
      MOV   ECX,32           // calc remaining Bits of M and shift M'
      MOV   ESI,EBP
@@2:   DEC   ECX
      SHL   ESI,1
      JNC   @@2
      PUSH  ECX           // save Bits as Param for @@5
      PUSH  ESI           // save M' as Param for @@5
      CMP   EAX,08A8D7Fh     // N >= 9080191 ??
      JAE   @@3
// now if (N < 9080191) and SPP(31, N) and SPP(73, N) then N is prime
      MOV   EAX,31
      CALL  @@5           // 31^((N-1)(2^s)) mod N
      JC    @@4
      MOV   EAX,73           // 73^((N-1)(2^s)) mod N
      PUSH  OFFSET @@4
      JMP   @@5
// now if (N < 4759123141) and SPP(2, N) and SPP(7, N) and SPP(61, N) then N is prime
@@3:   MOV   EAX,2
      CALL  @@5
      JC    @@4
      MOV   EAX,7
      CALL  @@5
      JC    @@4
      MOV   EAX,61
      CALL  @@5
@@4:   SETNC AL
      ADD   ESP,4 * 3
      POP   EBP
      POP   EBX
      POP   EDI
      POP   ESI
      RET
// do a Strong Pseudo Prime Test
@@5:   MOV   EBX,[ESP + 12]   // N on stack
      MOV   ECX,[ESP +  8]   // remaining Bits
      MOV   ESI,[ESP +  4]   // M'
      MOV   EDI,EAX           // T = b, temp. Base
@@6:   DEC   ECX
      MUL   EAX
      DIV   EBX
      MOV   EAX,EDX
      SHL   ESI,1
      JNC   @@7
      MUL   EDI
      DIV   EBX
      AND   ESI,ESI
      MOV   EAX,EDX
@@7:   JNZ   @@6
      CMP   EAX,1           // b^((N -1)(2^s)) mod N ==  1 mod N ??
      JE    @@A
@@8:   CMP   EAX,EBP           // b^((N -1)(2^s)) mod N == -1 mod N ?? , EBP = N -1
      JE    @@A
      DEC   ECX           // second part to 2^s
      JNG   @@9
      MUL   EAX
      DIV   EBX
      CMP   EDX,1
      MOV   EAX,EDX
      JNE   @@8
@@9:   STC
@@A:   RET
@@B:   DB    3,5,7,11,13,17,19,23,29,31,37,41,43,47,53,59,61,67,71
@@C:   MOV   EDX,OFFSET @@B
      MOV   ECX,18
@@D:   CMP   AL,[EDX + ECX]
      JE    @@E
      DEC   ECX
      JNL   @@D
@@E:   SETE  AL
end;

Function IsDevider(Number,devisor:Cardinal):Boolean;
Begin
  Result := Number mod devisor = 0;
End;

Function LargestKnownPrime : Cardinal;
Begin
  Result := PrimeTable[CPrimeLast];
End;

Function NumberToPRow(a : Cardinal):TProw;
Var Prow : TPRow;
    Pindex : Integer;

Begin
  Pindex:=1;
  SetLength(Prow,0);
  While not(a=1) Do
  Begin
    SetLength(Prow,Pindex);
    If (a mod PrimeTable[Pindex]) = 0 Then
    Begin
      a := a div PrimeTable[Pindex];
      Inc(Prow[Pindex-1]);
    End Else
    Begin
      Pindex := Pindex+1;
      if (Pindex=CPrimeLast) Then
        raise EFactorizeException.Create('Prime Index out of range. The number is too big to factorize');
    End;
  End;
  result := Prow;
End;

Function PRowToNumber(PRow:TProw):Cardinal;
var r,i,j:Cardinal;
Begin
  r:=1;
  i:=0;
  While i<length(Prow) Do
  Begin
    inc(i);
    if (Prow[i-1])>0 then
    Begin
      j:=0;
      while not (Prow[i-1] = j) do
      Begin
        r:=r *  PrimeTable[i];
        inc(j);
      end;
    end;
  End;
  result := r;
End;

Function PRowToString(PRow:TProw):String;
Var     I:Integer;
        S:String;
Begin
  s:='(';
  For i:=0 to Length(PRow)-1 Do
    s := s + IntToStr(Prow[i])+',';
  delete(s,length(s),1);
  s := s+')';
  result := s;
End;

Function CommonDenominator(a,b:Cardinal):Cardinal;
Begin
  while (a>0) and (b>0) do
  Begin
    if a>b then
      a := a - b
    else
      b := b - a;
  end;
  if a=0 then
    result := b
  else
    result := a;
End;

Function CommonDenominator_1(a,b:Cardinal):Cardinal;
//(2,3)=1
Var
  Pa : TProw;
  Pb : TProw;
  Pc : TProw;
  i,la,lb,longest : Integer;
Begin
  Pa := NumberToPRow(a);
  Pb := NumberToPRow(b);
  la := Length(Pa);
  lb := Length(Pb);
  if la>lb then
    longest := la
  else
    longest := lb;

  i:=0;
  SetLength(Pc,longest);
  while i<longest do
  Begin
    if (i<la) and (i<lb) Then
      Pc[i] := min(Pa[i],Pb[i])
    else
      if la>lb then
        Pc[i] := 0
      else
        Pc[i] := 0;
    inc(i);
  end;
  result := PRowToNumber(pc);
end;

Function Euler(a:Cardinal):Cardinal;
var t,i:Cardinal;
Begin
  t:=0;i:=0;
  while i<a do
  Begin
    if commonDenominator(i,a) = 1 then inc(t);
    inc(i);
  end;
  result := t;
End;

Function CommonMultiple(a,b:Cardinal):Cardinal;
//(2,3)=1
Var
  Pa : TProw;
  Pb : TProw;
  Pc : TProw;
  i,la,lb,longest : Integer;
Begin
  Pa := NumberToPRow(a);
  Pb := NumberToPRow(b);
  la := Length(Pa);
  lb := Length(Pb);
  if la>lb then
    longest := la
  else
    longest := lb;

  i:=0;
  SetLength(Pc,longest);
  while i<longest do
  Begin
    if (i<la) and (i<lb) Then
      Pc[i] := max(Pa[i],Pb[i])
    else
      if la>lb then
        Pc[i] := Pa[i]
      else
        Pc[i] := Pb[i];
    inc(i);
  end;
  result := PRowToNumber(pc);
end;

//TLargeNumber

Constructor TLargeNumber.Create(Number : String);
Var pos,x : Cardinal;
    l,t:Cardinal;
Begin
  //Max       0..999999999 [9 char]
  //Cardinal      0..4294967295      unsigned 32-bit

  l := Length(Number);
  T := (l div 6) + 1; //calculate how many cardinals are nessesary
  SetLength(FNumber,t);

  pos :=0;
  While l>5 Do
  Begin
    x := StrToInt(Copy(Number,pos,5));
    Inc(Pos,5);
    Fnumber[t] := x;
    Dec(T);
    Dec(l,5);
  End;

  If l>0 Then
  Begin
    x := StrToInt(Copy(Number,1,l));
    Fnumber[T] := x;
  End;

End;

end.


btw i made an unit of constants

unit primes;
interface
Const
  CPrimeLast = 78498;

  PrimeTable : array[1..CPrimeLast] of cardinal =(
      2,3,5,7,11,13,17,
      19,23,29,31,37,41,43,
      47,53,59,61,67,71,73,
      79,83,89,97,101,103,107,
      109,113,127,131,137,139,149,
etc..
etc..
etc..

  999983);

i could mail the file (ziped) to you if you want..

Become a Microsoft Certified Solutions Expert

This course teaches how to install and configure Windows Server 2012 R2.  It is the first step on your path to becoming a Microsoft Certified Solutions Expert (MCSE).

kretzschmarAuthor Commented:
well, ok, NEW upper limit := maxlongint

hopefully, some more will join this quest

meikl ;-)


kretzschmarAuthor Commented:
yep, god ares,
mail it to me at
info@meikl.de

because i must test the performance
(two solutions at the moment)
(i may ignore the new limit for you, as i see there is a constant prime-number-array defined there, which may not high enough)

send it, god ares

meikl ;-)

MBoCommented:
It isn't speed optimized due to embedded pretty output formatting ;)


procedure TForm1.Button2Click(Sender: TObject);
var
        PrList:Tlist;
        MulList:TStringList;
        i,Num,Temp,MaxPrime:integer;
        s:string;
        N:integer;
begin
N:=10000;
PrList:=Tlist.Create;
PrList.Capacity:=100;
MulList:=TStringList.Create;
MulList.Capacity:=N;
for Num:=2 to N do begin
  Temp:=Num;
  MaxPrime:=2;
  s:=IntToStr(Temp)+'=';
  i:=-1;
  while (Temp >= MaxPrime) and (i<PrList.Count-1) do begin
    inc(i);
    while (Temp >= MaxPrime) and (Temp mod Integer(PrList[i])=0) do begin
        MaxPrime:=Integer(PrList[i]);
        Temp:=Temp Div MaxPrime;
        s:=s+IntToStr(MaxPrime)+'*';
     end;
  end;
  if Temp=Num then begin
     PRList.Add(Pointer(Num));
     s:=s+'Prime';
     end
   else Delete(s,Length(s),1);
   MulList.add(s);
end;
PrList.Free;
MulList.SaveToFile('C:\Primes.txt');
MulList.Free;
end;
AvonWyssCommented:
Ah, if you mean calculating not only one out of 1 to 10000 but all, use the following code:

function GetFactor(N: Integer): Integer;
const
     KnownPrimes: array[0..24] of Cardinal=(2,3,5,7,$B,$D,17,19,23,29,31,37,41,43,47,53,59,61,67,71,73,79,83,89,97);
var
     I: Integer;
begin
     I:=Low(KnownPrimes);
     repeat
          if (N mod KnownPrimes[I])=0 then begin
               Result:=KnownPrimes[I];
               Exit;
          end;
          Inc(I);
     until I>High(KnownPrimes);
     Result:=N;
end;

function GetFactorString(N: Integer): string;
var
     F: Integer;
begin
     Result:=Format('%:5d = ',[N]);
     repeat
          F:=GetFactor(N);
          if F=N then begin
               Result:=Result+IntToStr(F);
               Exit;
          end else
               Result:=Result+IntToStr(F)+' * ';
          N:=N div F;
     until False;
end;

var
     I: integer;
     S: string;

begin
     for I:=1 to 10000 do begin
          S:=GetFactorString(I);
//          WriteLn(S);
     end;
     WriteLn('Done!');
     ReadLn;
end.

I commented out the WriteLn to allow measuring the speed of the computations (vs the speed of the display output *g*). Of course, you can uncomment it to veryfy the correctness of the string contents.
God_AresCommented:
i guezz i should make a thread that calculates primes while running and make a nice data structure to store it. anyway i'm stuck to the limit of high(cardinal), I'm working on a !!!BIG!!! number structure..

shurl i'll lose but this may be code that other may improve on, or just (re*)-steal and use.

* i'v "stolen" isPrine(Cardinal)
kretzschmarAuthor Commented:
seems i've much to do testing :-)

well, seems also that avonwyss got this q
(because as first, but i must check the result first)

well,
which code will be the fastest,
and gets the additional points?

i keep this q open until next friday,
so that all can tuning their codes
and others may join until then :-)

first performance tests this evening (in ~8 hours from now),
i will provide an intermediate resultlist then :-))

meikl ;-)
AvonWyssCommented:
Well. For a greater range, actually for *any* number up to 9223372036854775807, I propose the following:

Include file with precomputed primes: http://web.bsn.ch/avonwyss/primes.inc

function GetFactor(N: Int64): Int64;
const
     KnownPrimes: array[0..102537] of Cardinal=({$I PRIMES.INC});
var
     I: Integer;
     M,J,Act: Cardinal;
     N64: Int64 absolute N;
     N32: Cardinal absolute N;
     NC: Comp absolute N;
begin
     I:=0;
     Act:=2;
     M:=Trunc(Sqrt(NC));
     if M<65536 then begin
          J:=N32;
          while (Act<=M) and (J mod Act>0) do begin //32 bit divisions
               Act:=KnownPrimes[I];
               Inc(I);
          end;
     end else begin
          if M>=KnownPrimes[High(KnownPrimes)] then
               J:=KnownPrimes[High(KnownPrimes)-1]
          else
               J:=M;
          while (Act<=J) and (N64 mod Act>0) do begin //64 bit divisions
               Act:=KnownPrimes[I];
               Inc(I);
          end;
          if Act<=M then begin
               J:=(3-(Act mod 3))*2;
               while (Act<=M) and (N64 mod Act>0) do begin //64 bit divisions without primes, avoiding 2 or 3-dividers
                    Inc(Act,J);
                    J:=6-J;
               end;
          end;
     end;
     if Act>M then // factor found?
          Result:=N
     else
          Result:=Act;
end;

function GetFactorString(N: Int64): string;
var
     F: Int64;
begin
     Result:=Format('%d = ',[N]);
     repeat
          F:=GetFactor(N);
          if F=N then begin
               Result:=Result+IntToStr(F);
               Exit;
          end else
               Result:=Result+IntToStr(F)+' * ';
          N:=N div F;
     until False;
end;

:-)
kretzschmarAuthor Commented:
well, an array of known prime-numbers,
which contains all until maxlongint,
will push performance, of course :-))

(maybe a new quest?
a list/array a prime numbers until maxlongint is needed,
how to build it at runtime?)

meikl ;-)
God_AresCommented:
(maybe a new quest?
a list/array a prime numbers until maxlongint is needed,
how to build it at runtime?)

= ongoing progress...
AvonWyssCommented:
Well, with the include file I use, there are about 400 kbyte worth of primes... :-))
That's already a good starting point...
God_AresCommented:
To all: I respectfully give up..

i would like to leave this link :

http://www.mail-archive.com/cryptography%40wasabisystems.com/msg01830.html
kretzschmarAuthor Commented:
:-(
god ares, why give up?
ginsonicCommented:
interested
kretzschmarAuthor Commented:
sorry,
had no time for testing this evening,
family catched me before :-(

tomorrow evening,
i will post the first results (hopefully)

meikl ;-)
God_AresCommented:
k done it...
i'm running a thread that makes the primetable on the run (linkedList)..
i'm dumping all code to kretzschmar.

unit Udw6;

interface

Uses sysutils,math,primes,classes;

Type
    TProw = Array of Byte;
    TNumberRow = Array of Cardinal;
    EFactorizeException = class(Exception);
    PPrimeList = ^TPrimeList;
    TPrimeList = record
                   prime : Cardinal;
                   nr    : Cardinal;
                   pref  : PPrimeList;
                   next  : PPrimeList;
                 end;


    TLargeNumber = class //not operational
    private
      FNumber : TNumberRow;
    public
      Constructor Create(Number : String);
    end;

    TPrimeThread = class(TThread)
    private
      fTestNumber : Cardinal;
      fprimeNr : Cardinal;
      fWork : PPrimeList;
    protected
      procedure Execute; override;
    public
      Constructor Create(first : PPrimeList);
      Destructor Destroy; override;
    end;

Function IsPrime(N: Cardinal): Boolean; register;
Function LargestKnownPrime : Cardinal;
Function NumberToPRow(a : Cardinal):TProw;
Function PRowToString(PRow:TProw):String;
Function IsDevider(Number,devisor:Cardinal):Boolean;
Function PRowToNumber(PRow:TProw):Cardinal;
Function CommonMultiple(a,b:Cardinal):Cardinal;
Function CommonDenominator(a,b:Cardinal):Cardinal;
Function CommonDenominator_1(a,b:Cardinal):Cardinal;
Function Euler(a:Cardinal):Cardinal;
Function FindPrime(nr:Cardinal):Cardinal;

//function CommonDenominator(a,b: Cardinal) : Cardinal;
var PrimeThread : TPrimeThread;


implementation

var last,first : PPrimeList;

function IsPrime(N: Cardinal): Boolean; register;
// test if N is prime, do some small Pseudo Prime test in certain bounds
// copyright (c) 2000 Hagen Reddmann, don't remove
asm
      TEST  EAX,1           // Odd(N) ??
      JNZ   @@1
      CMP   EAX,2           // N == 2 ??
      SETE  AL
      RET
@@1:   CMP   EAX,73           // N  < 73 ??
      JB    @@C
      JE    @@E           // N == 73 ??
      PUSH  ESI
      PUSH  EDI
      PUSH  EBX
      PUSH  EBP
      PUSH  EAX           // save N as Param for @@5
      LEA   EBP,[EAX - 1]    // M == N -1, Exponent
      MOV   ECX,32           // calc remaining Bits of M and shift M'
      MOV   ESI,EBP
@@2:   DEC   ECX
      SHL   ESI,1
      JNC   @@2
      PUSH  ECX           // save Bits as Param for @@5
      PUSH  ESI           // save M' as Param for @@5
      CMP   EAX,08A8D7Fh     // N >= 9080191 ??
      JAE   @@3
// now if (N < 9080191) and SPP(31, N) and SPP(73, N) then N is prime
      MOV   EAX,31
      CALL  @@5           // 31^((N-1)(2^s)) mod N
      JC    @@4
      MOV   EAX,73           // 73^((N-1)(2^s)) mod N
      PUSH  OFFSET @@4
      JMP   @@5
// now if (N < 4759123141) and SPP(2, N) and SPP(7, N) and SPP(61, N) then N is prime
@@3:   MOV   EAX,2
      CALL  @@5
      JC    @@4
      MOV   EAX,7
      CALL  @@5
      JC    @@4
      MOV   EAX,61
      CALL  @@5
@@4:   SETNC AL
      ADD   ESP,4 * 3
      POP   EBP
      POP   EBX
      POP   EDI
      POP   ESI
      RET
// do a Strong Pseudo Prime Test
@@5:   MOV   EBX,[ESP + 12]   // N on stack
      MOV   ECX,[ESP +  8]   // remaining Bits
      MOV   ESI,[ESP +  4]   // M'
      MOV   EDI,EAX           // T = b, temp. Base
@@6:   DEC   ECX
      MUL   EAX
      DIV   EBX
      MOV   EAX,EDX
      SHL   ESI,1
      JNC   @@7
      MUL   EDI
      DIV   EBX
      AND   ESI,ESI
      MOV   EAX,EDX
@@7:   JNZ   @@6
      CMP   EAX,1           // b^((N -1)(2^s)) mod N ==  1 mod N ??
      JE    @@A
@@8:   CMP   EAX,EBP           // b^((N -1)(2^s)) mod N == -1 mod N ?? , EBP = N -1
      JE    @@A
      DEC   ECX           // second part to 2^s
      JNG   @@9
      MUL   EAX
      DIV   EBX
      CMP   EDX,1
      MOV   EAX,EDX
      JNE   @@8
@@9:   STC
@@A:   RET
@@B:   DB    3,5,7,11,13,17,19,23,29,31,37,41,43,47,53,59,61,67,71
@@C:   MOV   EDX,OFFSET @@B
      MOV   ECX,18
@@D:   CMP   AL,[EDX + ECX]
      JE    @@E
      DEC   ECX
      JNL   @@D
@@E:   SETE  AL
end;

Function IsDevider(Number,devisor:Cardinal):Boolean;
Begin
  Result := Number mod devisor = 0;
End;

Function LargestKnownPrime : Cardinal;
Begin
  Result := last^.prime;
End;

Function NumberToPRow(a : Cardinal):TProw;
Var Prow : TPRow;
    Pindex : Integer;
    Prime : Cardinal;
    UsingList : PPrimeList;

Begin
  Pindex:=1;
  SetLength(Prow,0);
  UsingList := first;
  While not(a=1) Do
  Begin
    SetLength(Prow,Pindex);

    if Pindex <=CPrimeLast then
      Prime := PrimeTable[Pindex]
    else
    Begin
      Prime := UsingList^.prime;
      Usinglist := Usinglist^.next;
      if (UsingList = nil) Then
        raise EFactorizeException.Create('Prime Index out of range. The number is too big to factorize');
    end;
    If (a mod Prime) = 0 Then
    Begin
      a := a div PrimeTable[Pindex];
      Inc(Prow[Pindex-1]);
    End Else
    Begin
      Pindex := Pindex+1;
      if (Pindex=last^.nr) Then
        raise EFactorizeException.Create('Prime Index out of range. The number is too big to factorize');
    End;
  End;
  result := Prow;
End;

Function PRowToNumber(PRow:TProw):Cardinal;
var r,i,j:Cardinal;
Begin
  r:=1;
  i:=0;
  While i<length(Prow) Do
  Begin
    inc(i);
    if (Prow[i-1])>0 then
    Begin
      j:=0;
      while not (Prow[i-1] = j) do
      Begin
        r:=r *  PrimeTable[i];
        inc(j);
      end;
    end;
  End;
  result := r;
End;

Function PRowToString(PRow:TProw):String;
Var     I:Integer;
        S:String;
Begin
  s:='(';
  For i:=0 to Length(PRow)-1 Do
    s := s + IntToStr(Prow[i])+',';
  delete(s,length(s),1);
  s := s+')';
  result := s;
End;

Function CommonDenominator(a,b:Cardinal):Cardinal;
Begin
  while (a>0) and (b>0) do
  Begin
    if a>b then
      a := a - b
    else
      b := b - a;
  end;
  if a=0 then
    result := b
  else
    result := a;
End;

Function CommonDenominator_1(a,b:Cardinal):Cardinal;
//(2,3)=1
Var
  Pa : TProw;
  Pb : TProw;
  Pc : TProw;
  i,la,lb,longest : Integer;
Begin
  Pa := NumberToPRow(a);
  Pb := NumberToPRow(b);
  la := Length(Pa);
  lb := Length(Pb);
  if la>lb then
    longest := la
  else
    longest := lb;

  i:=0;
  SetLength(Pc,longest);
  while i<longest do
  Begin
    if (i<la) and (i<lb) Then
      Pc[i] := min(Pa[i],Pb[i])
    else
      if la>lb then
        Pc[i] := 0
      else
        Pc[i] := 0;
    inc(i);
  end;
  result := PRowToNumber(pc);
end;

Function Euler(a:Cardinal):Cardinal;
var t,i:Cardinal;
Begin
  t:=0;i:=0;
  while i<a do
  Begin
    if commonDenominator(i,a) = 1 then inc(t);
    inc(i);
  end;
  result := t;
End;

Function CommonMultiple(a,b:Cardinal):Cardinal;
//(2,3)=1
Var
  Pa : TProw;
  Pb : TProw;
  Pc : TProw;
  i,la,lb,longest : Integer;
Begin
  Pa := NumberToPRow(a);
  Pb := NumberToPRow(b);
  la := Length(Pa);
  lb := Length(Pb);
  if la>lb then
    longest := la
  else
    longest := lb;

  i:=0;
  SetLength(Pc,longest);
  while i<longest do
  Begin
    if (i<la) and (i<lb) Then
      Pc[i] := max(Pa[i],Pb[i])
    else
      if la>lb then
        Pc[i] := Pa[i]
      else
        Pc[i] := Pb[i];
    inc(i);
  end;
  result := PRowToNumber(pc);
end;

//TLargeNumber

Constructor TLargeNumber.Create(Number : String);
Var pos,x : Cardinal;
    l,t:Cardinal;
Begin
  //Max       0..999999999 [9 char]
  //Cardinal      0..4294967295      unsigned 32-bit

  l := Length(Number);
  T := (l div 6) + 1; //calculate how many cardinals are nessesary
  SetLength(FNumber,t);

  pos :=0;
  While l>5 Do
  Begin
    x := StrToInt(Copy(Number,pos,5));
    Inc(Pos,5);
    Fnumber[t] := x;
    Dec(T);
    Dec(l,5);
  End;

  If l>0 Then
  Begin
    x := StrToInt(Copy(Number,1,l));
    Fnumber[T] := x;
  End;

End;


Constructor TPrimeThread.Create(first : PPrimeList);
Begin

  inherited create(false);
  fTestNumber := PrimeTable[CPrimeLast];
  fprimeNr := first.nr;
  fWork := first;
End;

Procedure TPrimeThread.Execute;
var newP : PPrimeList;
Begin
  while Not((fTestNumber = 4294967295)) do
  Begin
    fTestNumber := fTestNumber + 2; //only odds qualify above 2
    if IsPrime(fTestNumber) then
    Begin
      fprimeNr := fprimeNr + 1;
      new(newP);                   //prepare new
      newP^.pref := fwork;
      newP^.nr := fprimeNr;
      newP^.prime := 0;            //prime not found

      fwork^.prime := fTestNumber; //save number
      fwork^.next := newP;         //make chain

      last := fwork;               //set new work unit
      fwork := newP;
    end;
  End;
End;

Destructor TPrimeThread.Destroy;
Var Pl : PPrimeList;
Begin

  //destroy prime list
  dispose(fWork);
  While Not (last^.pref = nil) Do
  Begin
    pl := Last^.pref;
    Dispose(last);
    last := pl;
  End;

  inherited;
end;

Function FindPrime(nr:Cardinal):Cardinal;
var find:PPrimeList;
Begin

  if nr <= CPrimeLast then
    result := PrimeTable[nr]
  else
  Begin
    find := first;
    while not ((find=nil) or (find^.nr = nr)) do
    Begin
      find := find^.next;
    end;
    if find = nil then
      result := 0 //not found
    else
      result := find^.prime;

  end;

end;


Begin
  new(first);
  first^.nr := CPrimeLast+1;
  PrimeThread := TPrimeThread.Create(first);  //create and GO!
  last := nil;
end.
God_AresCommented:
function is suitable for cardinals

remeber (prime1 * prime2) could be > High(Cardinal)
kretzschmarAuthor Commented:
well thanks god ares, got it

to all,
but it seems i have to do the tests coming weekend,
because i've just to do other things :-(

be patient

meikl ;-)
kretzschmarAuthor Commented:
for the first solution

god_ares/MBo watch out for your q's
(didn't got the time for a performance test,
thats why i grade every, which are provising a solution,
but i guess god_ares code is the fastest)

thanks to all for participating on this quest
watch out for the next qow today
(also a mathematical problem)

meikl ;-)
Igor UL7AAjrSenior developerCommented:
hi all,

just another way :-)

var
  // after calling ResetNoPrimes this array
  // contains True for Prime indexes
  X: array [1..10000] of Boolean;

procedure ResetNoPrimes;
var
  I, J: Integer;
begin
  FillChar(X, SizeOf(X), True);
  for I := 2 to High(X) do
    for J := 2 to High(X) do
      if I * J <= High(X) then
        X[I * J] := False;
end;
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Delphi

From novice to tech pro — start learning today.