Vampire number: Difference between revisions

m
m (syntax highlighting fixup automation)
m (→‎{{header|Wren}}: Minor tidy)
 
(5 intermediate revisions by 4 users not shown)
Line 1,037:
24959017348650 = 2947050 x 8469153 = 2949705 x 8461530 = 4125870 x 6049395 = 4129587 x 6043950 = 4230765 x 5899410
14593825548650 is not vampiric</pre>
 
=={{header|EasyLang}}==
{{trans|C}}
<syntaxhighlight>
func dtally x .
while x > 0
t += bitshift 1 (x mod 10 * 6)
x = x div 10
.
return t
.
proc fangs x . f[] .
f[] = [ ]
nd = floor log10 x + 1
if nd mod 2 = 1
return
.
nd = nd div 2
lo = higher pow 10 (nd - 1) (x + pow 10 nd - 2) div (pow 10 nd - 1)
hi = lower (x / lo) sqrt x
t = dtally x
for a = lo to hi
b = x div a
if a * b = x and (a mod 10 > 0 or b mod 10 > 0) and t = dtally a + dtally b
f[] &= a
.
.
.
proc show_fangs x f[] . .
write x & " "
for f in f[]
write " = " & f & " x " & x div f
.
print ""
.
x = 1
while n < 25
fangs x f[]
if len f[] > 0
n += 1
write n & ": "
show_fangs x f[]
.
x += 1
.
bigs[] = [ 16758243290880 24959017348650 14593825548650 ]
for x in bigs[]
fangs x f[]
if len f[] > 0
show_fangs x f[]
else
print x & " is not vampiric"
.
.
</syntaxhighlight>
 
=={{header|Eiffel}}==
Line 1,345 ⟶ 1,400:
24959017348650 { 2947050 8469153 } { 2949705 8461530 } { 4125870 6049395 } { 4129587 6043950 } { 4230765 5899410 }
</pre>
 
 
=={{header|Forth}}==
{{works with|gforth|0.7.3}}
 
<syntaxhighlight lang="Forth">: sqrt ( u -- sqrt ) ( Babylonian method )
dup 2/ ( first square root guess is half )
dup 0= if drop exit then ( sqrt[0]=0, sqrt[1]=1 )
begin dup >r 2dup / r> + 2/ ( stack: square old-guess new-guess )
2dup > while ( as long as guess is decreasing )
nip repeat ( forget old-guess and repeat )
drop nip ;
 
: ndigits ( n -- n ) 10 / dup 0<> if recurse then 1+ ;
 
: dtally ( n -- n )
10 /mod
dup 0<> if recurse then
swap 6 * 1 swap lshift + ;
 
: ?product ( x a b -- f ) * = ;
: ?dtally ( x a b -- f ) dtally rot dtally rot dtally rot + = ;
: ?ndigits ( a b -- f ) ndigits swap ndigits = ;
: ?0trail ( a b -- f ) 10 mod 0= swap 10 mod 0= and invert ;
 
: ?fang ( x a -- f )
2dup / 2>r
dup 2r@ ?product
swap 2r@ ?dtally and
2r@ ?ndigits and
2r> ?0trail and ;
 
: next-fang ( n a -- false | a true )
over sqrt swap 1+ ?do
dup i ?fang if drop i true unloop exit then
loop drop false ;
 
: ?vampire ( n -- false | a true ) 0 next-fang ;
: next-vampire ( n -- n a ) begin 1+ dup ?vampire until ;
 
: .product ( n a -- ) dup . ." x " / . ." = " ;
 
: .vampire ( n a -- )
cr
begin 2dup .product
over swap next-fang
while repeat
. ;
 
: .fangs ( n -- ) dup ?vampire if .vampire else cr . ." is not vampiric." then ;
 
: vampires ( n -- )
1 swap
0 do next-vampire over swap .vampire loop drop ;
 
25 vampires
16758243290880 .fangs
24959017348650 .fangs
14593825548650 .fangs</syntaxhighlight>
 
{{out}}<pre>25 vampires
21 x 60 = 1260
15 x 93 = 1395
35 x 41 = 1435
30 x 51 = 1530
21 x 87 = 1827
27 x 81 = 2187
80 x 86 = 6880
201 x 510 = 102510
260 x 401 = 104260
210 x 501 = 105210
204 x 516 = 105264
150 x 705 = 105750
135 x 801 = 108135
158 x 701 = 110758
152 x 761 = 115672
161 x 725 = 116725
167 x 701 = 117067
141 x 840 = 118440
201 x 600 = 120600
231 x 534 = 123354
281 x 443 = 124483
152 x 824 = 125248
231 x 543 = 125433
204 x 615 = 246 x 510 = 125460
251 x 500 = 125500 ok
16758243290880 .fangs
1982736 x 8452080 = 2123856 x 7890480 = 2751840 x 6089832 = 2817360 x 5948208 = 16758243290880 ok
24959017348650 .fangs
2947050 x 8469153 = 2949705 x 8461530 = 4125870 x 6049395 = 4129587 x 6043950 = 4230765 x 5899410 = 24959017348650 ok
14593825548650 .fangs
14593825548650 is not vampiric. ok</pre>
 
 
=={{header|FreeBASIC}}==
Line 3,375 ⟶ 3,524:
125500: [251,500]
126027: [201,627]
</pre>
 
=={{header|RPL}}==
{{works with|HP|49}}
« 0 10 NDPUN →LIST
'''WHILE''' OVER '''REPEAT'''
SWAP 10 IDIV2 1 +
ROT SWAP DUP2 GET 1 + PUT
'''END''' NIP
» '<span style="color:blue">DIGCNT</span>' STO
« DUP XPON LASTARG <span style="color:blue">DIGCNT</span> 2 / IP { } DUP
→ n digc fangsize result divs
« n DIVIS SORT
DUP « XPON » MAP
DUP fangsize POS
'''IF''' DUP '''THEN'''
SWAP fangsize 1 + POS 1 - PICK3 SIZE MIN '''FOR''' j
DUP j GET
'''CASE'''
divs OVER POS '''THEN''' DROP '''END'''
n OVER /
DUP XPON fangsize ≠ '''THEN''' DROP2 '''END'''
2 →LIST
DUP 10 MOD { 0 0 } == '''THEN''' DROP '''END'''
DUP « →STR » MAP ∑LIST STR→ <span style="color:blue">DIGCNT</span> digc ≠ '''THEN''' DROP '''END'''
DUP 2 GET 'divs' STO+
'result' STO+
'''END'''
'''NEXT'''
'''ELSE''' DROP2 '''END'''
DROP result
» » '<span style="color:blue">VAMPIRE?</span>' STO
« '''IF''' OVER SIZE '''THEN'''
1 PICK3 SIZE '''FOR''' j
" = " +
OVER j GET +
"*" + OVER j 1 + GET +
2 '''STEP''' NIP
'''ELSE''' DROP2 "Not vampiric" '''END'''
» '<span style="color:blue">V→STR</span>' STO <span style="color:grey">@ ''( { (d1,d2) } n → "n = d1*d2" )''</span>
« { } 10
'''WHILE''' OVER SIZE 8 < '''REPEAT'''
DUP <span style="color:blue">VAMPIRE?</span>
'''IF''' DUP SIZE '''THEN'''
OVER <span style="color:blue">V→STR</span>
ROT SWAP + SWAP
'''ELSE''' DROP '''END'''
1 +
'''IF''' DUP XPON 2 MOD NOT '''THEN''' 10 * '''END'''
'''END''' DROP
{ 16758243290880 24959017348650 14593825548650 }
1 « DUP <span style="color:blue">VAMPIRE?</span> SWAP <span style="color:blue">V→STR</span> » DOLIST
» '<span style="color:blue">TASK</span>' STO
Since the search is very slow, it has been limited to the first eight numbers:
{{out}}
<pre>
2: { "1260 = 60*21" "1395 = 15*93" "1435 = 35*41" "1530 = 30*51" "1827 = 21*87" "2187 = 27*81" "6880 = 80*86" "102510 = 510*201" }
1: { "16758243290880 = 2817360*5948208 = 2751840*6089832 = 2123856*7890480 = 1982736*8452080"
"24959017348650 = 4230765*5899410 = 4129587*6043950 = 4125870*6049395 = 2949705*8461530 = 2947050*8469153"
"Not vampiric" }
</pre>
 
Line 3,900 ⟶ 4,112:
</pre>
 
=={{header|V (Vlang)}}==
{{trans|Go}}
<syntaxhighlight lang="v (vlang)">import math
fn max(a u64, b u64) u64 {
if a > b {
Line 4,043 ⟶ 4,255:
{{trans|Go}}
{{libheader|Wren-fmt}}
<syntaxhighlight lang="ecmascriptwren">import "./fmt" for Fmt
 
var ndigits = Fn.new { |x|
9,482

edits