Mathematica 9 is now available
Services & Resources / Wolfram Forums
-----
 /
MathGroup Archive
1999
*January
*February
*March
*April
*May
*June
*July
*August
*September
*October
*November
*December
*Archive Index
*Ask about this page
*Print this page
*Give us feedback
*Sign up for the Wolfram Insider

MathGroup Archive 1999

[Date Index] [Thread Index] [Author Index]

Search the Archive

Re: Re: Langford's Problem (another solution)

  • To: mathgroup at smc.vnet.net
  • Subject: [mg19618] Re: [mg19594] Re: [mg19541] Langford's Problem (another solution)
  • From: "Andrzej Kozlowski" <andrzej at tuins.ac.jp>
  • Date: Sun, 5 Sep 1999 16:57:40 -0400
  • Sender: owner-wri-mathgroup at wolfram.com

Once I saw Fred Simons solution I realized at once two things. The first  is
that probably one reason why Mathematica does not have a built in Backtrack
function is that backtracking is basically a method rather than a function,
which means that in most problems a custom backtracking solution will
generally be faster than a "general" Backtrack function. Still, I must say
it is easier to make use of a built in function than to have to program it
each time from scratch so I still feel that it is worth having one. Which
brings me to the second thing which is that is that I made a poor use of the
existing Backtrack. The better way to proceed is to consider a state space
made up of all possible pairs of positions rather than numbers, and then
just choose pairs of positions rather than individual numbers as in my
original algorithm. With this the built in Backtrack also works pretty fast.
Here is the new implementation:

First w load in the Combinatorica package (or use Allan Hayes functional
"Backtrack2" function, which should be faster though that might run out of
memory for larger lists)

<<DiscreteMath`Combinatorica`

Next we define our state space:
In[1]:=
pos[i_,n_]:=Table[{j,j+i+1},{j,1,2n-i-1}]
In[2]:=
space[n_]:=Table[pos[i,n],{i,1,n}]

For example
In[3]:=
space[4]
Out[3]=
{{{1, 3}, {2, 4}, {3, 5}, {4, 6}, {5, 7}, {6, 8}}, {{1, 4}, {2, 5}, {3, 6},
{4, 7}, {5, 8}}, {{1, 5}, {2, 6}, {3, 7}, {4, 8}}, {{1, 6}, {2, 7}, {3, 8}}}

This means that the possible positions for 1 are {1,3}, {2,4},{3,5},{4, 6},
{5, 7}, {6, 8} , for 2 they are {1, 4}, {2, 5}, {3, 6}, {4, 7}, {5, 8}  and
so on.
Now, our test for a partial solution is extremly simple: we only require
that no position be chosen twice!

In[4]:=
partialQ[l_]:=Length[Flatten[l]]==Length[Union[Flatten[l]]]

The test for the final solution will be exactly the same.
Finally the new problem soving function is now:

In[5]:=
problem[n_]:=Backtrack[space[n],partialQ,partialQ,All]


We can now check


In[6]:=
problem[3]
Out[6]=
{{{2, 4}, {3, 6}, {1, 5}}, {{3, 5}, {1, 4}, {2, 6}}}

In[7]:=
problem[4]
Out[7]=
{{{2, 4}, {5, 8}, {3, 7}, {1, 6}}, {{5, 7}, {1, 4}, {2, 6}, {3, 8}}}
In[8]:=
problem[5]
Out[8]=
{}
In[9]:=
problem[6]
Out[9]=
{}

In[10]:=
problem[7]//Timing
Out[10]=
{21.3167 Second, {{{1, 3}, {4, 7}, {8, 12}, {9, 14}, {5, 11}, {6, 13}, {2,
        10}}, {{1, 3}, {4, 7}, {9, 13}, {6, 11}, {8, 14}, {5, 12}, {2,
        10}}, {{1, 3}, {5, 8}, {10, 14}, {6, 11}, {7, 13}, {2, 9}, {4,
        12}}, {{1, 3}, {6, 9}, {10, 14}, {7, 12}, {2, 8}, {4, 11}, {5,
        13}}, {{1, 3}, {8, 11}, {9, 13}, {2, 7}, {4, 10}, {5, 12}, {6,
        14}}, {{1, 3}, {9, 12}, {6, 10}, {2, 7}, {8, 14}, {4, 11}, {5,
        13}}, {{1, 3}, {10, 13}, {4, 8}, {7, 12}, {5, 11}, {2, 9}, {6,
        14}}, {{1, 3}, {10, 13}, {5, 9}, {6, 11}, {2, 8}, {7, 14}, {4,
        12}}, {{1, 3}, {10, 13}, {5, 9}, {7, 12}, {2, 8}, {4, 11}, {6,
        14}}, {{1, 3}, {10, 13}, {7, 11}, {4, 9}, {2, 8}, {5, 12}, {6,
        14}}, {{2, 4}, {6, 9}, {10, 14}, {8, 13}, {1, 7}, {5, 12}, {3,
        11}}, {{2, 4}, {7, 10}, {9, 13}, {1, 6}, {8, 14}, {5, 12}, {3,
        11}}, {{2, 4}, {9, 12}, {7, 11}, {1, 6}, {8, 14}, {3, 10}, {5,
        13}}, {{2, 4}, {10, 13}, {3, 7}, {6, 11}, {8, 14}, {5, 12}, {1,
        9}}, {{2, 4}, {11, 14}, {6, 10}, {3, 8}, {7, 13}, {5, 12}, {1,
        9}}, {{2, 4}, {11, 14}, {6, 10}, {7, 12}, {3, 9}, {1, 8}, {5,
        13}}, {{3, 5}, {8, 11}, {10, 14}, {1, 6}, {7, 13}, {2, 9}, {4,
        12}}, {{3, 5}, {10, 13}, {2, 6}, {7, 12}, {8, 14}, {4, 11}, {1,
        9}}, {{3, 5}, {10, 13}, {7, 11}, {1, 6}, {8, 14}, {2, 9}, {4,
        12}}, {{3, 5}, {11, 14}, {6, 10}, {8, 13}, {1, 7}, {2, 9}, {4,
        12}}, {{3, 5}, {11, 14}, {8, 12}, {2, 7}, {4, 10}, {6, 13}, {1,
        9}}, {{3, 5}, {11, 14}, {8, 12}, {4, 9}, {1, 7}, {6, 13}, {2,
        10}}, {{4, 6}, {10, 13}, {1, 5}, {7, 12}, {8, 14}, {2, 9}, {3,
        11}}, {{4, 6}, {11, 14}, {9, 13}, {3, 8}, {1, 7}, {5, 12}, {2,
        10}}, {{5, 7}, {1, 4}, {10, 14}, {8, 13}, {6, 12}, {2, 9}, {3,
        11}}, {{5, 7}, {11, 14}, {9, 13}, {1, 6}, {2, 8}, {3, 10}, {4,
        12}}, {{8, 10}, {1, 4}, {2, 6}, {9, 14}, {7, 13}, {5, 12}, {3,
        11}}, {{8, 10}, {11, 14}, {1, 5}, {2, 7}, {3, 9}, {6, 13}, {4,
        12}}, {{9, 11}, {1, 4}, {2, 6}, {7, 12}, {8, 14}, {3, 10}, {5,
        13}}, {{9, 11}, {2, 5}, {10, 14}, {3, 8}, {1, 7}, {6, 13}, {4,
        12}}, {{10, 12}, {1, 4}, {3, 7}, {6, 11}, {8, 14}, {2, 9}, {5,
        13}}, {{10, 12}, {1, 4}, {3, 7}, {8, 13}, {5, 11}, {2, 9}, {6,
        14}}, {{10, 12}, {1, 4}, {5, 9}, {2, 7}, {8, 14}, {6, 13}, {3,
        11}}, {{10, 12}, {2, 5}, {4, 8}, {9, 14}, {1, 7}, {6, 13}, {3,
        11}}, {{10, 12}, {2, 5}, {9, 13}, {3, 8}, {1, 7}, {4, 11}, {6,
        14}}, {{10, 12}, {4, 7}, {1, 5}, {9, 14}, {2, 8}, {6, 13}, {3,
        11}}, {{11, 13}, {1, 4}, {5, 9}, {3, 8}, {6, 12}, {7, 14}, {2,
        10}}, {{11, 13}, {1, 4}, {5, 9}, {7, 12}, {2, 8}, {3, 10}, {6,
        14}}, {{11, 13}, {2, 5}, {8, 12}, {4, 9}, {1, 7}, {3, 10}, {6,
        14}}, {{11, 13}, {3, 6}, {4, 8}, {9, 14}, {1, 7}, {5, 12}, {2,
        10}}, {{11, 13}, {5, 8}, {2, 6}, {9, 14}, {1, 7}, {3, 10}, {4,
        12}}, {{11, 13}, {6, 9}, {1, 5}, {2, 7}, {8, 14}, {3, 10}, {4,
        12}}, {{12, 14}, {2, 5}, {4, 8}, {6, 11}, {7, 13}, {3, 10}, {1,
        9}}, {{12, 14}, {2, 5}, {6, 10}, {3, 8}, {7, 13}, {4, 11}, {1,
        9}}, {{12, 14}, {2, 5}, {6, 10}, {4, 9}, {7, 13}, {1, 8}, {3,
        11}}, {{12, 14}, {2, 5}, {7, 11}, {3, 8}, {4, 10}, {6, 13}, {1,
        9}}, {{12, 14}, {3, 6}, {5, 9}, {8, 13}, {1, 7}, {4, 11}, {2,
        10}}, {{12, 14}, {4, 7}, {2, 6}, {8, 13}, {5, 11}, {3, 10}, {1,
        9}}, {{12, 14}, {6, 9}, {1, 5}, {3, 8}, {7, 13}, {4, 11}, {2,
        10}}, {{12, 14}, {7, 10}, {1, 5}, {4, 9}, {2, 8}, {6, 13}, {3,
        11}}, {{12, 14}, {8, 11}, {2, 6}, {4, 9}, {1, 7}, {3, 10}, {5,
        13}}, {{12, 14}, {8, 11}, {3, 7}, {1, 6}, {4, 10}, {2, 9}, {5,
13}}}}

This is vastly faster than before. It's still not as fast as Fred's solution
(not to mention the optimized version by Hartmut) but it's fast enoguh and I
dont't think the code could be made any simpler.
--
Andrzej Kozlowski
Toyama International University
JAPAN
http://sigma.tuins.ac.jp
http://eri2.tuins.ac.jp


-


  • Prev by Date: Re: Re: Langford's Problem (another solution improved)
  • Next by Date: Re: Multiple sum with iterators that cannot equal
  • Previous by thread: Re: Re: Langford's Problem (yet another improvement!)
  • Next by thread: Levenberg-Marquart code