June 2018 Update

This commit is contained in:
Ingy döt Net 2018-06-22 20:57:24 +00:00
parent ba8067c3b7
commit 22f33d4004
5278 changed files with 84726 additions and 14379 deletions

View file

@ -0,0 +1,44 @@
USING: combinators.short-circuit fry io kernel lists lists.lazy math
math.combinatorics math.functions math.primes.factors math.statistics
math.text.utils prettyprint sequences sets ;
IN: rosetta-code.vampire-number
: digits ( n -- m )
log10 floor >integer 1 + ;
: same-digits? ( n n1 n2 -- ? )
[ 1 digit-groups ] tri@ append [ histogram ] bi@ = ;
: half-len-factors ( n -- seq )
[ divisors ] [ digits ] bi 2/ '[ digits _ = ] filter ;
: same-digit-factors ( n -- seq )
dup half-len-factors 2 <combinations> [ first2 same-digits? ] with filter ;
: under-two-trailing-zeros? ( seq -- ? )
[ 10 mod ] map [ 0 = ] count 2 < ;
: tentative-fangs ( n -- seq )
same-digit-factors [ under-two-trailing-zeros? ] filter ;
: fangs ( n -- seq )
[ tentative-fangs ] [ ] bi '[ product _ = ] filter ;
: vampire? ( n -- ? )
{ [ digits even? ] [ fangs empty? not ] } 1&& ;
: first25 ( -- seq )
25 0 lfrom [ vampire? ] lfilter ltake list>array ;
: .vamp-with-fangs ( n -- )
[ pprint bl ] [ fangs [ pprint bl ] each ] bi nl ;
: part1 ( -- )
first25 [ .vamp-with-fangs ] each ;
: part2 ( -- ) { 16758243290880 24959017348650 14593825548650 }
[ dup vampire? [ .vamp-with-fangs ] [ drop ] if ] each ;
: main ( -- ) part1 part2 ;
MAIN: main

View file

@ -0,0 +1,45 @@
use ntheory qw(sqrtint logint divisors);
sub is_vampire {
my ($n) = @_;
return if (length($n) % 2 or $n < 0);
my $l1 = 10**logint(sqrtint($n), 10);
my $l2 = sqrtint($n);
my $s = join('', sort split(//, $n));
my @fangs;
foreach my $d (divisors($n)) {
$d < $l1 and next;
$d > $l2 and last;
my $t = $n / $d;
next if ($d % 10 == 0 and $t % 10 == 0);
next if (join('', sort split(//, "$d$t")) ne $s);
push @fangs, [$d, $t];
}
return @fangs;
}
print "First 25 Vampire Numbers:\n";
for (my ($n, $i) = (1, 1) ; $i <= 25 ; ++$n) {
if (my @fangs = is_vampire($n)) {
printf("%2d. %6s : %s\n", $i++, $n, join(' ', map { "[@$_]" } @fangs));
}
}
print "\nIndividual tests:\n";
foreach my $n (16758243290880, 24959017348650, 14593825548650) {
my @fangs = is_vampire($n);
print("$n: ", (@fangs ? join(' ', map { "[@$_]" } @fangs)
: "is not a vampire number"), "\n");
}

View file

@ -6,37 +6,35 @@ parse arg N .; if N=='' | N=="," then N=25 /*Not specified? Then use the
#=0 /*num. of vampire numbers found, so far*/
if N>0 then do j=1260 until # >= N /*search until N vampire numbers found.*/
if length(j) // 2 then do; j=j*10 - 1; iterate; end /*adjust J*/
_=right(J,1); if j<!._ then iterate /*is number tenable based on last dig? */
_=right(j,1); if j<!._ then iterate /*is number tenable based on last dig? */
f=vampire(j); if f=='' then iterate /*Are fangs null? Yes, not vampire. */
#=#+1 /*bump the vampire count, Vlad. */
#=# + 1 /*bump the vampire count, Vlad. */
say 'vampire number' right(#,length(N)) "is: " j', fangs=' f
end /*j*/ /* [↑] process a range of numbers. */
else do; N=abs(N); f=vampire(N) /* [↓] process one number; get fangs.*/
if f=='' then say N " isn't a vampire number."
else say N " is a vampire number, fangs=" f
end
else do; N=abs(N); f=vampire(N) /* [↓] process a number; obtain fangs.*/
if f=='' then say N " isn't a vampire number."
else say N " is a vampire number, fangs=" f
end
exit /*stick a fork in it, we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
vampire: procedure; parse arg ?,, $. !! bot; L=length(?); if L//2 then return !!
w=L%2 /* [↑] L an odd length? Then ¬vampire*/
do k=1 for L; _=substr(?,k,1); $._=$._ || _; end /*k*/
do m=0 for 10; bot=bot || $.m; end /*m*/
vampire: procedure; parse arg ?,, $. a bot; L=length(?); w=L % 2
if L//2 then return '' /*Is L an odd length? Then ¬vampire.*/
do k=1 for L; _=substr(?,k,1); $._=$._ || _; end /*k*/
do m=0 for 10; bot=bot || $.m; end /*m*/
top=left( reverse(bot), w); bot=left(bot, w) /*determine limits of search*/
inc=?//2 + 1 /*? is odd? INC=2. No? INC=1*/
start=max(bot, 10**(w-1)); if inc=2 then if start//2==0 then start=start+1
/* [↑] odd START if odd INC*/
do d=start to min(top, 10**w-1) by inc
if ?//d\==0 then iterate
if verify(d, ?) \==0 then iterate
q=?%d; if d>q then iterate
if q*d//9\==(q+d)//9 then iterate /*modulo 9 congruence test. */
if verify(q, ?) \==0 then iterate
if right(q, 1) ==0 then if right(d, 1)==0 then iterate
if length(q)\==w then iterate
dq=d || q; t=?
do i=1 for L; p=pos( substr(dq, i, 1), t)
if p==0 then iterate d; t=delstr(t, p, 1)
end /*i*/
!!=!! '['d""q']'
end /*d*/
return !!
beg=max(bot, 10**(w-1)); if inc=2 then if beg//2==0 then beg=beg + 1
/* [↑] odd BEG if odd INC*/
do d=beg to min(top, 10**w - 1) by inc
if ? // d \==0 then iterate /*? not ÷ by D? Then skip,*/
q=? % d; if d>q then iterate /*is D > Q Then skip.*/
if q*d//9 \== (q+d)//9 then iterate /*modulo 9 congruence test. */
if length(q) \==w then iterate /*Len of Q ^= W? Then skip.*/
if right(q, 1) ==0 then if right(d, 1) ==0 then iterate
dq=d || q
t=?; do i=1 for L; p=pos( substr(dq, i, 1), t)
if p==0 then iterate d; t=delstr(t, p, 1)
end /*i*/
a=a '['d""q']'
end /*d*/
return a

View file

@ -0,0 +1,82 @@
# Project : Vampire number
# Date : 2018/02/01
# Author : Gal Zsolt [~ CalmoSoft ~]
# Email : <calmosoft@gmail.com>
for p = 10 to 127000
vampire(p)
next
func vampire(listnum)
sum = 0
flag = 1
list = list(len(string(listnum)))
total = newlist(len(list),2)
for n = 1 to len(string(listnum))
liststr = string(listnum)
list[n] = liststr[n]
next
for perm = 1 to fact(len(list))
numstr = substr(list2str(list), nl, "")
num1 = number(left(numstr,len(numstr)/2))
num2 = number(right(numstr,len(numstr)/2))
if (listnum = num1 * num2)
for n = 1 to len(total)
if (num1 = total[n][2] and num2 = total[n][1]) or
(num1 = total[n][1] and num2 = total[n][2])
flag = 0
ok
next
if flag = 1
sum = sum + 1
total[sum][1] = num1
total[sum][2] = num2
see "" + listnum + ": [" + num1 + "," + num2 + "]" + nl
ok
ok
nextPermutation(list)
next
func nextPermutation(a)
elementcount = len(a)
if elementcount < 1 then return ok
pos = elementcount-1
while a[pos] >= a[pos+1]
pos -= 1
if pos <= 0 permutationReverse(a, 1, elementcount)
return ok
end
last = elementcount
while a[last] <= a[pos]
last -= 1
end
temp = a[pos]
a[pos] = a[last]
a[last] = temp
permutationReverse(a, pos+1, elementcount)
func permutationReverse a, first, last
while first < last
temp = a[first]
a[first] = a[last]
a[last] = temp
first += 1
last -= 1
end
func fact(nr)
if nr = 1
return 1
else
return nr * fact(nr-1)
ok
func newlist(x,y)
if isstring(x) x=0+x ok
if isstring(y) y=0+y ok
alist = list(x)
for t in alist
t = list(y)
next
return alist

View file

@ -0,0 +1,39 @@
func is_vampire (n) {
return [] if n.ilog10.is_even
var l1 = n.isqrt.ilog10.ipow10
var l2 = n.isqrt
var s = n.digits.sort.join
gather {
n.divisors.each { |d|
d < l1 && next
d > l2 && break
var t = n/d
next if (d%%10 && t%%10)
next if ("#{d}#{t}".sort != s)
take([d, t])
}
}
}
say "First 25 Vampire Numbers:"
with (1) { |i|
for (var n = 1; i <= 25; ++n) {
var fangs = is_vampire(n)
printf("%2d. %6s : %s\n", i++, n, fangs.join(' ')) if fangs
}
}
say "\nIndividual tests:"
[16758243290880, 24959017348650, 14593825548650].each { |n|
var fangs = is_vampire(n)
say "#{n}: #{fangs ? fangs.join(', ') : 'is not a vampire number'}"
}