Numbers which are the cube roots of the product of their proper divisors: Difference between revisions

Added PL/M
(Added Forth solution)
(Added PL/M)
Line 427:
</pre>
For comparison, the gcc/C++ entry gets the 500kth about 8* faster, roughly about what I'd expect... &#x1F925;
 
=={{header|PL/M}}==
Solves the basic task by counting the proper divisors as per the OEIS page (the 50 000th number is too large for 16 bits).
{{works with|8080 PL/M Compiler}} ... under CP/M (or an emulator)
<syntaxhighlight lang="plm">
100H: /* FIND NUMBERS THAT ARE THE CUBE ROOT OF THEIR PROPER DIVISORS */
 
DECLARE FALSE LITERALLY '0', TRUE LITERALLY '0FFH';
 
/* CP/M SYSTEM CALL AND I/O ROUTINES */
BDOS: PROCEDURE( FN, ARG ); DECLARE FN BYTE, ARG ADDRESS; GOTO 5; END;
PR$CHAR: PROCEDURE( C ); DECLARE C BYTE; CALL BDOS( 2, C ); END;
PR$STRING: PROCEDURE( S ); DECLARE S ADDRESS; CALL BDOS( 9, S ); END;
PR$NL: PROCEDURE; CALL PR$CHAR( 0DH ); CALL PR$CHAR( 0AH ); END;
PR$NUMBER: PROCEDURE( N ); /* PRINTS A NUMBER IN THE MINIMUN FIELD WIDTH */
DECLARE N ADDRESS;
DECLARE V ADDRESS, N$STR ( 6 )BYTE, W BYTE;
V = N;
W = LAST( N$STR );
N$STR( W ) = '$';
N$STR( W := W - 1 ) = '0' + ( V MOD 10 );
DO WHILE( ( V := V / 10 ) > 0 );
N$STR( W := W - 1 ) = '0' + ( V MOD 10 );
END;
CALL PR$STRING( .N$STR( W ) );
END PR$NUMBER;
/* END SYSTEM CALL AND I/O ROUTINES */
 
DECLARE PDC ( 5000 )ADDRESS;
DECLARE ( I, I2, J, COUNT ) ADDRESS;
 
DO I = 1 TO LAST( PDC ); PDC( I ) = 1; END;
DO I = 2 TO LAST( PDC );
I2 = I + I;
DO J = I2 TO LAST( PDC ) BY I;
PDC( J ) = PDC( J ) + 1;
END;
END;
PDC( 1 ) = 7;
 
COUNT, I = 0;
DO WHILE COUNT < 500 AND I < LAST( PDC );
I = I + 1;
IF PDC( I ) = 7 THEN DO;
IF ( COUNT := COUNT + 1 ) < 51 THEN DO;
CALL PR$CHAR( ' ' );
IF I < 10 THEN CALL PR$CHAR( ' ' );
IF I < 100 THEN CALL PR$CHAR( ' ' );
IF I < 1000 THEN CALL PR$CHAR( ' ' );
CALL PR$NUMBER( I );
IF COUNT MOD 10 = 0 THEN CALL PR$NL;
END;
ELSE IF COUNT = 500 THEN DO;
CALL PR$NUMBER( COUNT );
CALL PR$STRING( .'TH: $' );
CALL PR$NUMBER( I );
CALL PR$NL;
END;
END;
END;
 
EOF
</syntaxhighlight>
{{out}}
<pre>
1 24 30 40 42 54 56 66 70 78
88 102 104 105 110 114 128 130 135 136
138 152 154 165 170 174 182 184 186 189
190 195 222 230 231 232 238 246 248 250
255 258 266 273 282 285 286 290 296 297
500TH: 2526
</pre>
 
=={{header|Python}}==
3,037

edits