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)

(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( _
                "Egad, another blasted dead-end !!!!!")
            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...")
            strEnd = UCase(Console.ReadLine())
        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
                    AddNewDayToTable(strArray, _
                    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