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...
LVL 10
c0ldfyr3Asked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

Éric MoreauSenior .Net ConsultantCommented:
is that homework?
0
c0ldfyr3Author Commented:
I'm a full time developer for a financial institution, I don't get homework....
0
GrahamSkanRetiredCommented:
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
Ultimate Tool Kit for Technology Solution Provider

Broken down into practical pointers and step-by-step instructions, the IT Service Excellence Tool Kit delivers expert advice for technology solution providers. Get your free copy now.

Éric MoreauSenior .Net ConsultantCommented:
in this case, better ask your question at http://www.experts-exchange.com/Other/Puzzles_Riddles/
0
c0ldfyr3Author Commented:
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
GrahamSkanRetiredCommented:
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 Sub

Open in new window

0
c0ldfyr3Author Commented:
Graham you little genious :D The only problem I see from first glance is you didn't include Draws >.<
0
GrahamSkanRetiredCommented:
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
c0ldfyr3Author Commented:
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)

Open in new window

0
c0ldfyr3Author Commented:
Oops meant this...

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

Open in new window

0
c0ldfyr3Author Commented:
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
c0ldfyr3Author Commented:
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

Open in new window

0
GrahamSkanRetiredCommented:
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
c0ldfyr3Author Commented:
That's the thing, it's working out more than 14 games each. 21 games total, 7 v each other makes 14 each...
0
GrahamSkanRetiredCommented:
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

Open in new window

0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
c0ldfyr3Author Commented:
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
c0ldfyr3Author Commented:
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
GrahamSkanRetiredCommented:
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
zorvek (Kevin Jones)ConsultantCommented:
>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
c0ldfyr3Author Commented:
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
GrahamSkanRetiredCommented:
I'm not going anywhere  - except, perhaps, to bed.
0
c0ldfyr3Author Commented:
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
                                            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

Open in new window

0
byundtCommented:
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
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Visual Basic Classic

From novice to tech pro — start learning today.

Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.