Humble numbers: Difference between revisions
Content added Content deleted
(Humble numbers en FreeBASIC) |
(→{{header|PL/M}}: syntax highlighting, Added Polyglot:PL/I and PL/M, Added PL/I) |
||
Line 4,436: | Line 4,436: | ||
152,515 humble numbers have 42 digits (23.9s, total:1,703,635) |
152,515 humble numbers have 42 digits (23.9s, total:1,703,635) |
||
</pre> |
</pre> |
||
=={{header|PL/I}}== |
|||
See [[#Polyglot:PL/I and PL/M]] |
|||
=={{header|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. |
{{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. |
Only handles Humble numbers with up to 4 digits as 8080 PL/M only has unsigned 8 and 16 bit integers. |
||
<lang |
<lang pli>100H: /* FIND SOME HUMBLE NUMBERS - NUMBERS WITH NO PRIME FACTORS ABOVE 7 */ |
||
BDOS: PROCEDURE( FN, ARG ); /* CP/M BDOS SYSTEM CALL */ |
BDOS: PROCEDURE( FN, ARG ); /* CP/M BDOS SYSTEM CALL */ |
||
DECLARE FN BYTE, ARG ADDRESS; |
DECLARE FN BYTE, ARG ADDRESS; |
||
Line 4,519: | Line 4,523: | ||
<pre> |
<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 |
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 9 HUMBLE NUMBERS WITH 1 DIGIT |
||
THERE ARE 36 HUMBLE NUMBERS WITH 2 DIGITS |
THERE ARE 36 HUMBLE NUMBERS WITH 2 DIGITS |