Katagiri calls a number nude if it is divisible by each of its digits
e.g like 672.
Clearly this definition (there exist other as well!) implies nonzero numbers only.
a. How many nude numbers are there below 1,000,000?
b. Evaluate the smallest nude number which contains all the odd digits.
c. Find the smallest triplet of consecutive nontrivial nude numbers.
d. Prove that there is infinite number of nude numbers.
a. There are 9039 nude numbers below 1,000,000: the 9030 counted by the program below, plus the nine trivial cases of singledigit numbers 1 through 9, making 9039. Although the program went through 10,000,000, only those numbers below 1,000,000 were counted for purposes of part a. In case you're interested a modified version counts 52,981 under 10,000,000 other than the trivial 9.
b. The smallest nude number containing all the odd digits is 1117935. Other such numbers are shown in the output below, all being seven digits in length, the largest tested.
c. The smallest triplet of consecutive nontrivial nude numbers is 1111, 1112, 1113. After that the next two such triplets have seven digits in each of their members; they are listed below as part of the output.
d. All repunit numbers are nude as are all those of the form 11...112 or 11...115, and those with a number of 1's that's a multiple of three, followed by a 3 or a 6 or a multiple of 9 1's followed by a 9 plus such numbers with groups of three 1's replaced by a 3, and similar such.
Three in a row:
1111 1112 1113
1111111 1111112 1111113
1111115 1111116 1111117
Having all the odd digits:
1117935
1131795
1197315
1311975
1371195
1711395
1713915
1739115
1911735
7119315
7131915
7191135
7913115
9111375
9173115
9311715
9711135
Count of those over 10 and under 1,000,000:
9030
DefDbl AZ
Dim crlf$
Private Sub Form_Load()
Form1.Visible = True
Text1.Text = ""
crlf = Chr(13) + Chr(10)
For n = 10 To 10000000
DoEvents
s$ = LTrim(Str(n))
If InStr(s, "0") = 0 Then
good = 1
For i = 1 To Len(s)
dvr = Val(Mid(s, i, 1))
If n / dvr > Int(n / dvr) Then good = 0: Exit For
Next
If good Then
If n < 1000000 Then nudeCt = nudeCt + 1
inRow = inRow + 1
If inRow >= 3 Then
For j = n  inRow + 1 To n
Text1.Text = Text1.Text & Str(j)
Next
Text1.Text = Text1.Text & crlf
End If
hasAll = 1
For i = 1 To 5
If InStr(s, Mid("13579", i, 1)) = 0 Then hasAll = 0: Exit For
Next
If hasAll Then Text1.Text = Text1.Text & n & crlf
Else
inRow = 0
End If
Else
inRow = 0
End If
Next
Text1.Text = Text1.Text & crlf & nudeCt & " done"
End Sub

Posted by Charlie
on 20180807 10:37:21 