Seating couples round a table - alternative view of handbell

[nicholas.small]

A couple of days ago I made a post on APL Chat that arose from a puzzle about change ringing on handbells. I did not explain what the puzzle was (though will do so if anyone wishes to know) but have thought of an alternative derivation of the same problem that can be simply explained.

Seat n couples round a table so that one couple sit next to each other, another have one person between them, a third couple have two people between them, ...., and the n'th couple have n-1 people between them.

A parity check shows that there is no solution for 2, 3, 6, 7, 10, 11 etc. couples. There is a unique solution for 4 and only 2 for 5. However, for 8 there are about 200 and for 9 about 1200.

I'm not asking for solutions to the problem but what I would like to know is whether anyone recognises the problem in this format, or has seen it in some other guise.

Nicholas

[petermsiegel]

This is a fascinating variant of the problème des ménages, aka the Married Couples problem, but not one I've seen before (others include the Oberwolfach problem). Since a number of the variants have only been solved in special cases after many years of trying, this is rather interesting. Would love to see what you learn, even correct APL solutions that might be intractable in practice.

[Veli-Matti]

Just had to have a closer look.

      ≢    ∆seats 4
1
      ≢    ∆seats 5
2
      ≢    ∆seats 6
0
      ≢    ∆seats 7
0
      ≢    ∆seats 8
192
      ≢    ∆seats 9
1200

..quick and dirty method, but uses memory (outer product!) :(
Five pair seatings & source:

      ∆seats 5
 1 1 5 2 4 2 3 5 4 3  1 1 5 4 2 3 2 5 3 4 

        ⎕vr¨ '∆seats' '∆ring' '∆clean'
      ∇ z←∆seats n;i;wd                          
[1]                                              
[2]    wd←¯2+2×n ⋄ z←wd ∆ring 1                  
[3]                                              
[4]    :For i :In 1+⍳n-2                         
[5]        z←∪(i+1){⍵/⍨⍺{∧/⍺≥⍵}¨⍵},z∘.+wd ∆ring i
[6]    :EndFor                                   
[7]                                              
[8]    z←1 1∘,¨∆clean z                          
     ∇       ∇ ∆ring←{                           
[1]        v←(1-⍳⍺-⍵+1)⌽¨⊂⍺↑(1∘+,(0⍴⍨⊢),1∘+)⍵    
[2]        2>⍵:v                                 
[3]        v,(1-⍳⍵-1)⌽¨⊂⍺↑(1∘+,(0⍴⍨⍺-⊢),1∘+)⍵    
[4]    }                                         
     ∇       ∇ z←∆clean x;b;i                    
[1]                                              
[2]    :For i :In ⍳≢b←1⊣¨x←(≠x)/x                
[3]        :If ~i⊃b ⋄ :Continue ⋄ :End           
[4]        b←b\b/x≢¨⊂⌽i⊃x                        
[5]    :EndFor                                   
[6]                                              
[7]    z←b/x                                     
     ∇

Waiting for more efficient solutions...
-Veli-Matti

[nicholas.small]

I approached the problem by building solutions from permutations of ⍳n-1, with the number j indicating the pair seated j apart. Initially I was content to find one solution for each permutation but anaylsis of the results indicated that more were possible (with 8 pairs there are 20 permutations with two solutions and one with three). ∇clean has to be applied to the result. (Warning to those of a sensitive disposition: you inspect the following code at your own risk; availability of a darkened room for recovery is recommended)

Nicholas

z←HandbellPairs npairs;nposn;perms;⎕IO;f
⍝ Find combinations with distinct pairs on 2×npairs bells
⍝ z is (pairs)(perms)
npairs←npairs-1 ⍝ Pair 0 is the coursing pair
⎕IO←1
nposn←2×npairs
perms←↓PermsN npairs
z←(Testperm¨perms)
f←~z≡¨⊂0⍴0
z←(f/z) ⍝ (f/perms)

zz←Testperm perm;nk;p1;p2;k;kp;level;z;z0k
⍝ Does this perm give all pairs different?
z0k←(npairs,nposn)⍴0 ⍝ For saving initial state at stage k
level←npairs⍴k←1
z←nposn⍴0
zz←(0,nposn)⍴0
Loop:
nk←perm[k]
p1←z⍳0
→(nposn<p2←p1+nk+1)/Fail1
→(0≠z[p2])/Fail1
Assign:
z[p1,p2]←nk
LoopEnd:
→(npairs<k←k+1)/Done ⍝ Solution found
z0k[k;]←z
→Loop
Fail1: ⍝ Try reaching round 0
level[k]←2
→(nk=npairs)/Fail2 ⍝ This would retry the same position
→(p1≥nk)/Fail2
→(0≠z[p2←nposn-((nk-2)-(p1-1))])/Fail2
→Assign
Fail2: ⍝ Backtrack to previous level 1
→(k=kp←(⌽(k-1)↑level)⍳1)/Fail
k←k-kp
level[k↓⍳npairs]←1
z←z0k[k;]
p1←z⍳0
nk←perm[k]
z0k[k↓⍳npairs;]←0
→Fail1
Fail:
:If 0∊⍴zz
zz←0⍴0
:EndIf
→0
Done:
zz←zz⍪z
k←k-1
→Fail2 ⍝ Try for more

[Veli-Matti]

Just had to try to make the original idea a little bit further, i.e. try to avoid ws full. This function does not handle the trivial cases 0 - 3, it does not use my inefficient ∆clean function, but perhaps someone finds it amusing.

      ⍝
 z←seats p;done;len;n;nxt;rgs;s;set;⍙ok;⍙ring

 ⍙ring←{v←(1-⍳⍺-⍵+1)⌽¨⊂⍺↑⍵(,,⊣)⍵⍴0 ⋄ 2>⍵:v
     ∪v,(1-⍳⍵-1)⌽¨⊂⍺↑⍵(,,⊣)0⍴⍨⍺-⍵}

 ⍙ok←{0∊⍴⍵:⍬ ⋄ ⍵/⍨(len-2×1+nxt)=+/¨0=⍵}

 (done nxt len z)←0 1(2×p-1)⍬
 set←rgs←len ⍙ring¨⍳p-1

 :Repeat
     :If 0∊⍴s←nxt⊃set ⋄ nxt-←1 ⋄ done←0=nxt
     :ElseIf nxt=p-1 ⋄ nxt-←1 ⋄ z,←s/⍨~(⌽¨s)∊z
     :Else ⋄ set[nxt]←⊂1↓s
         :If ~0∊⍴s←⍙ok(1⌷s)+rgs⊃⍨n←1+nxt ⋄ set[nxt←n]←⊂s ⋄ :End
     :EndIf
 :Until done

 z←0 0∘,¨z

For cases 8 - 12 the corresponding results have 192, 1200, 0, 0 and 456960 solutions, and (with a huge ws size and v17.1/64) the calculations lasted 0.06, 0.5, 4, 36 and 7486 seconds. The calculation for 13 pairs has lasted now some 14 hours...

-Veli-Matti

[nicholas.small]

You should be able to avoid producing the duplicate values by only generating the first half of the values in ∆ring for the largest spacing (p-1).

Nicholas

[Veli-Matti]

Methinks that's already taken care of with the ∪, i.e.

      ⍝
    ≢¨20 ⍙ring¨ ⍳10
18 18 18 18 18 18 18 18 18 9

-wm

[nicholas.small]

If you take only the first ⌊(p-1)÷2 generated by ⍙ring when ⍵ is p-1, then you will avoid generating duplicates and can manage without the code /⍨~(⌽¨s)∊z in the :Repeat loop.
(I've not had a chance to test this - I'm away from home at present.)

Nicholas

[nicholas.small]

Correction - it should be ⌈(p-1)÷2 items.
Nicholas

[Veli-Matti]

Was spending my time in our summer cottage, so couldn't respond earlier.
That approach does not fully work... But rethinking my original approach could make the algorithm some 25 times quicker.

      ⍝
z←seats p;n;nx;rs;s;st;⍙rng

 ⍙rng←{v←(1-⍳⍺-⍵+1)⌽¨⊂⍺↑(≢,⊢,≢)⍵⍴0 ⋄ 2>⍵:v
     ∪v,(1-⍳⍵-1)⌽¨⊂⍺↑⍵(,,⊣)0⍴⍨⍺-⍵}

 (nx z)←1 ⍬ ⋄ st←rs←(2×p-1)⍙rng¨⍳p-1

 :Repeat
     :If 0∊⍴s←nx⊃st ⋄ nx-←1
     :ElseIf nx=≢st ⋄ nx-←1 ⋄ z,←s
     :Else ⋄ st[nx]←⊂1↓s
         st[n]←⊂s←n{⍵/⍨⍺=⌈/¨⍵}(⊂↑s)+rs⊃⍨n←1+nx
         nx+←~0∊⍴s
     :EndIf
 :Until 0=nx

 z←0 0∘,¨clean z

and

 z←clean x;a;b;c;e;f;i;l

 a←b←0∧f←↑¨x ⋄ e←f=l←{↑⌽⍵}¨x

 :For i :In ∪f
     a←a∨i=f ⋄ c←e<a<i=l
     b←b∨c\x[⍸c]∊⌽¨x[⍸e<i=f]
 :EndFor

 :For i :In ⍸e
     :If ~i⊃e ⋄ :Continue ⋄ :End

     e←e\x[⍸e]≢¨⊂⌽i⊃x
 :EndFor

 z←(e⍱b)/x

(⎕ML←3)

-Veli-Matti