Humble numbers: Difference between revisions

Content added Content deleted
m (→‎{{header|Phix}}: added syntax colouring the hard way)
(→‎{{header|PL/M}}: Replaced PLM286 version with one that can be compiled with the original 8080 PL/M compiler)
Line 4,096: Line 4,096:


=={{header|PL/M}}==
=={{header|PL/M}}==
This can be compiled with the original 8080 PL/M compiler and run under CP/M or an emulator or clone.
{{Trans|ALGOL W}}
<br>Based on the Algol W sample, only handles Humble numbers with up to 4 digits as 8080 PL/M only has unsigned 8 and 16 bit integers.
Tested using a PLM286 to C converter and a suitable I/O library.
<lang plm>100H: /* FIND SOME HUMBLE NUMBERS - NUMBERS WITH NO PRIME FACTORS ABOVE 7 */
<lang plm>HUMBLE: DO;
BDOS: PROCEDURE( FN, ARG ); /* CP/M BDOS SYSTEM CALL */
/* find some Humble numbers - numbers with no prime factors above 7 */
DECLARE FN BYTE, ARG ADDRESS;
/* External I/O procedures */
GOTO 5;
⚫
WRITE$STRING: PROCEDURE( S ) EXTERNAL; DECLARE S POINTER; END;
⚫
END BDOS;
WRITE$WORD: PROCEDURE( W ) EXTERNAL; DECLARE W WORD; END;
WRITE$NL: PROCEDURE EXTERNAL; END;
PRINT$CHAR: PROCEDURE( C ); DECLARE C BYTE; CALL BDOS( 2, C ); END;
⚫
PRINT$STRING: PROCEDURE( S ); DECLARE S ADDRESS; CALL BDOS( 9, S ); END;
/* End external I/O procedures */
PRINT$NL: PROCEDURE; CALL PRINT$STRING( .( 0DH, 0AH, '$' ) ); END;
⚫
DECLARE MAX$HUMBLE LITERALLY '400';
PRINT$NUMBER: PROCEDURE( N );
/* returns the minimum of a and b */
MIN: PROCEDURE( A, B ) WORD;
DECLARE N ADDRESS;
DECLARE ( A, B ) WORD;
DECLARE V ADDRESS, N$STR( 6 ) BYTE, W BYTE;
V = N;
IF A < B THEN RETURN( A ); ELSE RETURN( B );
END MIN;
W = LAST( N$STR );
N$STR( W ) = '$';
/* display a statistic about Humble numbers */
WRITEHSTAT: PROCEDURE( S, D );
N$STR( W := W - 1 ) = '0' + ( V MOD 10 );
DECLARE ( S, D ) WORD;
DO WHILE( ( V := V / 10 ) > 0 );
CALL WRITE$STRING( @( 'there are', 0 ) );
N$STR( W := W - 1 ) = '0' + ( V MOD 10 );
CALL WRITE$WORD( S );
END;
CALL WRITE$STRING( @( ' Humble numbers with ', 0 ) );
CALL PRINT$STRING( .N$STR( W ) );
END PRINT$NUMBER;
⚫
CALL WRITE$WORD( D );
CALL WRITE$STRING( @( ' digit', 0 ) );
MIN: PROCEDURE( A, B ) ADDRESS;
IF D > 1 THEN CALL WRITE$STRING( @( 's', 0 ) );
DECLARE ( A, B ) ADDRESS;
CALL WRITE$NL();
IF A < B THEN RETURN( A ); ELSE RETURN( B );
END WRITEHSTAT;
END MIN;
/* DISPLAY A STASTIC ABOUT HUMBLE NUMBERS */
/* find and print Humble Numbers */
MAIN: PROCEDURE;
PRINT$H$STAT: PROCEDURE( S, D );
DECLARE H( MAX$HUMBLE ) WORD;
DECLARE ( S, D ) ADDRESS;
DECLARE ( P2, P3, P5, P7, M
CALL PRINT$STRING( .'THERE ARE $' );
, LAST2, LAST3, LAST5, LAST7
IF S < 10 THEN CALL PRINT$CHAR( ' ' );
, H1, H2, H3, H4, H5, H6, HPOS
IF S < 100 THEN CALL PRINT$CHAR( ' ' );
) WORD;
CALL PRINT$NUMBER( S );
CALL PRINT$STRING( .' HUMBLE NUMBERS WITH $' );
/* 1 is the first Humble number */
H( 0 ) = 1;
CALL PRINT$NUMBER( D );
CALL PRINT$STRING( .' DIGIT$' );
⚫
H1 = 0; H2 = 0; H3 = 0; H4 = 0; H5 = 0; H6 = 0;
LAST2 = 0; LAST3 = 0; LAST5 = 0; LAST7 = 0;
IF D > 1 THEN CALL PRINT$CHAR( 'S' );
⚫
CALL PRINT$NL;
P2 = 2; P3 = 3; P5 = 5; P7 = 7;
END PRINT$H$STAT;
DO HPOS = 1 TO MAX$HUMBLE - 1;
/* FIND AND PRINT HUMBLE NUMBERS */
/* the next Humble number is the lowest of the next multiple */
⚫
DECLARE MAX$HUMBLE LITERALLY '400';
/* of 2, 3, 5, 7 */
DECLARE H( MAX$HUMBLE ) ADDRESS;
M = MIN( MIN( MIN( P2, P3 ), P5 ), P7 );
H( HPOS ) = M;
DECLARE ( P2, P3, P5, P7, M
IF M = P2 THEN DO;
, LAST2, LAST3, LAST5, LAST7
⚫
, H1, H2, H3, H4, H5, H6, HPOS
/* the Humble number was the next multiple of 2 */
) ADDRESS;
/* the next multiple of 2 will now be twice the Humble */
/* 1 IS THE FIRST HUMBLE NUMBER */
/* number following the previous multple of 2 */
LAST2 = LAST2 + 1;
H( 0 ) = 1;
P2 = 2 * H( LAST2 );
H1 = 0; H2 = 0; H3 = 0; H4 = 0; H5 = 0; H6 = 0;
END;
LAST2 = 0; LAST3 = 0; LAST5 = 0; LAST7 = 0;
IF M = P3 THEN DO;
P2 = 2; P3 = 3; P5 = 5; P7 = 7;
LAST3 = LAST3 + 1;
DO HPOS = 1 TO MAX$HUMBLE - 1;
P3 = 3 * H( LAST3 );
/* THE NEXT HUMBLE NUMBER IS THE LOWEST OF THE NEXT MULTIPLES OF */
END;
/* 2, 3, 5, 7 */
IF M = P5 THEN DO;
M = MIN( MIN( MIN( P2, P3 ), P5 ), P7 );
LAST5 = LAST5 + 1;
H( HPOS ) = M;
P5 = 5 * H( LAST5 );
IF M = P2 THEN P2 = 2 * H( LAST2 := LAST2 + 1 );
END;
IF M = P3 THEN P3 = 3 * H( LAST3 := LAST3 + 1 );
IF M = P7 THEN DO;
IF M = P5 THEN P5 = 5 * H( LAST5 := LAST5 + 1 );
LAST7 = LAST7 + 1;
IF M = P7 THEN P7 = 7 * H( LAST7 := LAST7 + 1 );
END;
P7 = 7 * H( LAST7 );
END;
DO HPOS = 0 TO 49;
END;
CALL PRINT$CHAR( ' ' );
DO HPOS = 0 TO 49; CALL WRITE$WORD( H( HPOS ) ); END;
CALL PRINT$NUMBER( H( HPOS ) );
END;
CALL WRITE$NL();
CALL PRINT$NL;
DO HPOS = 0 TO MAX$HUMBLE - 1;
M = H( HPOS );
DO HPOS = 0 TO MAX$HUMBLE - 1;
IF M < 10 THEN H1 = H1 + 1;
M = H( HPOS );
ELSE IF M < 100 THEN H2 = H2 + 1;
IF M < 10 THEN H1 = H1 + 1;
ELSE IF M < 1000 THEN H3 = H3 + 1;
ELSE IF M < 100 THEN H2 = H2 + 1;
ELSE IF M < 10000 THEN H4 = H4 + 1;
ELSE IF M < 1000 THEN H3 = H3 + 1;
END;
ELSE IF M < 10000 THEN H4 = H4 + 1;
END;
⚫
CALL WRITEHSTAT( H1, 1 );
CALL WRITEHSTAT( H2, 2 );
CALL PRINT$H$STAT( H1, 1 );
CALL WRITEHSTAT( H3, 3 );
CALL PRINT$H$STAT( H2, 2 );
CALL WRITEHSTAT( H4, 4 );
CALL PRINT$H$STAT( H3, 3 );
⚫
CALL PRINT$H$STAT( H4, 4 );
⚫
END MAIN;
END HUMBLE;</lang>
EOF</lang>
{{out}}
{{out}}
<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 9 Humble numbers with 1 digit
THERE ARE 36 HUMBLE NUMBERS WITH 2 DIGITS
there are 36 Humble numbers with 2 digits
THERE ARE 95 HUMBLE NUMBERS WITH 3 DIGITS
there are 95 Humble numbers with 3 digits
THERE ARE 197 HUMBLE NUMBERS WITH 4 DIGITS
there are 197 Humble numbers with 4 digits
</pre>
</pre>


Retrieved from "https://rosettacode.org/wiki/Humble_numbers"