Data commit

Task/Sphenic-numbers/Delphi/sphenic-numbers.delphi

@@ -0,0 +1,123 @@
+procedure GetSphenicNumbers(var Sphenic: TIntegerDynArray);
+{Return Sphenic number up to MaxProd }
+const MaxProd = 1000000;
+var LimitA: integer;
+var Sieve: TPrimeSieve;
+var I,J,K,Prod1,Prod2: integer;
+begin
+Sieve:=TPrimeSieve.Create;
+try
+SetLength(Sphenic,0);
+{Limit outer most search}
+LimitA:=Trunc(CubeRoot(MaxProd));
+{Sieve values up to MaxProc ~ 78,000 primes }
+Sieve.Intialize(MaxProd);
+{Iteratre through all combination of sequential primes}
+for I:=0 to Sieve.PrimeCount-1 do
+	begin
+	{Limit first prime}
+	if Sieve.Primes[I]>LimitA then break;
+	for J:=I+1 to Sieve.PrimeCount-1 do
+		begin
+		Prod1:=Sieve.Primes[I] * Sieve.Primes[J];
+		{Limit product of first two primes}
+		if (Prod1 * Sieve.Primes[J + 1])>=MaxProd then break;
+		for K:=J+1 to Sieve.PrimeCount-1 do
+			begin
+			Prod2:= Prod1 * Sieve.Primes[k];
+			{Limit product of all three primes}
+			if Prod2 >=MaxProd then break;
+			{Store number}
+			SetLength(Sphenic,Length(Sphenic)+1);
+			Sphenic[High(Sphenic)]:=Prod2;
+			end;
+		end;
+	end;
+finally Sieve.Free; end;
+end;
+
+
+
+function Compare(P1,P2: pointer): integer;
+{Compare for quick sort}
+begin
+Result:=Integer(P1)-Integer(P2);
+end;
+
+{Struct to store Sphenic Triple}
+
+type TSphenicTriple = record
+ A,B,C: integer;
+ end;
+
+{Dynamic array to store triples}
+
+type TTripletArray = array of TSphenicTriple;
+
+procedure GetSphenicTriples(var Triplets: TTripletArray; var Sphenic: TIntegerDynArray);
+{Get sphenic numbers and find corresponding sphenic triples}
+var LS: TList;
+var I,T: integer;
+begin
+LS:=TList.Create;
+GetSphenicNumbers(Sphenic);
+{Sort the numbers}
+for I:=0 to High(Sphenic) do
+ LS.Add(Pointer(Sphenic[I]));
+LS.Sort(Compare);
+{Put them back in simple array}
+for I:=0 to LS.Count-1 do
+ Sphenic[I]:=Integer(LS[I]);
+SetLength(Triplets,0);
+for I:=0 to High(Sphenic)-1 do
+	begin
+	T:=Sphenic[I];
+	{Test if the next three numbers are a triple}
+	if (Sphenic[I+1]=(T+1)) and (Sphenic[I+2] = (T + 2)) then
+		begin
+		{Store the result}
+		SetLength(Triplets,Length(Triplets)+1);
+		Triplets[High(Triplets)].A:=T;
+		Triplets[High(Triplets)].B:=T+1;
+		Triplets[High(Triplets)].C:=T+2;
+		end;
+	end;
+end;
+
+procedure SphenicTriplets(Memo: TMemo);
+var Triplets: TTripletArray;
+var T: TSphenicTriple;
+var Sphenic: TIntegerDynArray;
+var S: string;
+var I: integer;
+begin
+{Get sphenic numbers and triples}
+GetSphenicTriples(Triplets,Sphenic);
+{Display sphenic numbers up to 1000}
+Memo.Lines.Add('Sphenic numbers less than 1,000:');
+S:='';
+for I:=0 to High(Sphenic) do
+	begin
+	if Sphenic[I]>1000 then break;
+	S:=S+Format('%4d',[Sphenic[I]]);
+	if (I mod 15)=14 then S:=S+CRLF;
+	end;
+Memo.Lines.Add(S);
+{Display sphenic triples up to a C-value of 10,000}
+Memo.Lines.Add('Sphenic triples less than 10,000:');
+S:='';
+for I:=0 to High(Triplets) do
+	begin
+	if Triplets[I].C> 10000 then break;
+	S:=S+Format('[%5d %5d %5d]',[Triplets[I].A,Triplets[I].B,Triplets[I].C]);
+	if (I mod 3)=2 then S:=S+CRLF;
+	end;
+Memo.Lines.Add(S);
+
+Memo.Lines.Add('Total Sphenic Numbers found = '+FloatToStrF(Sphenic[Length(Sphenic)],ffNumber,18,0));
+Memo.Lines.Add(Format('Sphenic numbers  < 1,000,000 = %8.0n',[Length(Sphenic)+0.0]));
+Memo.Lines.Add(Format('Sphenic triplets < 1,000,000 = %8.0n',[Length(Triplets)+0.0]));
+T:=Triplets[4999];
+Memo.Lines.Add(Format('200,000th sphenic =   %n',[Sphenic[199999]+0.0]));
+Memo.Lines.Add(Format('The 5,000th triplet = %d %d %d', [T.A,T.B,T.C]));
+end;