Message Boards

WOLFRAM COMMUNITY

11797 Views

9 Replies

4 Total Likes

View groups...

Follow this post

Share this post:

GROUPS:

Mathematics Mathematica Discrete Mathematics Graphs and Networks

How to get perfect square from the list element..

Okkes Dulgerci

Posted 10 years ago

Hi All, I need some help to solve this problem.. Assume you have n=1,2,3,...,15 number. Put them in an order so that when you add two successive number you get perfect square. As seen one example below. 9+7=16, 7+2=9, 2+14=16, and so on. I did this using pen and paper work.. I tried to solve this using Mathematica. First I got a set of number that make each number perfect square.. But I don't know what should be next step. I tried to use graph but it takes time and is easy to make error (has not been completed yet). I also want to extend it to say n=25.. Any help appreciated. Thanks.. when n=15---->9-7-2-14-11-5-4-12-13-3-6-10-15-1-8 when n=16----> 16-9-7-2-14-11-5-4-12-13-3-6-10-15-1-8 when n=17----> 16-9-7-2-14-11-5-4-12-13-3-6-10-15-1-8-17 when n=18----> no sequences when n=19----> no sequences when n=20----> I claimed no sequences It Must start with 18 since there is only one number make it perfect square namely 7. 18+7 but after this we have two options. 18+7+2 or 18+7+9 Please see attachment.. Attachments:

POSTED BY: Okkes Dulgerci

9 Replies

Sort By:

Okkes Dulgerci

Posted 10 years ago

Awesome Dent!!. Thanks a lot you all..

POSTED BY: Okkes Dulgerci

Okkes Dulgerci

Posted 10 years ago

Hi John, I forgot to mention that numbers cannot repeat and a sequence must contain all n. But I'll check it again maybe there is another combination..

POSTED BY: Okkes Dulgerci

Anonymous User

Posted 10 years ago

New phone still learning how to use it Sorry trying one more time Attachments:

POSTED BY: Anonymous User

Anonymous User

Posted 10 years ago

Sorry wrong pic See better pic attached Attachments:

POSTED BY: Anonymous User

Anonymous User

Posted 10 years ago

Attachments:

POSTED BY: Anonymous User

Okkes Dulgerci

Posted 10 years ago

Hi Paul, Thanks for your reply. Someone conjectured that you can always find a sequence for n>=25. It seems it is true for n>=32. How can we check it for 20<=n<31

POSTED BY: Okkes Dulgerci

Paul Cleary

Posted 10 years ago

Hi Okkes This works for n >=32, they are circular paths that are squares i.e. the first and last is also square. Do[a = Range[q]; b = Subsets[a, {2}]; b = Select[b, IntegerQ[Sqrt[#[[1]] + #[[2]]]] &]; b = GatherBy[b, #[[1]] &]; b = Flatten[b, 1]; b = DirectedEdge @@@ b; g = Graph[b]; g1 = UndirectedGraph[g]; s = FindHamiltonianCycle[g1]; s = Flatten[s]; s = ToString /@ s; s = StringReplace[s, "\[UndirectedEdge]" .. -> ","]; p = DeleteDuplicates[ Flatten[StringCases[s, RegularExpression["\\d+"]]]]; Print[{q, p}], {q, 32, 40}] // Timing It will slow down if you go above 1000 or so. P.

Hi Okkes

This works for n >=32, they are circular paths that are squares i.e. the first and last is also square.

Do[a = Range[q]; b = Subsets[a, {2}]; 
  b = Select[b, IntegerQ[Sqrt[#[[1]] + #[[2]]]] &]; 
  b = GatherBy[b, #[[1]] &]; b = Flatten[b, 1]; 
  b = DirectedEdge @@@ b; g = Graph[b]; g1 = UndirectedGraph[g]; 
  s = FindHamiltonianCycle[g1]; s = Flatten[s]; s = ToString /@ s; 
  s = StringReplace[s, "\[UndirectedEdge]" .. -> ","]; 
  p = DeleteDuplicates[
    Flatten[StringCases[s, RegularExpression["\\d+"]]]]; 
  Print[{q, p}], {q, 32, 40}] // Timing

It will slow down if you go above 1000 or so.

POSTED BY: Paul Cleary

Udo Krause

Udo Krause, NOrganization

Posted 10 years ago

The sequences produced by Paul's procedure In[5]:= Do[a = Range[q]; b = Subsets[a, {2}]; b = Select[b, IntegerQ[Sqrt[#[[1]] + #[[2]]]] &]; b = GatherBy[b, #[[1]] &]; b = Flatten[b, 1]; b = DirectedEdge @@@ b; g = Graph[b]; g1 = UndirectedGraph[g]; s = FindHamiltonianCycle[g1]; s = Flatten[s]; s = ToString /@ s; s = StringReplace[s, "\[UndirectedEdge]" .. -> ","]; p = DeleteDuplicates[ Flatten[StringCases[s, RegularExpression["\\d+"]]]]; Print[{q, p}], {q, 32, 40}] // Timing During evaluation of In[5]:= {32,{1,15,10,26,23,2,14,22,27,9,16,20,29,7,18,31,5,11,25,24,12,13,3,6,30,19,17,32,4,21,28,8}} During evaluation of In[5]:= {33,{1,15,10,26,23,2,14,22,27,9,16,33,31,18,7,29,20,5,11,25,24,12,13,3,6,30,19,17,32,4,21,28,8}} During evaluation of In[5]:= {34,{1,8,28,21,15,10,26,23,13,12,24,25,11,5,4,32,17,19,6,30,34,2,14,22,27,9,16,20,29,7,18,31,33,3}} During evaluation of In[5]:= {35,{1,8,28,21,15,34,2,14,11,25,24,12,13,23,26,10,6,30,19,17,32,4,5,31,18,7,9,27,22,3,33,16,20,29,35}} During evaluation of In[5]:= {36,{1,8,17,32,4,12,13,36,28,21,15,34,30,19,6,10,26,23,2,14,35,29,20,16,33,3,22,27,9,7,18,31,5,11,25,24}} During evaluation of In[5]:= {37,{1,24,25,11,14,22,3,33,16,9,27,37,12,13,36,28,8,17,32,4,21,15,34,30,19,6,10,26,23,2,7,18,31,5,20,29,35}} During evaluation of In[5]:= {38,{1,8,17,32,4,5,31,18,7,9,27,37,12,24,25,11,38,26,23,13,36,28,21,15,10,6,19,30,34,2,14,22,3,33,16,20,29,35}} During evaluation of In[5]:= {39,{1,24,25,39,10,6,19,30,34,15,21,4,32,17,8,28,36,13,12,37,27,9,7,18,31,5,11,38,26,23,2,14,22,3,33,16,20,29,35}} During evaluation of In[5]:= {40,{1,24,40,9,27,37,12,13,36,28,8,17,32,4,21,15,34,30,19,6,10,39,25,11,38,26,23,2,14,22,3,33,16,20,5,31,18,7,29,35}} Out[5]= {0.156001, Null} have the property, that also the first and the last entry of them sum up to a perfect square. That comes from the hamiltonian cycle searched for in the graph containing only vertices whose node values sum up to a perfect square. To get rid of that over-doing, one should accept one non-square vertex, then search again for a hamiltonian cycle and cut the cycle by throwing the non-square vertex away.

The sequences produced by Paul's procedure

In[5]:= Do[a = Range[q]; b = Subsets[a, {2}];
  b = Select[b, IntegerQ[Sqrt[#[[1]] + #[[2]]]] &];
  b = GatherBy[b, #[[1]] &]; b = Flatten[b, 1];
  b = DirectedEdge @@@ b; g = Graph[b]; g1 = UndirectedGraph[g];
  s = FindHamiltonianCycle[g1]; s = Flatten[s]; s = ToString /@ s;
  s = StringReplace[s, "\[UndirectedEdge]" .. -> ","];
  p = DeleteDuplicates[
    Flatten[StringCases[s, RegularExpression["\\d+"]]]];
  Print[{q, p}], {q, 32, 40}] // Timing

During evaluation of In[5]:= {32,{1,15,10,26,23,2,14,22,27,9,16,20,29,7,18,31,5,11,25,24,12,13,3,6,30,19,17,32,4,21,28,8}}

During evaluation of In[5]:= {33,{1,15,10,26,23,2,14,22,27,9,16,33,31,18,7,29,20,5,11,25,24,12,13,3,6,30,19,17,32,4,21,28,8}}

During evaluation of In[5]:= {34,{1,8,28,21,15,10,26,23,13,12,24,25,11,5,4,32,17,19,6,30,34,2,14,22,27,9,16,20,29,7,18,31,33,3}}

During evaluation of In[5]:= {35,{1,8,28,21,15,34,2,14,11,25,24,12,13,23,26,10,6,30,19,17,32,4,5,31,18,7,9,27,22,3,33,16,20,29,35}}

During evaluation of In[5]:= {36,{1,8,17,32,4,12,13,36,28,21,15,34,30,19,6,10,26,23,2,14,35,29,20,16,33,3,22,27,9,7,18,31,5,11,25,24}}

During evaluation of In[5]:= {37,{1,24,25,11,14,22,3,33,16,9,27,37,12,13,36,28,8,17,32,4,21,15,34,30,19,6,10,26,23,2,7,18,31,5,20,29,35}}

During evaluation of In[5]:= {38,{1,8,17,32,4,5,31,18,7,9,27,37,12,24,25,11,38,26,23,13,36,28,21,15,10,6,19,30,34,2,14,22,3,33,16,20,29,35}}

During evaluation of In[5]:= {39,{1,24,25,39,10,6,19,30,34,15,21,4,32,17,8,28,36,13,12,37,27,9,7,18,31,5,11,38,26,23,2,14,22,3,33,16,20,29,35}}

During evaluation of In[5]:= {40,{1,24,40,9,27,37,12,13,36,28,8,17,32,4,21,15,34,30,19,6,10,39,25,11,38,26,23,2,14,22,3,33,16,20,5,31,18,7,29,35}}

Out[5]= {0.156001, Null}

have the property, that also the first and the last entry of them sum up to a perfect square. That comes from the hamiltonian cycle searched for in the graph containing only vertices whose node values sum up to a perfect square.

To get rid of that over-doing, one should accept one non-square vertex, then search again for a hamiltonian cycle and cut the cycle by throwing the non-square vertex away.

POSTED BY: Udo Krause

Udo Krause

Udo Krause, NOrganization

Posted 10 years ago

POSTED BY: Udo Krause

Reply to this discussion

Reply Preview

Attachments

Remove Add a file to this post

Follow this discussion

or Discard

Group Abstract

Feedback