A372146 The smallest number k for which exactly n of its divisors are digitally balanced numbers in base 3 (A049354).
1, 11, 105, 420, 924, 2772, 6240, 4620, 18480, 13860, 55440, 69300, 120120, 180180, 240240, 360360, 514800, 720720, 1029600, 1801800, 2162160, 2522520, 2282280, 5045040, 7207200, 4564560, 6846840, 12612600, 15135120, 11411400, 20540520, 29343600, 22822800, 49729680
Offset: 0
Examples
Since A049354(1) = 11 it follows that a(0) = 1. The numbers 2 through 10 have no divisors in A049354 and A049354(1) = 11 = 102_3, so a(1) = 11. 105 has only two divisors in A049354, 15 = A049354(2) and 21 = A049354(4) and is the smallest with exactly two divisors in A049354, so a(2) = 105.
Programs
-
Magma
bal:=func
; a:=[]; for n in [0..34] do k:=1; while #[d:d in Divisors(k)|bal(d)] ne n do k:=k+1; end while; Append(~a,k); end for; a; -
Maple
N:= 15: # for terms before the first term >= 3^(N+1) db:= proc(n) option remember; local L,d,m; L:= convert(n,base,3); d:= nops(L); d mod 3 = 0 and 3*numboccur(0,L) = d and 3*numboccur(1,L) = d end proc: W:= Vector(3^(N+1),datatype=integer[4]): for d from 3 to N by 3 do for t from 3^(d-1) to 3^d-1 do if db(t) then J:= [seq(i, i=t..3^(N+1), t)]; W[J]:= W[J] +~ 1; fi od od: M:= max(W): V:= Array(0..M): count:= 0: for i from 1 to 3^(N+1) while count < M+1 do if V[W[i]] = 0 then V[W[i]]:= i; count:= count+1 fi; od: L:= convert(V,list): if not member(0,L,'m') then m:= M+2 fi: L[1..m-1]; # Robert Israel, Jun 03 2024
-
Mathematica
balQ[n_, b_] := balQ[n, b] = MinMax@ Differences@ DigitCount[n, b] == {0, 0}; f[n_] := DivisorSum[n, 1 &, balQ[#, 3] &]; seq[len_, nmax_] := Module[{s = Table[0, {len}], c = 0, n = 1, i}, While[c < len && n < nmax, i = f[n] + 1; If[i <= len && s[[i]] == 0, c++; s[[i]] = n]; n++]; s]; seq[12, 10^5] (* Amiram Eldar, Jun 03 2024 *)