The program below finds 93 almost-pandigital sets below 1000 as well as 43 actual pandigital sets. The numbers and their associated sets follows:
Listed are: the number; whether 9 or 10 different digits are accounted for; if one digit is missing, what that digit is; and the set of divisors.
The output was sorted so that the solutions set for this puzzle, the almost-pandigital, comes first. Within each row, the divisors themselves are not in numerical order, but rather: odd first, then even; within those groups, non-multiples of 3 followed by those that are multiples of 3 but not of 3^2, then multiples of 3^2, etc; that is, within any set of multiples of a given prime, non-multiples come first, then multiples of the first power, second power, etc., with the hierarchy being the lowest prime to the highest.
54 9 0 1,3,9,27,2,6,18,54
90 9 7 1,5,3,15,9,45,2,10,6,30,18,90
114 9 0 1,19,3,57,2,38,6,114
152 9 0 1,19,2,38,4,76,8,152
156 9 0 1,13,3,39,2,26,6,78,4,52,12,156
162 9 0 1,3,9,27,81,2,6,18,54,162
174 9 0 1,29,3,87,2,58,6,174
180 9 7 1,5,3,15,9,45,2,10,6,30,18,90,4,20,12,60,36,180
204 9 9 1,17,3,51,2,34,6,102,4,68,12,204
228 9 0 1,19,3,57,2,38,6,114,4,76,12,228
252 9 0 1,7,3,21,9,63,2,14,6,42,18,126,4,28,12,84,36,252
280 9 9 1,7,5,35,2,14,10,70,4,28,20,140,8,56,40,280
315 9 8 1,7,5,35,3,21,15,105,9,63,45,315
316 9 0 1,79,2,158,4,316
340 9 9 1,17,5,85,2,34,10,170,4,68,20,340
342 9 0 1,19,3,57,9,171,2,38,6,114,18,342
348 9 0 1,29,3,87,2,58,6,174,4,116,12,348
354 9 0 1,59,3,177,2,118,6,354
356 9 0 1,89,2,178,4,356
364 9 0 1,13,7,91,2,26,14,182,4,52,28,364
378 9 0 1,7,3,21,9,63,27,189,2,14,6,42,18,126,54,378
390 9 4 1,13,5,65,3,39,15,195,2,26,10,130,6,78,30,390
392 9 0 1,7,49,2,14,98,4,28,196,8,56,392
405 9 6 1,5,3,15,9,45,27,135,81,405
408 9 9 1,17,3,51,2,34,6,102,4,68,12,204,8,136,24,408
414 9 5 1,23,3,69,9,207,2,46,6,138,18,414
420 9 9 1,7,5,35,3,21,15,105,2,14,10,70,6,42,30,210,4,28,20,140,12,84,60,420
456 9 0 1,19,3,57,2,38,6,114,4,76,12,228,8,152,24,456
468 9 0 1,13,3,39,9,117,2,26,6,78,18,234,4,52,12,156,36,468
472 9 0 1,59,2,118,4,236,8,472
474 9 0 1,79,3,237,2,158,6,474
480 9 7 1,5,3,15,2,10,6,30,4,20,12,60,8,40,24,120,16,80,48,240,32,160,96,480
486 9 0 1,3,9,27,81,243,2,6,18,54,162,486
490 9 6 1,7,49,5,35,245,2,14,98,10,70,490
510 9 9 1,17,5,85,3,51,15,255,2,34,10,170,6,102,30,510
516 9 0 1,43,3,129,2,86,6,258,4,172,12,516
522 9 0 1,29,3,87,9,261,2,58,6,174,18,522
532 9 0 1,19,7,133,2,38,14,266,4,76,28,532
534 9 0 1,89,3,267,2,178,6,534
546 9 0 1,13,7,91,3,39,21,273,2,26,14,182,6,78,42,546
552 9 0 1,23,3,69,2,46,6,138,4,92,12,276,8,184,24,552
556 9 0 1,139,2,278,4,556
560 9 9 1,7,5,35,2,14,10,70,4,28,20,140,8,56,40,280,16,112,80,560
564 9 0 1,47,3,141,2,94,6,282,4,188,12,564
576 9 0 1,3,9,2,6,18,4,12,36,8,24,72,16,48,144,32,96,288,64,192,576
582 9 0 1,97,3,291,2,194,6,582
584 9 0 1,73,2,146,4,292,8,584
588 9 0 1,7,49,3,21,147,2,14,98,6,42,294,4,28,196,12,84,588
592 9 0 1,37,2,74,4,148,8,296,16,592
594 9 0 1,11,3,33,9,99,27,297,2,22,6,66,18,198,54,594
600 9 9 1,5,25,3,15,75,2,10,50,6,30,150,4,20,100,12,60,300,8,40,200,24,120,600
616 9 9 1,11,7,77,2,22,14,154,4,44,28,308,8,88,56,616
632 9 0 1,79,2,158,4,316,8,632
636 9 7 1,53,3,159,2,106,6,318,4,212,12,636
658 9 0 1,47,7,329,2,94,14,658
672 9 0 1,7,3,21,2,14,6,42,4,28,12,84,8,56,24,168,16,112,48,336,32,224,96,672
676 9 0 1,13,169,2,26,338,4,52,676
680 9 9 1,17,5,85,2,34,10,170,4,68,20,340,8,136,40,680
684 9 0 1,19,3,57,9,171,2,38,6,114,18,342,4,76,12,228,36,684
690 9 7 1,23,5,115,3,69,15,345,2,46,10,230,6,138,30,690
696 9 0 1,29,3,87,2,58,6,174,4,116,12,348,8,232,24,696
704 9 9 1,11,2,22,4,44,8,88,16,176,32,352,64,704
712 9 0 1,89,2,178,4,356,8,712
716 9 0 1,179,2,358,4,716
752 9 0 1,47,2,94,4,188,8,376,16,752
754 9 0 1,29,13,377,2,58,26,754
765 9 0 1,17,5,85,3,51,15,255,9,153,45,765
768 9 0 1,3,2,6,4,12,8,24,16,48,32,96,64,192,128,384,256,768
774 9 0 1,43,3,129,9,387,2,86,6,258,18,774
784 9 0 1,7,49,2,14,98,4,28,196,8,56,392,16,112,784
798 9 0 1,19,7,133,3,57,21,399,2,38,14,266,6,114,42,798
816 9 9 1,17,3,51,2,34,6,102,4,68,12,204,8,136,24,408,16,272,48,816
826 9 0 1,59,7,413,2,118,14,826
828 9 5 1,23,3,69,9,207,2,46,6,138,18,414,4,92,12,276,36,828
836 9 5 1,19,11,209,2,38,22,418,4,76,44,836
840 9 9 1,7,5,35,3,21,15,105,2,14,10,70,6,42,30,210,4,28,20,140,12,84,60,420,8,56,40,280,24,168,120,840
858 9 0 1,13,11,143,3,39,33,429,2,26,22,286,6,78,66,858
860 9 9 1,43,5,215,2,86,10,430,4,172,20,860
872 9 5 1,109,2,218,4,436,8,872
896 9 0 1,7,2,14,4,28,8,56,16,112,32,224,64,448,128,896
904 9 7 1,113,2,226,4,452,8,904
920 9 7 1,23,5,115,2,46,10,230,4,92,20,460,8,184,40,920
930 9 7 1,31,5,155,3,93,15,465,2,62,10,310,6,186,30,930
940 9 6 1,47,5,235,2,94,10,470,4,188,20,940
944 9 0 1,59,2,118,4,236,8,472,16,944
948 9 0 1,79,3,237,2,158,6,474,4,316,12,948
950 9 6 1,19,5,95,25,475,2,38,10,190,50,950
952 9 0 1,17,7,119,2,34,14,238,4,68,28,476,8,136,56,952
956 9 0 1,239,2,478,4,956
960 9 7 1,5,3,15,2,10,6,30,4,20,12,60,8,40,24,120,16,80,48,240,32,160,96,480,64,320,192,960
986 9 0 1,29,17,493,2,58,34,986
988 9 0 1,19,13,247,2,38,26,494,4,76,52,988
990 9 7 1,11,5,55,3,33,15,165,9,99,45,495,2,22,10,110,6,66,30,330,18,198,90,990
108 10 1,3,9,27,2,6,18,54,4,12,36,108
216 10 1,3,9,27,2,6,18,54,4,12,36,108,8,24,72,216
270 10 1,5,3,15,9,45,27,135,2,10,6,30,18,90,54,270
304 10 1,19,2,38,4,76,8,152,16,304
306 10 1,17,3,51,9,153,2,34,6,102,18,306
312 10 1,13,3,39,2,26,6,78,4,52,12,156,8,104,24,312
324 10 1,3,9,27,81,2,6,18,54,162,4,12,36,108,324
360 10 1,5,3,15,9,45,2,10,6,30,18,90,4,20,12,60,36,180,8,40,24,120,72,360
380 10 1,19,5,95,2,38,10,190,4,76,20,380
406 10 1,29,7,203,2,58,14,406
432 10 1,3,9,27,2,6,18,54,4,12,36,108,8,24,72,216,16,48,144,432
450 10 1,5,25,3,15,75,9,45,225,2,10,50,6,30,150,18,90,450
504 10 1,7,3,21,9,63,2,14,6,42,18,126,4,28,12,84,36,252,8,56,24,168,72,504
540 10 1,5,3,15,9,45,27,135,2,10,6,30,18,90,54,270,4,20,12,60,36,180,108,540
570 10 1,19,5,95,3,57,15,285,2,38,10,190,6,114,30,570
608 10 1,19,2,38,4,76,8,152,16,304,32,608
612 10 1,17,3,51,9,153,2,34,6,102,18,306,4,68,12,204,36,612
624 10 1,13,3,39,2,26,6,78,4,52,12,156,8,104,24,312,16,208,48,624
630 10 1,7,5,35,3,21,15,105,9,63,45,315,2,14,10,70,6,42,30,210,18,126,90,630
648 10 1,3,9,27,81,2,6,18,54,162,4,12,36,108,324,8,24,72,216,648
654 10 1,109,3,327,2,218,6,654
702 10 1,13,3,39,9,117,27,351,2,26,6,78,18,234,54,702
708 10 1,59,3,177,2,118,6,354,4,236,12,708
714 10 1,17,7,119,3,51,21,357,2,34,14,238,6,102,42,714
720 10 1,5,3,15,9,45,2,10,6,30,18,90,4,20,12,60,36,180,8,40,24,120,72,360,16,80,48,240,144,720
728 10 1,13,7,91,2,26,14,182,4,52,28,364,8,104,56,728
756 10 1,7,3,21,9,63,27,189,2,14,6,42,18,126,54,378,4,28,12,84,36,252,108,756
760 10 1,19,5,95,2,38,10,190,4,76,20,380,8,152,40,760
780 10 1,13,5,65,3,39,15,195,2,26,10,130,6,78,30,390,4,52,20,260,12,156,60,780
810 10 1,5,3,15,9,45,27,135,81,405,2,10,6,30,18,90,54,270,162,810
812 10 1,29,7,203,2,58,14,406,4,116,28,812
864 10 1,3,9,27,2,6,18,54,4,12,36,108,8,24,72,216,16,48,144,432,32,96,288,864
870 10 1,29,5,145,3,87,15,435,2,58,10,290,6,174,30,870
900 10 1,5,25,3,15,75,9,45,225,2,10,50,6,30,150,18,90,450,4,20,100,12,60,300,36,180,900
910 10 1,13,7,91,5,65,35,455,2,26,14,182,10,130,70,910
912 10 1,19,3,57,2,38,6,114,4,76,12,228,8,152,24,456,16,304,48,912
918 10 1,17,3,51,9,153,27,459,2,34,6,102,18,306,54,918
924 10 1,11,7,77,3,33,21,231,2,22,14,154,6,66,42,462,4,44,28,308,12,132,84,924
936 10 1,13,3,39,9,117,2,26,6,78,18,234,4,52,12,156,36,468,8,104,24,312,72,936
945 10 1,7,5,35,3,21,15,105,9,63,45,315,27,189,135,945
954 10 1,53,3,159,9,477,2,106,6,318,18,954
972 10 1,3,9,27,81,243,2,6,18,54,162,486,4,12,36,108,324,972
980 10 1,7,49,5,35,245,2,14,98,10,70,490,4,28,196,20,140,980
Interesting fact: The first number whose set of divisors has all digits except 2 is 3815, whose divisors are 1,109,7,763,5,545,35 and 3815. All except 3 is 1816, with divisors 1,227,2,454,4,908,8,1816. Thus all digits, except of course 1, are possible as the missing digit, though 2 and 3 require going beyond number 1000.
DefDbl A-Z
Dim crlf$, fct(20, 1), flist$, f, divisor
Private Sub Form_Load()
Form1.Visible = True
Text1.Text = ""
crlf = Chr$(13) + Chr$(10)
For i = 10 To 1000
f = factor(i)
flist = ""
divisor = 1
vary 1
digct = 0
flist = Left(flist, Len(flist) - 1)
ReDim had(9)
For j = 1 To Len(flist)
If Mid(flist, j, 1) <> "," Then
If InStr(flist, Mid(flist, j, 1)) = j Then digct = digct + 1: had(Val(Mid(flist, j, 1))) = 1
End If
Next
If digct > 8 Then
Text1.Text = Text1.Text & mform(i, "####0") & mform(digct, "##0") & " "
For j = 0 To 9
If had(j) = 0 Then Text1.Text = Text1.Text & j
Next
If digct = 10 Then
Text1.Text = Text1.Text & " "
pdCt = pdCt + 1
Else
apdCt = apdCt + 1
End If
Text1.Text = Text1.Text & " " & flist & crlf
End If
Next
Text1.Text = Text1.Text & crlf & apdCt & Str(pdCt) & " done"
End Sub
Function mform$(x, t$)
a$ = Format$(x, t$)
If Len(a$) < Len(t$) Then a$ = Space$(Len(t$) - Len(a$)) & a$
mform$ = a$
End Function
Sub vary(wh)
For i = 0 To fct(wh, 1)
savediv = divisor
divisor = Int(divisor * fct(wh, 0) ^ i + 0.5)
If wh = f Then
flist = flist + LTrim(Str(divisor)) + ","
Else
vary wh + 1
End If
divisor = savediv
Next
End Sub
Function factor(num)
diffCt = 0: good = 1
nm1 = Abs(num): If nm1 > 0 Then limit = Sqr(nm1) Else limit = 0
If limit <> Int(limit) Then limit = Int(limit + 1)
dv = 2: GoSub DivideIt
dv = 3: GoSub DivideIt
dv = 5: GoSub DivideIt
dv = 7
Do Until dv > limit
GoSub DivideIt: dv = dv + 4 '11
GoSub DivideIt: dv = dv + 2 '13
GoSub DivideIt: dv = dv + 4 '17
GoSub DivideIt: dv = dv + 2 '19
GoSub DivideIt: dv = dv + 4 '23
GoSub DivideIt: dv = dv + 6 '29
GoSub DivideIt: dv = dv + 2 '31
GoSub DivideIt: dv = dv + 6 '37
If INKEY$ = Chr$(27) Then s$ = Chr$(27): Exit Function
Loop
If nm1 > 1 Then diffCt = diffCt + 1: fct(diffCt, 0) = nm1: fct(diffCt, 1) = 1
factor = diffCt
Exit Function
DivideIt:
cnt = 0
Do
q = Int(nm1 / dv)
If q * dv = nm1 And nm1 > 0 Then
nm1 = q: cnt = cnt + 1: If nm1 > 0 Then limit = Sqr(nm1) Else limit = 0
If limit <> Int(limit) Then limit = Int(limit + 1)
Else
Exit Do
End If
Loop
If cnt > 0 Then
diffCt = diffCt + 1
fct(diffCt, 0) = dv
fct(diffCt, 1) = cnt
End If
Return
End Function
Edited on July 22, 2017, 11:37 am
|
Posted by Charlie
on 2017-07-22 11:32:40 |