Solved

Logic Problem

Posted on 2008-10-20
24
202 Views
Last Modified: 2011-10-19
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
Comment
Question by:c0ldfyr3
  • 12
  • 7
  • 2
  • +2
24 Comments
 
LVL 69

Expert Comment

by:Éric Moreau
ID: 22756138
is that homework?
0
 
LVL 10

Author Comment

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

Expert Comment

by:GrahamSkan
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

by:Éric Moreau
ID: 22756212
in this case, better ask your question at http://www.experts-exchange.com/Other/Puzzles_Riddles/
0
 
LVL 10

Author Comment

by:c0ldfyr3
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

by:GrahamSkan
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

    

    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
 
LVL 10

Author Comment

by:c0ldfyr3
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

by:GrahamSkan
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

by:c0ldfyr3
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)

Open in new window

0
 
LVL 10

Author Comment

by:c0ldfyr3
ID: 22756706
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
 
LVL 10

Author Comment

by:c0ldfyr3
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
Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

 
LVL 10

Author Comment

by:c0ldfyr3
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

Open in new window

0
 
LVL 76

Expert Comment

by:GrahamSkan
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

by:c0ldfyr3
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

by:
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

Open in new window

0
 
LVL 10

Author Comment

by:c0ldfyr3
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

by:c0ldfyr3
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

by:GrahamSkan
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

by:zorvek (Kevin Jones)
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

by:c0ldfyr3
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

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

Author Comment

by:c0ldfyr3
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

                                            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
 
LVL 81

Expert Comment

by:byundt
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


Brad


CheckersTournament2.xls
0

Featured Post

Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

Question has a verified solution.

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

Suggested Solutions

Title # Comments Views Activity
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…

929 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

11 Experts available now in Live!

Get 1:1 Help Now