aparler/RosettaCodeData
1
0
Fork 0
Code Issues 12 Pull requests 3 Projects Releases Packages Wiki Activity Actions

Data commit

Browse source
This commit is contained in:
Ingy döt Net 2023-07-01 11:58:00 -04:00
parent 7387c8f97b
commit cb5bb5e222
199093 changed files with 3378972 additions and 0 deletions
Download patch file Download diff file Expand all files Collapse all files

82
Task/Sphenic-numbers/XPL0/sphenic-numbers.xpl0 Normal file
View file

@ -0,0 +1,82 @@
int Factors(3);
func Sphenic(N); \Return 'true' if N is sphenic
int N, C, F, L, Q;
[L:= sqrt(N);
C:= 0; F:= 2;
loop [Q:= N/F;
if rem(0) = 0 then
[Factors(C):= F; \found a factor
C:= C+1; \count it
if C > 3 then return false;
N:= Q;
if rem(N/F) = 0 then \has a square
return false;
if F > N then quit;
]
else [F:= F+1;
if F > L then \reached limit
[Factors(C):= N;
C:= C+1;
quit;
];
];
];
return C = 3;
];
int C, N, I;
[Format(4, 0);
C:= 0; N:= 2*3*5;
Text(0, "Sphenic numbers less than 1,000:^m^j");
loop [if Sphenic(N) then
[C:= C+1;
if N < 1000 then
[RlOut(0, float(N));
if rem(C/15) = 0 then CrLf(0);
];
if C = 200_000 then
[Text(0, "The 200,000th sphenic number is ");
IntOut(0, N);
Text(0, " = ");
for I:= 0 to 2 do
[IntOut(0, Factors(I));
if I < 2 then Text(0, "*");
];
CrLf(0);
];
];
N:= N+1;
if N >= 1_000_000 then quit;
];
Text(0, "There are "); IntOut(0, C);
Text(0, " sphenic numbers less than 1,000,000^m^j^m^j");
C:= 0; N:= 2*3*5;
Text(0, "Sphenic triplets less than 10,000:^m^j");
loop [if Sphenic(N) then if Sphenic(N+1) then if Sphenic(N+2) then
[C:= C+1;
if N < 10_000 then
[ChOut(0, ^[);
for I:= 0 to 2 do
[IntOut(0, N+I);
if I < 2 then Text(0, ", ");
];
ChOut(0, ^]);
if rem(C/3) = 0 then CrLf(0) else Text(0, ", ");;
];
if C = 5000 then
[Text(0, "The 5000th sphenic triplet is [");
for I:= 0 to 2 do
[IntOut(0, N+I);
if I < 2 then Text(0, ", ");
];
Text(0, "]^m^j");
];
];
N:= N+1;
if N+2 >= 1_000_000 then quit;
];
Text(0, "There are "); IntOut(0, C);
Text(0, " sphenic triplets less than 1,000,000^m^j");
]