For Fun and Learning Project

PA HS Teacher · Dec 14, 2006

Interesting Problem. I decided to attack the problem using a series of User Defined Functions, that return Collections.

The User Defined Function Math9YearOld() can be used in a spreadsheet to solve the problem:
http://www.box.net/public/3psd0h6la0

I'll post an image of the spreadsheet when I get home.

In A2 and Pasted Down
=Math9Yearold(B2,C2,D2,E2,F2)

The Math9YearOldFunction Returns a String with all Solutions to the Problem:

**************** Function Math9YearOld ************************
Function Math9YearOld(Optional GHB As Integer = 40, _
 Optional BAC As Integer = 30, _
 Optional CDE As Integer = 48, _
 Optional EFG As Integer = 0, _
 Optional Center As Integer = 14) As String
StartTime = timeGetTime()
Dim PotentialSolutions As New Collection ' Collection of Potential Solutions
Dim Answers As New Collection ' Collection of Correct Solutions
Dim GHBs As New Collection
Dim BACs As New Collection
Dim CDEs As New Collection ' A Colection for each triplet of the combinations that
Dim EFGs As New Collection ' multiply to the corresponding constant above
Dim GHBACs As New Collection
Dim GHBACDEs As New Collection
Dim GHBACDEFGs As New Collection

Set GHBs = Triplets(Factors(GHB), GHB) 'Collection of all possible Triplets Multiplying to GHB
Set BACs = Triplets(Factors(BAC), BAC) 'Collection of all possible Triplets Multiplying to BAC
Set CDEs = Triplets(Factors(CDE), CDE) 'Collection of all possible Triplets Multiplying to CDE
Set EFGs = Triplets(Factors(EFG), EFG) 'Collection of all possible Triplets Multiplying to EFG

' Possible Solutions are stored as a String of Numbers. The first character of each String Correspods _
 to G, the second to H etc. The collection of Possible Solutions is assembled by going through all _
 Possible combinations of one Family of Triplets with the Previous Families of Triplets. Any _
 Solutions that repeat a digit are not included.

Set GHBACs = UniquePossibilities(GHBs, BACs)
Set GHBACDEs = UniquePossibilities(GHBACs, CDEs)
Set GHBACDEFGs = UniquePossibilities(GHBACDEs, EFGs, SkipLastDigit:=True)

' Collect the Possible Solutions that also Satisfy B+C+E+G = Center into a SolutionSet Collection
Set PotentialSolutions = CenterMet(GHBACDEFGs, 14)
' Check Solutions to make sure they meet all Criteria
Set Answers = VerifiedSolutions(PotentialSolutions, GHB, BAC, CDE, EFG, Center)

For Each cc In Answers
 S = S & "G = " & Mid(cc, 1, 1) & " H = " & Mid(cc, 2, 1) & " B = " & Mid(cc, 3, 1)
 S = S & " A = " & Mid(cc, 4, 1) & " C = " & Mid(cc, 5, 1)
 S = S & " D = " & Mid(cc, 6, 1) & " E = " & Mid(cc, 7, 1)
 S = S & " F = " & Mid(cc, 8, 1) & Chr(10)
Next cc
EndTime = timeGetTime()
Debug.Print S
Debug.Print "Elapsed Time: " & (Format(EndTime - StartTime)) & " ms?"
Math9YearOld = S
End Function


The Logic is similar to what Dennis suggested, (and I"m sure what Andrew Impletented, though I only skimmed his code). Instead of using Loops and Arrays, I used Functions that return Collections.

1. For each of the 4 Multiplication requirement, determine the possible Factors (0 to 9) of the Required Number.

**************** Function Factors ******************************
New>Function Factors(N As Integer) As Variant
' Returns all Factors (0 to 9) of N
Dim C As New Collection
C.Add 0
For i = 1 To 9
 If N Mod i = 0 Then C.Add i
Next i
Set Factors = C
End Function

2. For each of the 4 Triplets, G*H*B, B*A*C, C*D*E, E*F*G, Assemble a collection of all possible 3 Factor Multiplications that yield the desired Number for Triplet.

**************** Function Triplets ************************Function Triplets(Factors As Collection, N As Integer) As Variant
' Returns a Collection of all possible 3 digit combinations of Factors that multiply to N
Dim C As New Collection
For i = 1 To Factors.Count
For j = 1 To Factors.Count
For k = 1 To Factors.Count
 If Factors(i) <> Factors(j) And Factors(i) <> Factors(k) And Factors(j) <> Factors(k) Then
 If Factors(i) * Factors(j) * Factors(k) = N Then
 C.Add Factors(i) & Factors(j) & Factors(k)
 End If
 End If
Next k
Next j
Next i
Set Triplets = C
End Function

3. Assemble a Collection of all Possible 4 Triplet Combinations by making 3 calls to the follwing Function.
A. (C1) Because the Triplets Overal (e.g. GHB and BAC share B, All combinations where the Last Digit of the Previous Triplet does not Match the Left Digit of the Current Triplet are excluded.
B. (C2) All Members of this Collection that repeat digits are excluded.
C. (C3) Any Duplicate Members are Excluded.

**************** Function UniquePossibilities ******************

Function UniquePossibilities(A As Collection, B As Collection, Optional SkipLastDigit As Boolean = False) As Variant
Dim C1 As New Collection ' Collection A & B's where the Last A = Last B (In the game they overlap)
Dim C2 As New Collection ' Subset of C1 with No digits repeating
Dim C3 As New Collection ' Same as C2 but no Duplicates
Dim NotUnique As Boolean
ALen = Len(A(1))
ANum2 = A.Count
BLen = Len(B(1))
BNum2 = B.Count
LastDigit = ALen + BLen - 1
If SkipLastDigit Then LastDigit = LastDigit - 1

 ' C1 Collection A & B's where the Last A = Last B (In the game they overlap)
For i = 1 To ANum2
For j = 1 To BNum2
If Right(A(i), 1) = Left(B(j), 1) Then C1.Add A(i) & Right(B(j), Len(B(j)) - 1)
Next j
Next i

 ' C2 Subset of C1 with No digits repeating in any Solution
For Each cc In C1
NotUnique = False
 For i = ALen + 1 To LastDigit
 If InStr(1, Left(cc, ALen - 1), Mid(cc, i, 1)) > 0 Then NotUnique = True
 Next i
If NotUnique = False Then
 S = Left(cc, ALen) & Right(cc, BLen - 1)
 If SkipLastDigit Then S = Left(S, Len(S) - 1)
 C2.Add S
End If
Next cc

 'C3 Same as C2 but no Duplicates
For Each cc In C2
 AlreadyExists = False
 For Each cc3 In C3
 If cc3 = cc Then AlreadyExists = True
 Next cc3
 If Not AlreadyExists Then C3.Add cc
Next cc
Set UniquePossibilities = C3
End Function

4. Potential Solutions that do not meet the requirement B+C+E+G=Center are excluded

**************** Function CenterMet ************************
Function CenterMet(A As Collection, N As Integer) As Variant
' Returns a Collection of Solutions that Meet the requirement that B+C+E+G = N
Dim C As New Collection
Dim S As Integer
For Each cc In A
 S = 0
 S = S + Val(Mid(cc, 3, 1))
 S = S + Val(Mid(cc, 5, 1))
 S = S + Val(Mid(cc, 7, 1))
 S = S + Val(Mid(cc, 1, 1))
 If S = N Then C.Add cc
Next cc
Set CenterMet = C
End Function

5. All Potential Solutions are Checked for Correctness

**************** Function VerifiedSolutions *********************
Function VerifiedSolutions(A As Collection, GHB As Integer, BAC As Integer, CDE As Integer, EFG As Integer, Center As Integer) As Collection
' Checks Potential Solutions in Collection A, returning a Collection of Correct Solutions
Dim C As New Collection
Dim Sum As Integer
Dim ConditionsMet As Boolean
For Each cc In A
Sum = 0
ConditionsMet = True
 ConditionsMet = ConditionsMet And (Val(Mid(cc, 1, 1)) * Val(Mid(cc, 2, 1)) * Val(Mid(cc, 3, 1))) = GHB
 ConditionsMet = ConditionsMet And (Val(Mid(cc, 3, 1)) * Val(Mid(cc, 4, 1)) * Val(Mid(cc, 5, 1))) = BAC
 ConditionsMet = ConditionsMet And (Val(Mid(cc, 5, 1)) * Val(Mid(cc, 6, 1)) * Val(Mid(cc, 7, 1))) = CDE
 ConditionsMet = ConditionsMet And (Val(Mid(cc, 7, 1)) * Val(Mid(cc, 8, 1)) * Val(Mid(cc, 1, 1))) = EFG
 Sum = Val(Mid(cc, 3, 1)) + Val(Mid(cc, 5, 1)) + Val(Mid(cc, 7, 1)) + Val(Mid(cc, 1, 1))
 ConditionsMet = ConditionsMet And Sum = Center
 If ConditionsMet Then C.Add cc
Next cc
Set VerifiedSolutions = C
End Function

6. Finally the Lead Function Math9YearOld() returns a String containing all possible Solutions.

Using the timing function posted by Sydney, A correct answer is yielded in about 11 ms on my (slow) machine. Tweaking numbers on the example spreadsheet, I was able to create 2 similar problems, one with 2 solutions.

I hope hope the hours I put in last night add something to this discussion.

PS - Tom, thank you immensely for your Object help this summer. I'm teaching 5 classes this year, and I had to put the project down for a while, but I will come back to it eventually. (probably not till the summer, otherwise it will become too consuming.) I have been extending your object oriented philosophy in some of my smaller projects.

Andrew Fergus · Dec 14, 2006

Hi

It's nice to see an alternative solution to this puzzle. I haven't gone through your code in detail yet (I will give it a whirl this weekend) but I noticed you refer to the solution in the plural - does your code produce more than one solution?

Andrew

PA HS Teacher · Dec 14, 2006

Hi Andrew,
I assume that for some values of the input parameters, there could be more than one valid solution. For the Parameters in this problem,
=Math9Yearold(40,30,48,0,14) yields the single solution:

G = 1 H = 8 B = 5 A = 3 C = 2 D = 4 E = 6 F = 0

however,
=Math9Yearold(40,6,48,0,14) yields two solutions:

G = 5 H = 4 B = 2 A = 3 C = 1 D = 8 E = 6 F = 0
G = 5 H = 8 B = 1 A = 3 C = 2 D = 4 E = 6 F = 0

I suppose it is possible that some comnations may yield more.

Most combinations of input parameters GHB, BAC, CDE, EFG, Center dont' seem to yield any solutions, and for certain combinations, the function seems like it may be caught in a loop. I haven't tried that many combinations for the parameters, but I supose one could use this function in some loops to generate a list of all possible parameters, for this puzzle.

Assuming Only Numbers from 0 to 9 are used, and no digits are used more than once.

Andrew Fergus · Dec 14, 2006

Interesting - I hadn't considered the possibility of multiple solutions - I was focused on just finding the one solution. What combination(s) does your solution fail on?

Andrew

PA HS Teacher · Dec 14, 2006

Here is what the sheet looks like. I've added some rows with parameters to illustrate the function.

Math 9 Year Old Function 12-4-06(1).xls

A

B

C

D

E

F

1

Solutions

GHB

BAC

CDE

EFG

B+C+E+G

2

G = 1 H = 8 B = 5 A = 3 C = 2 D = 4 E = 6 F = 0

40

30

48

0

14

3

G = 5 H = 4 B = 2 A = 3 C = 1 D = 8 E = 6 F = 0 G = 5 H = 8 B = 1 A = 3 C = 2 D = 4 E = 6 F = 0

40

6

48

0

14

4

G = 4 H = 5 B = 3 A = 2 C = 1 D = 8 E = 6 F = 0

60

6

48

0

14

5

#VALUE!

60

3

48

0

14

6

#VALUE!

60

1

48

0

14

7

G = 7 H = 8 B = 1 A = 3 C = 2 D = 6 E = 4 F = 0

56

6

48

0

14

8

G = 7 H = 8 B = 1 A = 3 C = 2 D = 9 E = 4 F = 0

56

6

72

0

14

9

#VALUE!

67

6

72

0

14

10

0

30

56

0

14

Sheet1

Notice, some sets of Parameters yield more than one solution.
Row 3 has 2 solutions
Row 10 has 36 solutions! (though my approach allows for multiple 0 Targets)

I believe the #Value! is resulting from the inability to form a Triplet (3 Unique factors that multiply to one of the parameters.)

I have not been able to recreate the "endless loop" that I saw earlier. Maybe the program had simply frozen when observed the behavior earlier?

Andrew Fergus · Dec 15, 2006

The minimum value for one of the triplets is 6 (assuming the product is >0) given the three smallest values are 1, 2, 3 - the product of which is 6 so there are no possible solutions for rows 5 and 6. Also row 9 contains a prime number as one of the triplet values so it only has one single digit factor and again the puzzle cannot be solved. So it looks like your code is working fine.

Andrew

PA HS Teacher · Dec 16, 2006

Extension of Problem: All possible "Games"?

I showed my wife the original puzzle, and she liked playing it, sort of like she plays Soduko. I thought it would be fun to generate a list of "puzzles". Same rules apply but with different constants.

Still no digits used more than once.
Still only digits 0 to 9.
Still GHB = a Constant
Still BAC = a Constant
Still CDE = a Constant
Still EFG = a Constant
Still B +C + E + G = a Constant

I am trying to assemble a list of 5 Constant Combinations that are solvable puzzles.

The largest possible Constant that a triplet can multiply to is 9*8*7 or 504.
The smallest (nonzero) is 1*2*3 or 6 as Andrew has pointed out.

The largest possible Constant that B+C+E+G can be is 9+8+7+6 or 30.
The smallest possible B + C + E + G = 0 + 1 + 2 + 3 = 6

None of the Target Constants for triplet multiplication can be a Prime Number as Andrew has also pointed out.

To start out, a brute force method would be to loop through all possible combinations using the logic above. I've started this approach, but it would take days to weeks to run on my computer.

A Sheet called Not Possible Triplets, can help cut down some unncecessary looping, but not considering certain Target Constants for Triplet Multiplications:

Math 9 Year Old Function All Possible 12-16-06.xls

A

B

C

D

1

TRUE

2

TRUE

3

TRUE

4

TRUE

5

TRUE

6

FALSE

7

TRUE

8

FALSE

9

FALSE

10

FALSE

11

TRUE

12

FALSE

13

TRUE

Not a Possible Triplet

A list of Valid Puzzles can be written to this Sheet.

Math 9 Year Old Function All Possible 12-16-06.xls

A

B

C

D

E

F

1

Solutions

GHB

BAC

CDE

EFG

B+C+E+G

2

3

Possible Puzzles

I have a button on the "Puzzles" Sheet with the following Code:PrivateSub CommandButton1_Click()Dim GHBAsInteger, BACAsInteger, CDEAsInteger, EFGAsInteger, BCEGAsIntegerDim AAsString, iRowAsIntegerDim NotAPossibleTriplet(0To 504)AsBoolean
NotAPossibleTriplet(0) =FalseFor i = 1To 504
 NotAPossibleTriplet(i) = Worksheets("Not a Possible Triplet").Cells(i, 1).ValueNext i
iRow = Range("B65535").End(xlUp).RowFor GHB = 0To 504
 If NotAPossibleTriplet(GHB)ThenGoTo ErrGHBFor BAC = 0To 504
 If NotAPossibleTriplet(BAC)ThenGoTo ErrBACFor CDE = 0To 504
 If NotAPossibleTriplet(CDE)ThenGoTo ErrCDEFor EFG = 0To 504
 If NotAPossibleTriplet(EFG)ThenGoTo ErrEFGFor BCEG = 6To 30
 OnErrorGoTo Err
 A = "Error"
 A = Math9YearOld(GHB, BAC, CDE, EFG, BCEG)
 If A = "Error"ThenGoTo Err
 iRow = iRow + 1
 Cells(iRow, 1) = A
 Cells(iRow, 2) = GHB
 Cells(iRow, 3) = BAC
 Cells(iRow, 4) = CDE
 Cells(iRow, 5) = EFG
 Cells(iRow, 6) = BCEG
 Cells(iRow, 7) = Now()
 Debug.Print GHB & " " & BAC & " " & CDE & " " & EFG & " " & BCEG & " " & A & " " & Format(Now(), "mm/dd/yy h:mm:ss")

Err:Next BCEG
ErrEFGNext EFG
ErrCDENext CDE
ErrBAC:
Debug.Print GHB & " " & BAC & " " & CDE & " " & EFG & " " & BCEG & " " & A & " " & Format(Now(), "mm/dd/yy h:mm:ss")Next BAC
ErrGHB:'ThisWorkbook.SaveNext GHBEndSub

This approach is too brute force. I'd like to refine it, by reducing unnecessary looping. Perhaps one could prescreen the constants in the loops before calling the Math9YearOld function. If we know somehow ahead of time that the constant will not yield a solution, don't call the function.

I'm also considering the possiblity that instead of looping through constants sequentially, one could loop through a collection of possible contstants. The collection of possible constants might be dependent on the current value of the more outer constant loops. For example if every possible triplet for the outermost constant (GHB) requires a 1 in every possible triplet, then we can eliminate constants for the inner loop that require a 1 in every possible triplet for that constant.

This would allow us to reduce the number of loops.

btw: I modified Math9YearOld so that it returns "Error" if the function errors out rather than #Value!. This allows these loops to keep running when the Math9YearOld function errors out.

Here's the file:
http://www.box.net/public/lj7srjiyau

thought it would take at least days to run completely as is.

Andrew Fergus · Dec 17, 2006

Hi

It appears your technique for generating puzzles is starting at the possible solutions and working backwards. When I first viewed this question I thought about producing a list of all possible puzzles based on using the values 0 through 9 in the 8 positions and working forwards. However, I believe there hundreds of thousands (if not millions) of unique permutations. I think you will find there are 6,720 unique solutions for 20,160 permutations where you have the number 0 in position A and the number 1 in position B.

So, rather than producing puzzles en masse, the following code will provide the eight final values and from that you can use math to calculate the 5 'clues', for one puzzle at a time.

Code:

Option Explicit

Public Sub MakeMeAPuzzle()

Dim tempValue(8) As Single, _
    ActualValue(8) As Integer, _
    ValuesToChoose(9) As Integer, _
    LoopCount As Integer, _
    InnerLoop As Integer, _
    PickDigit As Integer, _
    DigitCounter As Integer

'Resets the random seed
Randomize

For LoopCount = 1 To 8
    'I could have merged this with the line below but kept it seperate for debugging
    tempValue(LoopCount) = Rnd()
    'Multiply the random number by the number of choices left
    'Used one extra value plus the -0.5 to give the 2 end values the same chance of
    'being selected as the other values
    tempValue(LoopCount) = CInt(((11 - LoopCount) * tempValue(LoopCount)) - 0.5)
    'This number represents the digit to choose, based on the digits not yet used
Next

'Clear the used flag for the 10 possible choices
For LoopCount = 0 To 9
    ValuesToChoose(LoopCount) = 0
Next

For LoopCount = 1 To 8
    DigitCounter = 0
    PickDigit = tempValue(LoopCount)
    For InnerLoop = 0 To 9
        If ValuesToChoose(InnerLoop) = 0 Then
            'Not used yet
            If PickDigit = DigitCounter Then
                'Use this digit
                ValuesToChoose(InnerLoop) = 1
                ActualValue(LoopCount) = InnerLoop
                'Exit the inner loop
                InnerLoop = 9
            Else
                'Keep searching
                DigitCounter = DigitCounter + 1
            End If
        End If
    Next
Next

'Display the values
For LoopCount = 1 To 8
    Cells(2, LoopCount) = ActualValue(LoopCount)
Next

'The 4 triplet values are ActualValue(1*2*3) , ActualValue(3*4*5) , _
  ActualValue(5*6*7) , ActualValue(7*8*1)
'The inner value is ActualValue(1*3*5*7) - more correctly ActualValue(1) * ActualValue(3) etc.

End Sub

Andrew

For Fun and Learning Project

PA HS Teacher

Well-known Member

Excel Facts

Andrew Fergus

MrExcel MVP

PA HS Teacher

Well-known Member

Andrew Fergus

MrExcel MVP

PA HS Teacher

Well-known Member

Andrew Fergus

MrExcel MVP

PA HS Teacher

Well-known Member

Andrew Fergus

MrExcel MVP

Forum statistics

Share this page

For Fun and Learning Project

Well-known Member

Excel Facts

MrExcel MVP

Well-known Member

MrExcel MVP

Well-known Member

MrExcel MVP

Well-known Member

MrExcel MVP

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock