A number puzzle

1

I need to generate combinations of 3 , 3 digit numbers where each digit (1 thru 9) only appears ONE time so the first seq would be 123, 456, 789 , then 134, 567, 892 or something

here is the code I THOUGHT would work but it doesn’t not even close :frowning:

For i1=123 To 987
  n1=Format(i1,"000")
  For i2=i1+1 To 987
    n2=Format(i2,"000")
    For i3=i2+1 To 987
      n3=Format(i3,"000")
      For j=1 To 3
        xx=Mid(n1,j,1)
        If InStr(n2,xx)>0 Or InStr(n3,xx)>0 Then Continue
        xx=Mid(n2,j,1)
        If InStr(n3,xx)>0 Then Continue
        tt=i1+i2+i3
        txt.writeline Format(tt,"000000")+"|"+n1+"|"+n2+"|"+n3
      Next j
    Next i3
  Next i2
Next i1
2

why not just start with 100000000 and count up from there to 999999999 and record each one once in a dictionary ?
then break those 9 digit numbers into groups of 3 digits

3

because there would still be unwanted duplicate digits. each sequence of 3 digits can only have ONE instance of a 1-9 character

which is why the smalled sequence is 123, and the largest is 987

so for each sequnce of 3 digits… 1-9 must appear only once

4

You could always test for duplicate digits before adding to a dictionary.

5

That is EXACTLY what the above code is SUPPOSED to be doing… the question is why isn’t it

6

Question: is “123,123,123” valid?

7

I think each loop needs to go from 123 to 987

when the i1 loop is at 456 the i2 loop could put 123 but wont

when i1 is at 987, i2 at 654, i3 wont put 123

8

Question: is “123,123,123” valid?

No… because 1 appears more than once, as does 2 and 3

Norman… that was the first thing I tried… but it isn’t rejecting the “bad” numbers… my output file was 6gig… there should only be 3 or 4 thousand “right” answers (if that many)

9

suppose i1 = 222
there is no check for the 2 being repeated multiple times in that section

and no check if n3 repeats digits in itself

For i1 As Integer = 123 To 987
  Dim n1 As String = Format(i1,"000")
  
  For i2 As Integer = 123 To 987
    Dim n2 As String = Format(i2,"000")
    
    For i3 As Integer = 123 To 987
      Dim n3 As String = Format(i3,"000")
      
      Dim digits() As String = Split(n1 + n2 + n3,"")
      Dim counts As New dictionary
      Dim keep As Boolean = True
      
      For i As Integer = 0 To digits.ubound
        if digits(i) = "0" then
           keep = False
          Exit
        End if
        If counts.HasKey( digits(i) ) Then
          // repeated digit so skip this one
          keep = False
          Exit
        Else
          counts.Value( digits(i) ) = True
        End If
      Next
      
      If keep Then
        print n1+"|"+n2+"|"+n3
      End If
      
    Next i3
  Next i2
Next i1

edited to DISALLOW zero’s

10

or maybe a version with a single loop something like

For i1 As Integer = 123456789 To 987654321
  Dim n1 As String = Format(i1,"000000000")
      Dim digits() As String = Split(n1,"")
      Dim counts As New dictionary
      Dim keep As Boolean = True
      
      For i As Integer = 0 To digits.ubound
        if digits(i) = "0" then
           keep = False
          Exit
        End if
        If counts.HasKey( digits(i) ) Then
          // repeated digit so skip this one
          keep = False
          Exit
        Else
          counts.Value( digits(i) ) = True
        End If
      Next
      
      If keep Then
        print n1
      End If
Next i1

edit : fixed to disallow zero as a valid digit

11

Look at Heap’s algorithm. There are 362,879 combinations without duplicates across all 9 digits.

1 Like
12

Sudoku?

13

No… the order of the numbers is not important… just that it is 3 numbers of 3 digits with no repeating digits. that and what the 3 numbers add up to 123+456+789 = 1368

14

And 362’879 doesn’t have a duplicate digit either, fun!

15

That was an early try. There were no duplicate digits in any sequence, but it did produce duplicate sequences.
Final count is 80,760.

16

This is recursive, results is a global dictionary
a() is an array containing “1”,“2”,“3”,“4”,“5”,“6”,“7”,“8”,“9”

Call with: generate(9, a)

results will contain all 9 digit permutations of digits 1-9 non-duplicated

Public Sub generate(k as integer, a() as string)
  Dim i As Integer
  Dim t As String
  
  If k = 1 Then
    ' just using the unique key properties
    results.Value(String.FromArray(a,"")) = 0
  Else
    For i = 0 To k - 1
      generate(k - 1, a)
      If i < k-1 Then
        t = a(k-1)
        If (k Mod 1) = 0 Then    // odd
          a(k-1) = a(i)
          a(i) = t
        Else
          a(k-1) = a(0)
          a(0) = t
        End If
      End If
    Next i
  End If
  
End Sub
17

Then your code makes no sense at all, it does NOT matter at all that at the end it will be divided in 3 groups. So, to make it by brute force you need only one loop like the example by @npalardy, but, brute force will be way too slow

Heap’s algorithm should be the answer, but I think your implementation is wrong, the formula for permutations says:
P(n,r)=n!(n−r)!
P(n,r)=9!(9−9)! = 362,880
So, the count should be 362,880

Permutations are from Middle School, there are tons of web pages with info about them and many of them will have an Online list generator.

18

The first number was the array Ubound (off by 1). When sorted, the array had a LOT of duplicates.

19

Even test should be mod 2.

Public Sub generate(k as integer, a() as string)
  Dim i As Integer
  Dim t As String
  
  If k = 1 Then
    // just using the unique key properties
    results.Value(String.FromArray(a,"")) = 0
  Else
    For i = 0 To k - 1
      generate(k - 1, a)
      If i < k-1 Then
        t = a(k-1)
        If (k Mod 2) = 0 Then    // <<-- test for even
          a(k-1) = a(i)
          a(i) = t
        Else
          a(k-1) = a(0)
          a(0) = t
        End If
      End If
    Next i
  End If
  
End Sub

Result is 362880 values of 9 digits
11 seconds to generate
2 seconds to sort
15 seconds to fill a textbox

But, whatever.

1 Like
20

BTW: This was the original routine from https://en.wikipedia.org/wiki/Heap%27s_algorithm

procedure generate(k : integer, A : array of any):
    if k = 1 then
        output(A)
    else
        // Recursively call once for each k
        for i := 0; i < k; i += 1 do
            generate(k - 1, A)
            // avoid swap when i==k-1
            if (i < k - 1)
                // swap choice dependent on parity of k
                if k is even then
                    swap(A[i], A[k-1])
                else
                    swap(A[0], A[k-1])
                end if
            end if
        end for
    end if