June 2018 Update
This commit is contained in:
parent
ba8067c3b7
commit
22f33d4004
5278 changed files with 84726 additions and 14379 deletions
44
Task/Vampire-number/Factor/vampire-number.factor
Normal file
44
Task/Vampire-number/Factor/vampire-number.factor
Normal 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
|
||||
45
Task/Vampire-number/Perl/vampire-number-2.pl
Normal file
45
Task/Vampire-number/Perl/vampire-number-2.pl
Normal 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");
|
||||
}
|
||||
|
|
@ -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
|
||||
|
|
|
|||
82
Task/Vampire-number/Ring/vampire-number.ring
Normal file
82
Task/Vampire-number/Ring/vampire-number.ring
Normal 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
|
||||
39
Task/Vampire-number/Sidef/vampire-number.sidef
Normal file
39
Task/Vampire-number/Sidef/vampire-number.sidef
Normal 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'}"
|
||||
}
|
||||
Loading…
Add table
Add a link
Reference in a new issue