What is is the smallest number k such that k, 2k, 3k, 4k, 5k, and 6k, each contain all ten digits at least once?
At first I tried for 10-digit pandigital base values. The first time through, to save time, I went for even pandigitals to serve as 2k, as evidenced by the commented out code. When that didn't work, I left out the requirement for even number, and tried all 10-digit values for k. That didn't work. Then I added an outer loop to try one duplicated digit, zero through 9, and achieved success.
The multiples for the smallest successful k are:
1 36492195078
2 72984390156
3 109476585234
4 145968780312
5 182460975390
6 218953170468
As the numbers came out in order of the extra digit, I sorted the output (60 11-digit values of k work), bringing the smallest, with a duplicated 9, to the top. Each of these could serve as k:
36492195078
48602175913
48613021759
49021758613
49130217586
49219635078
53829197460
53829301746
53928301746
54601738293
54601739283
58829301746
59288301746
60174538293
60174539283
60174588293
60174592883
64820935179
64917935082
78036492195
78049219635
80253931746
80253994617
80317253946
80317392546
80317453926
80317539246
81725394603
81730253946
81739254603
81739302546
81745392603
81745393026
81746025393
81753924603
82064917935
82539301746
82539460173
82546017393
82601745393
83017253946
83017392546
83017453926
83017539246
85463728190
89465237801
89465237810
90175398246
93517906482
93780246551
93781024655
94652237801
94652237810
94655237801
94655237810
94785720163
94785721630
97539018246
98175390246
98246017539
DefDbl A-Z
Dim crlf$
Private Sub Form_Load()
Form1.Visible = True
Text1.Text = ""
crlf = Chr$(13) + Chr$(10)
digs$ = "1023456789"
For xtra = 0 To 9
s$ = digs + LTrim(Str(xtra)): h$ = s
Do
If Left(s, 1) > "0" Then
' If InStr("02468", Right(s, 1)) > 0 Then
k = Val(s)
good = 1
For mult = 2 To 6
ns$ = LTrim(Str(mult * k))
For i = 1 To 10
If InStr(ns, Mid(digs, i, 1)) = 0 Then good = 0: Exit For
Next
DoEvents
Next
If good Then Text1.Text = Text1.Text & k & crlf
' End If
End If
permute s
Loop Until s = h
Next xtra
Text1.Text = Text1.Text & crlf & " done"
End Sub
|
Posted by Charlie
on 2017-11-26 16:30:12 |