RosettaCodeData/Task/Arithmetic-numbers/Modula-2/arithmetic-numbers.mod2

66 lines
1.5 KiB
Plaintext

MODULE ArithmeticNumbers;
FROM InOut IMPORT WriteString, WriteCard, WriteLn;
CONST
Max = 13000;
VAR
divSum: ARRAY [1..Max] OF CARDINAL;
divCount: ARRAY [1..Max] OF CHAR;
current, count, composites: CARDINAL;
PROCEDURE CalculateDivisorSums;
VAR div, num: CARDINAL;
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);
INC(divCount[num]);
INC(num, div)
END
END
END CalculateDivisorSums;
PROCEDURE Next(n: CARDINAL): CARDINAL;
BEGIN
REPEAT INC(n) UNTIL (divSum[n] MOD ORD(divCount[n])) = 0;
RETURN n
END Next;
PROCEDURE Composite(n: CARDINAL): BOOLEAN;
BEGIN
RETURN (n>1) AND (divSum[n] # n+1)
END Composite;
BEGIN
CalculateDivisorSums;
WriteString("First 100 arithmetic numbers:");
WriteLn;
current := 0;
FOR count := 1 TO 10000 DO
current := Next(current);
IF Composite(current) THEN INC(composites) END;
IF count <= 100 THEN
WriteCard(current, 5);
IF count MOD 10 = 0 THEN WriteLn END
END;
IF (count = 1000) OR (count = 10000) THEN
WriteCard(count, 5);
WriteString(": ");
WriteCard(current, 5);
WriteString(", ");
WriteCard(composites, 5);
WriteString(" composites");
WriteLn
END;
END
END ArithmeticNumbers.