Rosetta Code

Humble numbers: Difference between revisions

Page Discussion

Humble numbers (view source)

Revision as of 17:59, 12 June 2021

438 bytes removed ,  2 years ago
→‎{{header|PL/M}}: Replaced PLM286 version with one that can be compiled with the original 8080 PL/M compiler
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:
 
=={{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 MAINBDOS;▼
WRITE$WORD: PROCEDURE( W ) EXTERNAL; DECLARE W WORD; END;
WRITEPRINT$NLCHAR: PROCEDURE( C ); DECLARE C EXTERNALBYTE; CALL BDOS( 2, C ); END;
▲ WRITEPRINT$STRING: PROCEDURE( S ); DECLARE S ADDRESS; CALL BDOS( EXTERNAL; DECLARE9, S POINTER); 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,DECLARE BN ) WORDADDRESS;
DECLARE V ADDRESS, DECLAREN$STR( 6 () ABYTE, B )W WORDBYTE;
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 N$STR( W := W - 1 ) = '0' + PROCEDURE( S,V MOD D10 );
DO DECLAREWHILE( ( S,V D:= V / 10 ) WORD> 0 );
CALL WRITEN$STRINGSTR( @(W 'there:= are',W 0- 1 ) = '0' + ( V MOD 10 );
CALL WRITE$WORD( S )END;
CALL WRITEPRINT$STRING( @.N$STR( ' Humble numbers with ', 0W ) );
END PRINT$NUMBER;
CALL WRITE$WORD( D );▼
MIN: CALL WRITE$STRINGPROCEDURE( @( ' digit'A, 0B ) )ADDRESS;
DECLARE IF D > 1 THEN CALL WRITE$STRING( @( 's'A, 0B ) )ADDRESS;
IF A CALL< WRITE$NLB THEN RETURN( A ); ELSE RETURN( B );
END WRITEHSTATMIN;
/* DISPLAY A STASTIC ABOUT HUMBLE NUMBERS */
/* find and print Humble Numbers */
MAINPRINT$H$STAT: PROCEDURE( S, D );
DECLARE H( MAX$HUMBLES, D ) WORDADDRESS;
CALL DECLARE PRINT$STRING( P2, P3,.'THERE P5,ARE P7,$' M);
IF S < 10 THEN CALL PRINT$CHAR( ' ' , LAST2, LAST3, LAST5, LAST7);
IF S < 100 THEN CALL PRINT$CHAR( ' ' , H1, H2, H3, H4, H5, H6, HPOS);
CALL PRINT$NUMBER( S ) WORD;
CALL PRINT$STRING( .' HUMBLE NUMBERS WITH $' );
/* 1 is the first Humble number */
CALL HPRINT$NUMBER( 0D ) = 1;
CALL PRINT$STRING( .' DIGIT$' );
H1 = 0; H2 = 0; H3 = 0; H4 = 0; H5 = 0; H6 = 0;▼
IF D LAST2> =1 0;THEN LAST3CALL =PRINT$CHAR( 0;'S' LAST5 = 0; LAST7 = 0);
▲ CALL WRITEPRINT$WORD( D )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 );
DECLARE ( P2, P3, P5, H( HPOS ) =P7, M;
, IFLAST2, MLAST3, =LAST5, P2 THEN DO;LAST7
▲ H1 , = 0;H1, H2 = 0;, H3 = 0;, H4 = 0;, H5 = 0;, H6, = 0;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 */
H( 0 LAST2) = LAST2 + 1;
H1 = 0; H2 = 0; H3 P2 = 0; H4 = 20; *H5 H(= LAST20; H6 = )0;
LAST2 = 0; LAST3 = 0; LAST5 = 0; ENDLAST7 = 0;
P2 = 2; P3 IF M= 3; P5 = P35; THENP7 = DO7;
DO HPOS = 1 TO MAX$HUMBLE LAST3 = LAST3 +- 1;
/* THE NEXT HUMBLE NUMBER IS THE LOWEST OF THE P3NEXT MULTIPLES = 3OF * H( LAST3 );/
/* 2, 3, 5, 7 END;*/
M = MIN( MIN( MIN( P2, IFP3 M =), P5 THEN), P7 DO);
H( HPOS LAST5) = LAST5 + 1M;
IF M = P2 THEN P2 = 2 * H( P5 LAST2 := 5LAST2 * H(+ LAST51 );
IF M = P3 THEN P3 END= 3 * H( LAST3 := LAST3 + 1 );
IF M = P5 THEN P5 IF= M5 * H( LAST5 := P7LAST5 THEN+ 1 DO);
IF M = P7 THEN P7 = 7 * H( LAST7 := LAST7 + 1 );
END;
P7 = 7 * H( LAST7 );
DO HPOS = 0 TO END49;
CALL PRINT$CHAR( END' ' );
DO HPOS = 0 TO 49; CALL WRITEPRINT$WORDNUMBER( H( HPOS ) ); END;
END;
CALL WRITEPRINT$NL();
DO HPOS = 0 TO MAX$HUMBLE - 1;
DO HPOS = 0 TO MAX$HUMBLE - M = H( HPOS )1;
IF M < 10 THEN H1 = H1H( +HPOS 1);
IF ELSE IF M < 100 10 THEN H2H1 = H2H1 + 1;
ELSE IF M < 1000 100 THEN H3H2 = H3H2 + 1;
ELSE IF M < 10000 1000 THEN H4H3 = H4H3 + 1;
ELSE IF ENDM < 10000 THEN H4 = H4 + 1;
END;
CALL WRITEHSTAT( H1, 1 );▼
CALL WRITEHSTATPRINT$H$STAT( H2H1, 21 );
CALL WRITEHSTATPRINT$H$STAT( H3H2, 32 );
CALL WRITEHSTATPRINT$H$STAT( H4H3, 43 );
▲ CALL WRITEHSTATPRINT$H$STAT( H1H4, 14 );
▲ END MAIN;
END HUMBLE;EOF</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
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>
 
Tigerofdarkness
3,043

edits

Retrieved from "https://rosettacode.org/wiki/Special:MobileDiff/293282"