RosettaCodeData/Task/Arithmetic-numbers/Oberon-07/arithmetic-numbers.oberon
2024-10-16 18:07:41 -07:00

64 lines
1.5 KiB
Text

MODULE ArithmeticNumbers;
IMPORT Out;
CONST
Max = 130000;
VAR divSum: ARRAY Max + 1 OF INTEGER;
divCount: ARRAY Max + 1 OF CHAR;
current, count, composites: INTEGER;
PROCEDURE CalculateDivisorSums;
VAR div, num: INTEGER;
BEGIN
FOR num := 1 TO Max DO
divSum[num] := 0;
divCount[num] := CHR(0)
END;
FOR div := 1 TO Max DO
num := div;
WHILE num <= Max DO
INC(divSum[num],div);
divCount[num] := CHR(ORD(divCount[num]) + 1);
INC(num,div)
END
END
END CalculateDivisorSums;
PROCEDURE Next(n: INTEGER): INTEGER;
BEGIN
REPEAT INC(n) UNTIL (divSum[n] MOD ORD(divCount[n])) = 0;
RETURN n
END Next;
PROCEDURE Composite(n: INTEGER): BOOLEAN;
BEGIN
RETURN (n>1) & (divSum[n] # n+1)
END Composite;
BEGIN
CalculateDivisorSums;
Out.String("First 100 arithmetic numbers:");
Out.Ln;
current := 0;
FOR count := 1 TO 100000 DO
current := Next(current);
IF Composite(current) THEN INC(composites) END;
IF count <= 100 THEN
Out.Int(current, 5);
IF count MOD 10 = 0 THEN Out.Ln END
END;
IF (count = 1000) OR (count = 10000) OR (count = 100000) THEN
Out.Int(count, 6);
Out.String("th: ");
Out.Int(current, 6);
Out.String(", ");
Out.Int(composites, 6);
Out.String(" composites");
Out.Ln
END;
END
END ArithmeticNumbers.