Solved

qow 14: prime number dismantling

Posted on 2002-04-08
335 Views
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

for the fastest routine

let see

meikl ;-)
0
Question by:kretzschmar
• 8
• 6
• 5
• +3

LVL 14

Accepted Solution

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

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

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

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

hopefully, some more will join this quest

meikl ;-)

0

LVL 27

Author Comment

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

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
s:=s+'Prime';
end
else Delete(s,Length(s),1);
end;
PrList.Free;
MulList.SaveToFile('C:\Primes.txt');
MulList.Free;
end;
0

LVL 14

Expert Comment

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!');
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

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

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,

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

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

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

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

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

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

ID: 6925186
:-(
god ares, why give up?
0

LVL 9

Expert Comment

ID: 6925672
interested
0

LVL 27

Author Comment

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

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;

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;

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

Begin

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

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;

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

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

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
else
result := find^.prime;

end;

end;

Begin
new(first);
first^.nr := CPrimeLast+1;
last := nil;
end.
0

LVL 7

Expert Comment

ID: 6928438
function is suitable for cardinals

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

LVL 27

Author Comment

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

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

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

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â€¦