Humble numbers: Difference between revisions
→{{header|PL/M}}: syntax highlighting, Added Polyglot:PL/I and PL/M, Added PL/I
(Humble numbers en FreeBASIC) |
(→{{header|PL/M}}: syntax highlighting, Added Polyglot:PL/I and PL/M, Added PL/I) |
||
Line 4,436:
152,515 humble numbers have 42 digits (23.9s, total:1,703,635)
</pre>
=={{header|PL/I}}==
See [[#Polyglot:PL/I and PL/M]]
=={{header|PL/M}}==
{{Trans|ALGOL W}}This can be compiled with the original 8080 PL/M compiler and run under CP/M or an emulator or clone.
Only handles Humble numbers with up to 4 digits as 8080 PL/M only has unsigned 8 and 16 bit integers.
<lang
BDOS: PROCEDURE( FN, ARG ); /* CP/M BDOS SYSTEM CALL */
DECLARE FN BYTE, ARG ADDRESS;
Line 4,519 ⟶ 4,523:
<pre>
1 2 3 4 5 6 7 8 9 10 12 14 15 16 18 20 21 24 25 27 28 30 32 35 36 40 42 45 48 49 50 54 56 60 63 64 70 72 75 80 81 84 90 96 98 100 105 108 112 120
THERE ARE 9 HUMBLE NUMBERS WITH 1 DIGIT
THERE ARE 36 HUMBLE NUMBERS WITH 2 DIGITS
THERE ARE 95 HUMBLE NUMBERS WITH 3 DIGITS
THERE ARE 197 HUMBLE NUMBERS WITH 4 DIGITS
</pre>
See also [[#Polyglot:PL/I and PL/M]]
=={{header|Polyglot:PL/I and PL/M}}==
{{works with|8080 PL/M Compiler}} ... under CP/M (or an emulator)
Should work with many PL/I implementations.
<br>
The PL/I include file "pg.inc" can be found on the [[Polyglot:PL/I and PL/M]] page.<br>
Note the use of text in column 81 onwards to hide the PL/I specifics from the PL/M compiler.<br><br>
Based on the PL/M version, noter PL/I does not have the "walrus operator" (:=) which allows assignments to be nested in expressions, so it can't be used here.
<lang pli>/* FIND SOME HUMBLE NUMBERS - NUMBERS WITH NO PRIME FACTORS ABOVE 7 */
humble_100H: procedure options (main);
/* PROGRAM-SPECIFIC %REPLACE STATEMENTS MUST APPEAR BEFORE THE %INCLUDE AS */
/* E.G. THE CP/M PL/I COMPILER DOESN'T LIKE THEM TO FOLLOW PROCEDURES */
/* PL/I */
%replace dclhumble by 400;
/* PL/M */ /*
DECLARE DCLHUMBLE LITERALLY '401';
/* */
/* PL/I DEFINITIONS */
%include 'pg.inc';
/* PL/M DEFINITIONS: CP/M BDOS SYSTEM CALL AND CONSOLE I/O ROUTINES, ETC. */ /*
DECLARE BINARY LITERALLY 'ADDRESS', CHARACTER LITERALLY 'BYTE';
DECLARE FIXED LITERALLY ' ', BIT LITERALLY 'BYTE';
DECLARE STATIC LITERALLY ' ', RETURNS LITERALLY ' ';
DECLARE FALSE LITERALLY '0', TRUE LITERALLY '1';
DECLARE HBOUND LITERALLY 'LAST', SADDR LITERALLY '.';
BDOSF: PROCEDURE( FN, ARG )BYTE;
DECLARE FN BYTE, ARG ADDRESS; GOTO 5; END;
BDOS: PROCEDURE( FN, ARG ); DECLARE FN BYTE, ARG ADDRESS; GOTO 5; END;
PRCHAR: PROCEDURE( C ); DECLARE C BYTE; CALL BDOS( 2, C ); END;
PRSTRING: PROCEDURE( S ); DECLARE S ADDRESS; CALL BDOS( 9, S ); END;
PRNL: PROCEDURE; CALL PRCHAR( 0DH ); CALL PRCHAR( 0AH ); END;
PRNUMBER: PROCEDURE( N );
DECLARE N ADDRESS;
DECLARE V ADDRESS, N$STR( 6 ) BYTE, W BYTE;
N$STR( W := LAST( N$STR ) ) = '$';
N$STR( W := W - 1 ) = '0' + ( ( V := N ) MOD 10 );
DO WHILE( ( V := V / 10 ) > 0 );
N$STR( W := W - 1 ) = '0' + ( V MOD 10 );
END;
CALL BDOS( 9, .N$STR( W ) );
END PRNUMBER;
MODF: PROCEDURE( A, B )ADDRESS;
DECLARE ( A, B )ADDRESS;
RETURN( A MOD B );
END MODF;
MIN: PROCEDURE( A, B ) ADDRESS;
DECLARE ( A, B ) ADDRESS;
IF A < B THEN RETURN( A ); ELSE RETURN( B );
END MIN;
/* END LANGUAGE DEFINITIONS */
/* TASK */
/* DISPLAY A STASTIC ABOUT HUMBLE NUMBERS */
PRHUMBLESTAT: PROCEDURE( S, D );
DECLARE ( S, D ) FIXED BINARY;
CALL PRSTRING( SADDR( 'THERE ARE $' ) );
IF S < 10 THEN CALL PRCHAR( ' ' );
IF S < 100 THEN CALL PRCHAR( ' ' );
CALL PRNUMBER( S );
CALL PRSTRING( SADDR( ' HUMBLE NUMBERS WITH $' ) );
CALL PRNUMBER( D );
CALL PRSTRING( SADDR( ' DIGIT$' ) );
IF D > 1 THEN CALL PRCHAR( 'S' );
CALL PRNL;
END PRHUMBLESTAT;
/* FIND AND PRINT HUMBLE NUMBERS */
DECLARE H( DCLHUMBLE ) FIXED BINARY;
DECLARE ( P2, P3, P5, P7, M
, LAST2, LAST3, LAST5, LAST7
, H1, H2, H3, H4, HPOS
, MAXHUMBLE
) FIXED BINARY;
MAXHUMBLE = HBOUND( H ,1
);
/* 1 IS THE FIRST HUMBLE NUMBER */
H( 1 ) = 1;
LAST2 = 1; LAST3 = 1; LAST5 = 1; LAST7 = 1;
P2 = 2; P3 = 3; P5 = 5; P7 = 7;
DO HPOS = 2 TO MAXHUMBLE;
/* THE NEXT HUMBLE NUMBER IS THE LOWEST OF THE NEXT MULTIPLES OF */
/* 2, 3, 5, 7 */
M = MIN( MIN( MIN( P2, P3 ), P5 ), P7 );
H( HPOS ) = M;
IF M = P2 THEN DO; LAST2 = LAST2 + 1; P2 = 2 * H( LAST2 ); END;
IF M = P3 THEN DO; LAST3 = LAST3 + 1; P3 = 3 * H( LAST3 ); END;
IF M = P5 THEN DO; LAST5 = LAST5 + 1; P5 = 5 * H( LAST5 ); END;
IF M = P7 THEN DO; LAST7 = LAST7 + 1; P7 = 7 * H( LAST7 ); END;
END;
/* SHOW THE FIRST 50 HUMBLE NUMBERS */
DO HPOS = 1 TO 50;
CALL PRCHAR( ' ' );
M = H( HPOS );
IF M < 10 THEN CALL PRCHAR( ' ' );
IF M < 100 THEN CALL PRCHAR( ' ' );
CALL PRNUMBER( H( HPOS ) );
IF MODF( HPOS, 16 ) = 0 THEN CALL PRNL;
END;
CALL PRNL;
/* SHOW THE NUMBER OF HUMBLE NUMBERS UP TO VARIOUS POWERS OF 10 */
H1 = 0; H2 = 0; H3 = 0; H4 = 0;
DO HPOS = 1 TO MAXHUMBLE;
M = H( HPOS );
IF M < 10 THEN H1 = H1 + 1;
ELSE IF M < 100 THEN H2 = H2 + 1;
ELSE IF M < 1000 THEN H3 = H3 + 1;
ELSE IF M < 10000 THEN H4 = H4 + 1;
END;
CALL PRHUMBLESTAT( H1, 1 );
CALL PRHUMBLESTAT( H2, 2 );
CALL PRHUMBLESTAT( H3, 3 );
CALL PRHUMBLESTAT( H4, 4 );
EOF: end humble_100H;</lang>
{{out}}
<pre>
1 2 3 4 5 6 7 8 9 10 12 14 15 16 18 20
21 24 25 27 28 30 32 35 36 40 42 45 48 49 50 54
56 60 63 64 70 72 75 80 81 84 90 96 98 100 105 108
112 120
THERE ARE 9 HUMBLE NUMBERS WITH 1 DIGIT
THERE ARE 36 HUMBLE NUMBERS WITH 2 DIGITS
| |||