Solved

# Logic Problem

Posted on 2008-10-20
202 Views
Virtual checkers tournament. Jay, Alan, and Fred played 7 games against each other. Jay won the most games. Alan lost the least games. Fred became a champion. Find a final score.

Does anybody have any idea how I would demonstrate this? 21 games altogether... I think it's 2 points for a win and 1 for a draw...
0
Question by:c0ldfyr3
• 12
• 7
• 2
• +2

LVL 69

Expert Comment

ID: 22756138
is that homework?
0

LVL 10

Author Comment

ID: 22756165
I'm a full time developer for a financial institution, I don't get homework....
0

LVL 76

Expert Comment

ID: 22756173
I don't think c0ldfyr3 needs too many lessons in programming. If the game were labelled 'draughts', I would think that it was a Brainteaser from the Sunday Times.
0

LVL 69

Expert Comment

ID: 22756212
0

LVL 10

Author Comment

ID: 22756255
It's a Puzzle/Riddle but the answer must be a program in VB so I think this is the best place for it... It's quite easy to work it out yourself....
0

LVL 76

Expert Comment

ID: 22756428
This is a recursive tree-search solution. The puzzle setters might have something cleverer in mind.
``````Option Explicit

Sub Draughts()

Dim Points(2) As Integer

Dim Wins(2) As Integer

Dim Losses(2) As Integer

End Sub

Sub AddPoints(ByVal s As Integer, Points() As Integer, Wins() As Integer, Losses() As Integer)

Dim NewPoints(2) As Integer

Dim NewWins(2) As Integer

Dim NewLosses(2) As Integer

Dim w As Integer

Dim d As Integer

Dim g As Integer

Dim h As Integer

Const f = 0

Const j = 1

Const a = 2

For w = 0 To 7 'no of games that s won with opponent s + 1

For d = 0 To 7 - w 'no of games that s and s + 1 drew

g = s Mod 3

NewPoints(g) = Points(g) + 2 * w + d

NewLosses(g) = Losses(g) + 7 - d - w

NewWins(g) = Losses(g) + w

h = (h + 1) Mod 3

NewPoints(h) = Points(h) + 2 * (7 - w) + d

NewLosses(h) = Losses(h) + w

NewWins(h) = Losses(h) + 7 - d - w

If s > 1 Then

If NewWins(j) > NewWins(a) Then

If NewWins(j) > NewWins(f) Then

If NewLosses(a) < NewLosses(j) Then

If NewLosses(a) < NewLosses(f) Then

If NewPoints(f) > NewPoints(a) Then

If NewPoints(f) > NewPoints(j) Then

Debug.Print , "Jay", "Fred", "Alan"

Debug.Print "Wins:", NewWins(j), NewWins(f), NewWins(a)

Debug.Print "Points:", NewPoints(j), NewPoints(f), NewPoints(a)

Debug.Print "Losses:", NewLosses(j), NewLosses(f), NewLosses(a)

Debug.Print

Stop

End If

End If

End If

End If

End If

End If

Else

AddPoints s + 1, NewPoints(), NewWins(), NewLosses()

End If

Next d

Next w

End Sub
``````
0

LVL 10

Author Comment

ID: 22756450
Graham you little genious :D The only problem I see from first glance is you didn't include Draws >.<
0

LVL 76

Expert Comment

ID: 22756638
Thanks, but little? I'm nearly all of 5 ft 4 inches :>)

Draws were only needed in their contribution to the points. The number of draws wasn't necessary for the solution, but I'm sure that you would be able to add them in.
0

LVL 10

Author Comment

ID: 22756700
Hrm sorry I can't dedicate much attention to it at the moment and it's for a friend, I added the following two lines below the win & loss calculation with no avail...

Course I added NewDraws and Draws arrays!

``````NewDraws(g) = NewDraws(g) + 7 - NewWins(g) - NewLosses(g)

NewDraws(h) = NewDraws(h) + 7 - NewWins(h) - NewLosses(h)
``````
0

LVL 10

Author Comment

ID: 22756706
Oops meant this...

``````NewDraws(g) = Draws(g) + 7 - NewWins(g) - NewLosses(g)

NewDraws(h) = Draws(h) + 7 - NewWins(h) - NewLosses(h)
``````
0

LVL 10

Author Comment

ID: 22756729
hrm by changing to this I get a result sheet that looks ok but doesn't add to 21 games.

NewDraws(g) = Draws(g) + d
NewDraws(h) = Draws(h) + d
0

LVL 10

Author Comment

ID: 22756781
Ok finaly addeda check for game counter per player and it failed that check >.<

``````If NewWins(j) + NewDraws(j) + NewLosses(j) = 14 And NewWins(f) + NewDraws(f) + NewLosses(f) = 14 And _

NewWins(a) + NewDraws(a) + NewLosses(a) = 14 Then

'*****************************************************************'

'*****************************************************************'

Sub Draughts()

Dim Points(2) As Integer

Dim Wins(2) As Integer

Dim Losses(2) As Integer

Dim Draws(2) As Integer

AddPoints 0, Points(), Wins(), Losses(), Draws()

End Sub

Sub AddPoints(ByVal s As Integer, Points() As Integer, Wins() As Integer, Losses() As Integer, Draws() As Integer)

Dim NewPoints(2) As Integer

Dim NewWins(2) As Integer

Dim NewLosses(2) As Integer

Dim NewDraws(2) As Integer

Dim w As Integer

Dim d As Integer

Dim g As Integer

Dim h As Integer

Const f = 0

Const j = 1

Const a = 2

For w = 0 To 6 'no of games that s won with opponent s + 1

For d = 0 To 6 - w 'no of games that s and s + 1 drew

g = s Mod 3

NewPoints(g) = Points(g) + 2 * w + d

NewLosses(g) = Losses(g) + 7 - d - w

NewWins(g) = Losses(g) + w

h = (h + 1) Mod 3

NewPoints(h) = Points(h) + 2 * (7 - w) + d

NewLosses(h) = Losses(h) + w

NewWins(h) = Losses(h) + 7 - d - w

NewDraws(g) = Draws(g) + d

NewDraws(h) = Draws(h) + d

If s > 1 Then

If NewWins(j) + NewDraws(j) + NewLosses(j) = 14 And NewWins(f) + NewDraws(f) + NewLosses(f) = 14 And _

NewWins(a) + NewDraws(a) + NewLosses(a) = 14 Then

If NewWins(j) > NewWins(a) Then

If NewWins(j) > NewWins(f) Then

If NewLosses(a) < NewLosses(j) Then

If NewLosses(a) < NewLosses(f) Then

If NewPoints(f) > NewPoints(a) Then

If NewPoints(f) > NewPoints(j) Then

Debug.Print , "Jay", "Fred", "Alan"

Debug.Print "Wins:", NewWins(j), NewWins(f), NewWins(a)

Debug.Print "Points:", NewPoints(j), NewPoints(f), NewPoints(a)

Debug.Print "Losses:", NewLosses(j), NewLosses(f), NewLosses(a)

Debug.Print "Draws:", NewDraws(j), NewDraws(f), NewDraws(a)

Debug.Print

Stop

End If

End If

End If

End If

End If

End If

End If

Else

AddPoints s + 1, NewPoints(), NewWins(), NewLosses(), NewDraws()

End If

Next d

Next w

End Sub
``````
0

LVL 76

Expert Comment

ID: 22756789
Why not just calculate the draws at the end:
Debug.Print "Draws:", 21 - NewLosses(j) - NewWins(j), 21 - NewLosses(f) - NewWins(f), 21 - NewLosses(a) - NewWins(a)
0

LVL 10

Author Comment

ID: 22756839
That's the thing, it's working out more than 14 games each. 21 games total, 7 v each other makes 14 each...
0

LVL 76

Accepted Solution

GrahamSkan earned 500 total points
ID: 22759627
Sorry. Got called away.

My code failed to copy the statistics of the uninvolved player into the called procedure, so his scores reverted to zero. Another error in calculating  the index (h) for the second player masked the symptom.

This is the corrected code.

``````Option Explicit

Dim Names(2) As String

Const f = 0

Const j = 1

Const a = 2

Sub Draughts()

Dim Points(2) As Integer

Dim Wins(2) As Integer

Dim Losses(2) As Integer

Dim Draws(2) As Integer

Names(a) = "Alan"

Names(f) = "Fred"

Names(j) = "Jay"

AddPoints 0, Points(), Wins(), Losses(), Draws()

End Sub

Sub AddPoints(ByVal s As Integer, Points() As Integer, Wins() As Integer, Losses() As Integer, Draws() As Integer)

Dim NewPoints(2) As Integer

Dim NewWins(2) As Integer

Dim NewLosses(2) As Integer

Dim NewDraws(2) As Integer

Dim w As Integer

Dim d As Integer

Dim g As Integer

Dim h As Integer

Dim i As Integer

g = s

h = (s + 1) Mod 3

i = (s + 2) Mod 3

For w = 0 To 7 'no of games that s won with opponent s + 1

For d = 0 To 7 - w 'no of games that s and s + 1 drew

NewPoints(g) = Points(g) + 2 * w + d

NewLosses(g) = Losses(g) + 7 - d - w

NewWins(g) = Wins(g) + w

NewDraws(g) = Draws(g) + d

NewPoints(h) = Points(h) + 2 * (7 - w) + d

NewLosses(h) = Losses(h) + w

NewWins(h) = Wins(h) + 7 - d - w

NewDraws(h) = Draws(h) + d

NewPoints(i) = Points(i)

NewWins(i) = Wins(i)

NewLosses(i) = Losses(i)

NewDraws(i) = Draws(i)

If s > 1 Then

If NewWins(j) > NewWins(a) Then

If NewWins(j) > NewWins(f) Then

If NewLosses(a) < NewLosses(j) Then

If NewLosses(a) < NewLosses(f) Then

If NewPoints(f) > NewPoints(a) Then

If NewPoints(f) > NewPoints(j) Then

Debug.Print , Names(j), Names(f), Names(a)

Debug.Print "Wins:", NewWins(j), NewWins(f), NewWins(a)

Debug.Print "Losses:", NewLosses(j), NewLosses(f), NewLosses(a)

Debug.Print "Draws:", NewDraws(j), NewDraws(f), NewDraws(a)

Debug.Print "Points:", NewPoints(j), NewPoints(f), NewPoints(a)

Debug.Print "DrawCheck:", 14 - NewLosses(j) - NewWins(j), 14 - NewLosses(f) - NewWins(f), 14 - NewLosses(a) - NewWins(a)

Debug.Print

Stop

End If

End If

End If

End If

End If

End If

Else

AddPoints s + 1, NewPoints(), NewWins(), NewLosses(), NewDraws()

End If

Next d

Next w

End Sub
``````
0

LVL 10

Author Comment

ID: 22761351
Graham, please post in this new thread as I gave too little points too early on this one: http://www.experts-exchange.com/viewQuestion.jsp?qid=23830932
0

LVL 10

Author Closing Comment

ID: 31507744
Worked great, the only problem was it repeated some results. Working on an example to check existing result sets and then i'll post the final code.
0

LVL 76

Expert Comment

ID: 22762154
Thanks c0ldfyr3.  If I had put End instead of Stop, you couldn't get more than one result. Perhaps there really is more than one answer. I'd be interested to see what you come up with.

Also Kevin, I'd be also interested in what Excel can do.
0

LVL 81

Expert Comment

ID: 22762298
>Also Kevin, I'd be also interested in what Excel can do.

So would I :-) So far I'm getting bogus solutions which leads me to think it doesn't have an answer. That's why I was wanting the best solution you guys have derived.

My understanding of the rules:

Each contestant plays 14 games, seven with one player and seven with the other player.
Jay wins more games than either Alan or Fred.
Alan loses fewer games than either Jay or Fred.
Fred scores more points than either Jay or Alan where a win is 2 points, a draw is 1 point, and loss is 0 points.

Kevin
0

LVL 10

Author Comment

ID: 22762536
I got it, the points system was b0rked in that example you gave and it was returning 257 unique scores. I fixed it and now it returns two which satisy all criteria :D Gimme 20 mins and i'll post it.
0

LVL 76

Expert Comment

ID: 22762574
I'm not going anywhere  - except, perhaps, to bed.
0

LVL 10

Author Comment

ID: 22762659
Here's the final answer and only 2 possible solutions...

Jay           Fred          Alan
Wins:          5             4             2
Losses:        6             3             2
Draws:         3             7             10
Points:        13            15            14
DrawCheck:     3             7             10

Jay           Fred          Alan
Wins:          5             4             1
Losses:        5             3             2
Draws:         4             7             11
Points:        14            15            13
DrawCheck:     4             7             11

``````Option Explicit

Dim Names(2)                        As String

Dim oDictionary                     As Object

Const f = 0

Const j = 1

Const a = 2

Sub Draughts()

Dim Points(2)                   As Integer

Dim Wins(2)                     As Integer

Dim Losses(2)                   As Integer

Dim Draws(2)                    As Integer

Set oDictionary = CreateObject("Scripting.Dictionary")

Names(a) = "Alan"

Names(f) = "Fred"

Names(j) = "Jay"

AddPoints 0, Points(), Wins(), Losses(), Draws()

End Sub

Sub AddPoints(ByVal s As Integer, Points() As Integer, Wins() As Integer, Losses() As Integer, Draws() As Integer)

Dim iLost                       As Integer

Dim iWon                        As Integer

Dim NewPoints(2)                As Integer

Dim NewWins(2)                  As Integer

Dim NewLosses(2)                As Integer

Dim NewDraws(2)                 As Integer

Dim w                           As Integer

Dim d                           As Integer

Dim g                           As Integer

Dim h                           As Integer

Dim i                           As Integer

Dim sKey                        As String

g = s

h = (s + 1) Mod 3

i = (s + 2) Mod 3

For w = 0 To 7 'no of games that s won with opponent s & 1

For d = 0 To (7 - w) 'no of games that s and s & 1 drew

iLost = (7 - d - w)

NewLosses(g) = Losses(g) + iLost

NewWins(g) = Wins(g) + w

NewDraws(g) = Draws(g) + d

NewPoints(g) = Points(g) + (2 * w) + d

iWon = iLost

NewLosses(h) = Losses(h) + w

NewWins(h) = Wins(h) + iWon

NewDraws(h) = Draws(h) + d

NewPoints(h) = Points(h) + (iWon * 2) + d

NewPoints(i) = Points(i)

NewWins(i) = Wins(i)

NewLosses(i) = Losses(i)

NewDraws(i) = Draws(i)

If s > 1 Then

If NewWins(j) > NewWins(a) Then

If NewWins(j) > NewWins(f) Then

If NewLosses(a) < NewLosses(j) Then

If NewLosses(a) < NewLosses(f) Then

If NewPoints(f) > NewPoints(a) Then

If NewPoints(f) > NewPoints(j) Then

sKey = NewWins(f) & "|" & NewWins(f) & "|" & NewWins(a) & "|" & NewLosses(j) & "|" & NewLosses(f) & "|" & NewLosses(a) & "|" & NewDraws(j) & "|" & NewDraws(f) & "|" & NewDraws(a)

If Not oDictionary.Exists(sKey) Then

Debug.Print , Names(j), Names(f), Names(a)

Debug.Print "Wins:", NewWins(j), NewWins(f), NewWins(a)

Debug.Print "Losses:", NewLosses(j), NewLosses(f), NewLosses(a)

Debug.Print "Draws:", NewDraws(j), NewDraws(f), NewDraws(a)

Debug.Print "Points:", NewPoints(j), NewPoints(f), NewPoints(a)

Debug.Print "DrawCheck:", 14 - NewLosses(j) - NewWins(j), 14 - NewLosses(f) - NewWins(f), 14 - NewLosses(a) - NewWins(a)

Debug.Print

End If

End If

End If

End If

End If

End If

End If

Else

AddPoints s + 1, NewPoints(), NewWins(), NewLosses(), NewDraws()

End If

Next d

Next w

End Sub
``````
0

LVL 81

Expert Comment

ID: 22768899
I tried unsuccessfully to lay out a series of match results that agreed with the Win/Loss/Tied scores reported by c0ldfyr3. Excel Solver immediately gave up on the problem.

On the other hand, when I asked Excel Solver to maximize Fred's points while predicting results of each match and satisfying the other constraints, I got the following (after about 30 minutes of calculation):

Jay      Fred      Alan
1      1            1
2      1            1
3      1            1
4      1            1
5      2            0
6      2            0
7      2            0
8      2      0
9      0      2
10      0      2
11      0      2
12      0      2
13      1      1
14      1      1
15            1      1
16            1      1
17            1      1
18            1      1
19            1      1
20            0      2
21            0      2

Sum      14      15      13
Wins      4      4      2
Losses      4      3      3

Approach B (using attached workbook):
Jay      Fred      Alan
1      2            0
2      2            0
3      1            1
4      0            2
5      2            0
6      2            0
7      1            1
8      2      0
9      0      2
10      0      2
11      1      1
12      0      2
13      0      2
14      0      2
15            0      2
16            1      1
17            1      1
18            1      1
19            1      1
20            0      2
21            0      2

Sum      13      15      14
Wins      5      5      4
Losses      6      4      4

CheckersTournament2.xls
0

## Featured Post

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

### Suggested Solutions

Access 2016 VB code 9 102
String manipulation in Visual Basic 7 58
MsgBox 2 47
Copy a row 12 57
Introduction While answering a recent question about filtering a custom class collection, I realized that this could be accomplished with very little code by using the ScriptControl (SC) library.  This article will introduce you to the SC library a…
You can of course define an array to hold data that is of a particular type like an array of Strings to hold customer names or an array of Doubles to hold customer sales, but what do you do if you want to coordinate that data? This article describes…
Get people started with the utilization of class modules. Class modules can be a powerful tool in Microsoft Access. They allow you to create self-contained objects that encapsulate functionality. They can easily hide the complexity of a process from…
This lesson covers basic error handling code in Microsoft Excel using VBA. This is the first lesson in a 3-part series that uses code to loop through an Excel spreadsheet in VBA and then fix errors, taking advantage of error handling code. This l…