Idoneal numbers: Difference between revisions
Added ABC
m (→{{header|Wren}}: Changed to Wren S/H) |
(Added ABC) |
||
| (3 intermediate revisions by the same user not shown) | |||
Line 47:
</syntaxhighlight>
{{out}}
<pre>
1 2 3 4 5 6 7 8 9 10 12 13 15
16 18 21 22 24 25 28 30 33 37 40 42 45
48 57 58 60 70 72 78 85 88 93 102 105 112
120 130 133 165 168 177 190 210 232 240 253 273 280
312 330 345 357 385 408 462 520 760 840 1320 1365 1848
</pre>
=={{header|ABC}}==
<syntaxhighlight lang="abc">
HOW TO RETURN a over b: RETURN floor( a / b )
HOW TO REPORT is.idoneal n:
PUT 1 IN idoneal
PUT 0 IN a
PUT n over 2 IN max.a
WHILE idoneal = 1 AND a < max.a:
PUT a + 1 IN a
PUT a IN b
PUT n IN c
PUT 0 IN sum
PUT 1 IN again
WHILE b < c AND b < n - 1 AND sum <= n AND idoneal = 1:
PUT b + 1 IN b
PUT a * b IN ab
PUT ( n - ab ) over ( a + b ) IN c
PUT ab + ( c * ( b + a ) ) IN sum
IF c > b AND sum = n:
PUT 0 IN idoneal
REPORT idoneal = 1
PUT 0 IN count
PUT 0 IN n
WHILE count < 65:
PUT n + 1 IN n
IF is.idoneal n:
WRITE n >> 5
PUT count + 1 IN count
IF count mod 13 = 0: WRITE /
</syntaxhighlight>
{{out}}
<pre>
Line 119 ⟶ 160:
FOR n WHILE count < max count DO
BOOL idoneal := TRUE;
FOR a TO n
FOR b FROM a + 1 TO n - 1
WHILE INT ab = a * b;
Line 125 ⟶ 166:
INT sum = ab + ( c * ( b + a ) );
sum <= n
AND b < c
AND ( idoneal := c <= b OR sum /= n )
DO SKIP OD
Line 134 ⟶ 176:
OD
END
</syntaxhighlight>
{{out}}
<pre>
1 2 3 4 5 6 7 8 9 10 12 13 15
16 18 21 22 24 25 28 30 33 37 40 42 45
48 57 58 60 70 72 78 85 88 93 102 105 112
120 130 133 165 168 177 190 210 232 240 253 273 280
312 330 345 357 385 408 462 520 760 840 1320 1365 1848
</pre>
=={{header|ALGOL W}}==
<syntaxhighlight lang="algolw">
begin % find idoneal numbers - numbers that cannot be written as ab + bc + ac %
% where 0 < a < b < c %
% there are 65 known idoneal numbers %
integer count, MAX_COUNT, n;
MAX_COUNT := 65;
count := 0;
n := 0;
while count < MAX_COUNT do begin
logical idoneal;
integer a;
n := n + 1;
idoneal := true;
a := 1;
while ( a + 2 ) < n and idoneal do begin
integer b;
b := a + 1;
while begin
integer ab, sum;
ab := a * b;
sum := 0;
if ab < n then begin
integer c;
c := ( n - ab ) div ( a + b );
sum := ab + ( c * ( b + a ) );
if c > b and sum = n then idoneal := false;
b := b + 1
end if_ab_lt_n ;
sum <= n and idoneal and ab < n
end do begin end;
a := a + 1
end;
if idoneal then begin
count := count + 1;
writeon( i_w := 4, s_w := 0, " ", n );
if count rem 13 = 0 then write()
end if_idoneal
end while_count_lt_MAX_COUNT
end.
</syntaxhighlight>
{{out}}
Line 1,086 ⟶ 1,179:
1365
1848
</pre>
=={{header|PL/M}}==
{{works with|8080 PL/M Compiler}} ... under CP/M (or an emulator)
<syntaxhighlight lang="plm">
100H: /* FIND IDONEAL NUMBERS - NUMBERS THAT CANNOT BE WRITTEN */
/* AS AB + BC + AC WHERE 0 < A < B < C */
/* THERE ARE 65 KNOWN IDONEAL NUMBERS */
/* CP/M BDOS 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;
/* TASK */
DECLARE TRUE LITERALLY '0FFH', FALSE LITERALLY '0';
DECLARE ( COUNT, N, A, B, C, AB, SUM ) ADDRESS;
DECLARE ( IDONEAL, FINISHED ) BYTE;
DECLARE MAX$COUNT LITERALLY '65';
COUNT, N = 0;
DO WHILE COUNT < MAX$COUNT;
N = N + 1;
IDONEAL = TRUE;
A = 1;
DO WHILE ( A + 2 ) < N AND IDONEAL;
B = A + 1;
FINISHED = FALSE;
DO WHILE NOT FINISHED;
AB = A * B;
SUM = 0;
IF AB < N THEN DO;
C = ( N - AB ) / ( A + B );
SUM = AB + ( C * ( B + A ) );
IF C > B AND SUM = N THEN IDONEAL = FALSE;
B = B + 1;
END;
FINISHED = SUM > N OR NOT IDONEAL OR AB >= N;
END;
A = A + 1;
END;
IF IDONEAL THEN DO;
CALL PR$CHAR( ' ' );
IF N < 10 THEN CALL PR$CHAR( ' ' );
IF N < 100 THEN CALL PR$CHAR( ' ' );
IF N < 1000 THEN CALL PR$CHAR( ' ' );
CALL PR$NUMBER( N );
IF ( COUNT := COUNT + 1 ) MOD 13 = 0 THEN CALL PR$NL;
END;
END;
EOF
</syntaxhighlight>
{{out}}
<pre>
1 2 3 4 5 6 7 8 9 10 12 13 15
16 18 21 22 24 25 28 30 33 37 40 42 45
48 57 58 60 70 72 78 85 88 93 102 105 112
120 130 133 165 168 177 190 210 232 240 253 273 280
312 330 345 357 385 408 462 520 760 840 1320 1365 1848
</pre>
| |||