Solved

qow 14: prime number dismantling

Posted on 2002-04-08
22
335 Views
Last Modified: 2010-04-04
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 ;-)
0
Comment
Question by:kretzschmar
  • 8
  • 6
  • 5
  • +3
22 Comments
 
LVL 14

Accepted Solution

by:
AvonWyss earned 25 total points
ID: 6925027
{$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.
0
 
LVL 14

Expert Comment

by:AvonWyss
ID: 6925030
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...
0
 
LVL 7

Expert Comment

by:God_Ares
ID: 6925037
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..

0
 
LVL 27

Author Comment

by:kretzschmar
ID: 6925040
well, ok, NEW upper limit := maxlongint

hopefully, some more will join this quest

meikl ;-)


0
 
LVL 27

Author Comment

by:kretzschmar
ID: 6925047
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 ;-)

0
 
LVL 1

Expert Comment

by:MBo
ID: 6925060
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;
0
 
LVL 14

Expert Comment

by:AvonWyss
ID: 6925064
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.
0
 
LVL 7

Expert Comment

by:God_Ares
ID: 6925071
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)
0
 
LVL 27

Author Comment

by:kretzschmar
ID: 6925087
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 ;-)
0
 
LVL 14

Expert Comment

by:AvonWyss
ID: 6925095
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;

:-)
0
 
LVL 27

Author Comment

by:kretzschmar
ID: 6925098
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 ;-)
0
Free Trending Threat Insights Every Day

Enhance your security with threat intelligence from the web. Get trending threat insights on hackers, exploits, and suspicious IP addresses delivered to your inbox with our free Cyber Daily.

 
LVL 7

Expert Comment

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

= ongoing progress...
0
 
LVL 14

Expert Comment

by:AvonWyss
ID: 6925111
Well, with the include file I use, there are about 400 kbyte worth of primes... :-))
That's already a good starting point...
0
 
LVL 7

Expert Comment

by:God_Ares
ID: 6925149
To all: I respectfully give up..

i would like to leave this link :

http://www.mail-archive.com/cryptography%40wasabisystems.com/msg01830.html
0
 
LVL 27

Author Comment

by:kretzschmar
ID: 6925186
:-(
god ares, why give up?
0
 
LVL 9

Expert Comment

by:ginsonic
ID: 6925672
interested
0
 
LVL 27

Author Comment

by:kretzschmar
ID: 6926004
sorry,
had no time for testing this evening,
family catched me before :-(

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

meikl ;-)
0
 
LVL 7

Expert Comment

by:God_Ares
ID: 6928369
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.
0
 
LVL 7

Expert Comment

by:God_Ares
ID: 6928438
function is suitable for cardinals

remeber (prime1 * prime2) could be > High(Cardinal)
0
 
LVL 27

Author Comment

by:kretzschmar
ID: 6930656
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 ;-)
0
 
LVL 27

Author Comment

by:kretzschmar
ID: 6941295
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 ;-)
0
 
LVL 9

Expert Comment

by:ITugay
ID: 6941984
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;
0

Featured Post

IT, Stop Being Called Into Every Meeting

Highfive is so simple that setting up every meeting room takes just minutes and every employee will be able to start or join a call from any room with ease. Never be called into a meeting just to get it started again. This is how video conferencing should work!

Join & Write a Comment

A lot of questions regard threads in Delphi.   One of the more specific questions is how to show progress of the thread.   Updating a progressbar from inside a thread is a mistake. A solution to this would be to send a synchronized message to the…
In this tutorial I will show you how to use the Windows Speech API in Delphi. I will only cover basic functions such as text to speech and controlling the speed of the speech. SAPI Installation First you need to install the SAPI type library, th…
Get a first impression of how PRTG looks and learn how it works.   This video is a short introduction to PRTG, as an initial overview or as a quick start for new PRTG users.
In this tutorial you'll learn about bandwidth monitoring with flows and packet sniffing with our network monitoring solution PRTG Network Monitor (https://www.paessler.com/prtg). If you're interested in additional methods for monitoring bandwidt…

747 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

12 Experts available now in Live!

Get 1:1 Help Now