?
Solved

qow 14: prime number dismantling

Posted on 2002-04-08
22
Medium Priority
?
351 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
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 8
  • 6
  • 5
  • +3
22 Comments
 
LVL 14

Accepted Solution

by:
AvonWyss earned 100 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
VIDEO: THE CONCERTO CLOUD FOR HEALTHCARE

Modern healthcare requires a modern cloud. View this brief video to understand how the Concerto Cloud for Healthcare can help your organization.

 
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
 
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

VIDEO: THE CONCERTO CLOUD FOR HEALTHCARE

Modern healthcare requires a modern cloud. View this brief video to understand how the Concerto Cloud for Healthcare can help your organization.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

This article explains how to create forms/units independent of other forms/units object names in a delphi project. Have you ever created a form for user input in a Delphi project and then had the need to have that same form in a other Delphi proj…
In my programming career I have only very rarely run into situations where operator overloading would be of any use in my work.  Normally those situations involved math with either overly large numbers (hundreds of thousands of digits or accuracy re…
In this video we outline the Physical Segments view of NetCrunch network monitor. By following this brief how-to video, you will be able to learn how NetCrunch visualizes your network, how granular is the information collected, as well as where to f…
Monitoring a network: how to monitor network services and why? Michael Kulchisky, MCSE, MCSA, MCP, VTSP, VSP, CCSP outlines the philosophy behind service monitoring and why a handshake validation is critical in network monitoring. Software utilized …
Suggested Courses

800 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