All about flooble | fun stuff | Get a free chatterbox | Free JavaScript | Avatars
 perplexus dot info

 The Conversing Club 3 (Posted on 2004-03-28)
Many members of the club disliked the lack of variety and togetherness at the club. Although the club still had 12 members, some members were threatening to quit because each schedule was so short and there were so few people around each table.

To satisfy their request, the club decided to seat themselves around a big table and create a longer schedule. The twelve members of the club seated themselves in a schedule such that during each block of 55 days, no person was between the same pair of people. How was the schedule constructed?

(Based on The Round Table)

 No Solution Yet Submitted by Gamer Rating: 4.5714 (14 votes)

Comments: ( Back to comment list | You must be logged in to post comments.)
 I will solve this puzzle if it takes all summer !! | Comment 22 of 62 |

(See program listing below).

I don't know why I am so obsessed with "The Conversing Club 3", but.......The fact that the 12 conversers are sitting at a ROUND table, means that we can envision one of the conversers A thru L, let's say L, as always sitting in the same "rightmost" chair, with the other 11 conversers sitting to her "left" (so that the one "leftmost" from her is actually on her right). Then we can just compute combinations of those 11, which is a reasonably "small" number, 11! = 39,916,800, rather than trying to work with 12! = 479,001,600, which is too big a number for my little Visual Basic program. But 11! is not too big. I have improved my randomizing algorithm, and I am now battering at the gates of "The Conversing Club 3". I seat the 12 conversers in order A,B,C,D,E,F,G,H,I,J,K,L on the first day, then I mix up A thru K, always having L at "the rightmost" chair. My program tries 11! combinations of A-K before assuming that it's a dead-end. Then I trry again. It takes about 8-15 hours on my system to move thru all 11! possibilities. But as Civil War General Ulysses S. Grant once said, "I propose to fight it out on this line if it takes all summer !"

Imports System
Imports System.IO
Imports System.Text
Imports System.Runtime.InteropServices
Imports System.Math
Module Module1
Sub Main()
Randomize()
Dim strStartTime As String
Dim strEndTime As String
Dim dblCount1 As Double = 0
Dim strGood As String
Dim strEnd As String
Dim dblRCount As Double = 0
Dim dblRBound As Double
Dim strArray(55, 12) As String
Dim strOneDay(12) As String
strStartTime = TimeOfDay
Console.WriteLine( _
TimeOfDay & ": Beginning execution")
Console.WriteLine(" ")
dblRCount = 0
dblRBound = 11 * 10 * 9 * 8 * 7 * _
6 * 5 * 4 * 3 * 2 * 1
InitializeTable(strArray)
dblRCount = 0
strGood = "N"
While strGood = "N"
While dblRCount <= dblRBound
BuildTheTable(strArray, _
strOneDay, strGood, _
dblCount1, _
dblRCount, dblRBound, strStartTime)
If strGood = "Y" Then
Exit While
End If
End While
If strGood = "N" Then
strGood = "F"
End If
End While
Console.WriteLine(" ")
If strGood = "F" Then
For Index67 As Integer = 0 To 15
Console.WriteLine( _
Next
Else
For index99 As Integer = 0 To 29
Console.WriteLine("EUREKA !!!!!!!!")
Next
For Index1 As Integer = 0 To 54
Console.WriteLine( _
strArray(Index1, 0) & " " & _
strArray(Index1, 1) & " " & _
strArray(Index1, 2) & " " & _
strArray(Index1, 3) & " " & _
strArray(Index1, 4) & " " & _
strArray(Index1, 5) & " " & _
strArray(Index1, 6) & " " & _
strArray(Index1, 7) & " " & _
strArray(Index1, 8) & " " & _
strArray(Index1, 9) & " " & _
strArray(Index1, 10) & " " & _
strArray(Index1, 11))
Next
End If
strEndTime = TimeOfDay
Console.WriteLine(" ")
Console.WriteLine("Start of execution: " & strStartTime)
strEndTime = TimeOfDay
Console.WriteLine("End of execution: " & strEndTime)
strEnd = "?"
Console.WriteLine(" ")
While strEnd <> "X"
Console.WriteLine("Please enter X to exit program...")
End While
End Sub

Sub InitializeTable(ByRef strArray)
strArray(0, 0) = "A"
strArray(0, 1) = "B"
strArray(0, 2) = "C"
strArray(0, 3) = "D"
strArray(0, 4) = "E"
strArray(0, 5) = "F"
strArray(0, 6) = "G"
strArray(0, 7) = "H"
strArray(0, 8) = "I"
strArray(0, 9) = "J"
strArray(0, 10) = "K"
strArray(0, 11) = "L"
For Index1 As Integer = 1 To 54
For Index2 As Integer = 0 To 11
strArray(Index1, Index2) = "Z"
Next
Next
End Sub

Sub BuildTheTable(ByRef strArray, ByRef strOneDay, _
ByRef strGood, ByRef dblCount1, ByRef dblRCount, _
ByRef dblRBound, ByRef strStartTime)
While strGood = "N" And _
dblRCount <= dblRBound
GetASched(strOneDay)
dblRCount += 1
If dblRCount > dblRBound Then
Exit While
End If
TestRowToTable(strArray, _
strOneDay, strGood, dblCount1, _
dblRCount, dblRBound, _
strStartTime)
End While
End Sub

Sub GetASched(ByRef strOneDay)
Dim intWork1(11) As String
Dim intSub1 As Integer
Dim intNumb As Integer
intWork1(0) = "A"
intWork1(1) = "B"
intWork1(2) = "C"
intWork1(3) = "D"
intWork1(4) = "E"
intWork1(5) = "F"
intWork1(6) = "G"
intWork1(7) = "H"
intWork1(8) = "I"
intWork1(9) = "J"
intWork1(10) = "K"
intSub1 = 11
For Index1 As Integer = 0 To 10
intSub1 = intSub1 - 1
intNumb = Int((intSub1 - 0 + 1) * Rnd()) + 0
strOneDay(Index1) = intWork1(intNumb)
If intNumb < 10 Then
For Index2 As Integer = intNumb To 9
intWork1(Index2) = intWork1(Index2 + 1)
Next
End If
intWork1(10) = " "
Next
strOneDay(11) = "L"
End Sub

Sub TestRowToTable(ByRef strArray, _
ByRef strOneDay, ByRef strGood, ByRef dblCount1, _
ByRef dblRCount, ByRef dblRBound, _
ByRef strStartTime)
Dim strGoodTable As String
strGoodTable = "Y"
If strGood = "Y" Then
Exit Sub
End If
For Index2 As Integer = 0 To 54
IntervalCount(dblCount1, _
strGood, strArray, _
dblRCount, dblRBound, _
strOneDay, strStartTime)
If strGood = "Y" Then
Exit Sub
End If
If strArray(Index2, 0) = "Z" Then
If strGoodTable = "Y" Then
strOneDay, _
strGood)
End If
Exit Sub
End If
CompareRows(Index2, _
strArray, strOneDay, strGoodTable)
If strGoodTable = "N" Then
Exit Sub
End If
Next
End Sub

Sub CompareRows(ByRef Index2, _
ByRef strArray, ByRef strOneDay, ByRef strGoodTable)
Dim intSub1 As Integer
Dim intSub2 As Integer
Dim intSub3 As Integer
Dim intSub4 As Integer
strGoodTable = "Y"
For Index3 As Integer = 0 To 11
If Index3 = 0 Then
intSub1 = 11
intSub2 = 1
ElseIf Index3 = 11 Then
intSub1 = 10
intSub2 = 0
Else
intSub1 = Index3 - 1
intSub2 = Index3 + 1
End If
For Index4 As Integer = 0 To 11
If Index4 = 0 Then
intSub3 = 11
intSub4 = 1
ElseIf Index4 = 11 Then
intSub3 = 10
intSub4 = 0
Else
intSub3 = Index4 - 1
intSub4 = Index4 + 1
End If
If strOneDay(Index3) = _
strArray(Index2, Index4) Then
If strOneDay(intSub1) = _
strArray(Index2, intSub3) And _
strOneDay(intSub2) = _
strArray(Index2, intSub4) Then
strGoodTable = "N"
Exit Sub
End If
If strOneDay(intSub2) = _
strArray(Index2, intSub3) And _
strOneDay(intSub1) = _
strArray(Index2, intSub4) Then
strGoodTable = "N"
Exit Sub
End If
End If
Next
Next
End Sub

Sub AddNewDayToTable(ByRef strArray, _
ByRef strOneDay, _
ByRef strGood)
For Index2 As Integer = 0 To 54
If strArray(Index2, 0) = "Z" Then
If Index2 = 54 Then
strGood = "Y"
End If
For Index3 As Integer = 0 To 11
strArray(Index2, Index3) = _
strOneDay(Index3)
Next
Exit Sub
End If
Next
End Sub

Sub IntervalCount(ByRef dblCount1, _
ByRef strGood, ByRef strArray, _
ByRef dblRCount, ByRef dblRBound, _
ByRef strOneDay, ByRef strStartTime)
Dim intTableRows As Integer
Dim dblWork As Double
Dim dblPercent As Double
dblCount1 += 1
If dblCount1 >= 1000000 Then
dblCount1 = 0
dblWork = 100 * (dblRCount / dblRBound)
dblPercent = _
Int(dblWork * (10 ^ 2) + 0.5) / _
(10 ^ 2)
Console.WriteLine("We have been executing " & _
"since " & strStartTime)
Console.WriteLine("It is now " & TimeOfDay)
Console.WriteLine( _
Str(dblRCount) & " day schedules (" & _
Str(dblPercent) & "% of " & _
Str(dblRBound) & ")")
Console.WriteLine( _
" have been randomly generated for this run.")
intTableRows = 0
For Index1 As Integer = 0 To 54
If strArray(Index1, 0) = "Z" Then
Exit For
End If
intTableRows += 1
Next
Console.WriteLine( _
"The table now has " & _
Str(intTableRows) & " rows.")
Console.WriteLine(" ")
End If
End Sub
End Module

Edited on July 6, 2004, 12:59 pm
 Posted by Penny on 2004-07-06 12:55:11

 Search: Search body:
Forums (0)