Logic Problem
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...
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...
Éric Moreau
is that homework?
ASKER
I'm a full time developer for a financial institution, I don't get homework....
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.
in this case, better ask your question at https://www.experts-exchange.com/Other/Puzzles_Riddles/
ASKER
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....
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
AddPoints 0, Points(), Wins(), Losses()
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 SubASKER
Graham you little genious :D The only problem I see from first glance is you didn't include Draws >.<
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.
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.
ASKER
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!
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)
ASKER
Oops meant this...
NewDraws(g) = Draws(g) + 7 - NewWins(g) - NewLosses(g)
NewDraws(h) = Draws(h) + 7 - NewWins(h) - NewLosses(h)
ASKER
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
NewDraws(g) = Draws(g) + d
NewDraws(h) = Draws(h) + d
ASKER
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
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)
Debug.Print "Draws:", 21 - NewLosses(j) - NewWins(j), 21 - NewLosses(f) - NewWins(f), 21 - NewLosses(a) - NewWins(a)
ASKER
That's the thing, it's working out more than 14 games each. 21 games total, 7 v each other makes 14 each...
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
Graham, please post in this new thread as I gave too little points too early on this one: https://www.experts-exchange.com/viewQuestion.jsp?qid=23830932
ASKER
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.
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.
Also Kevin, I'd be also interested in what Excel can do.
>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
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
ASKER
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.
I'm not going anywhere - except, perhaps, to bed.
ASKER
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
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
Call oDictionary.Add(sKey, "")
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
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
Brad
CheckersTournament2.xls
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
Brad
CheckersTournament2.xls