Message Boards Message Boards

How to get perfect square from the list element..

GROUPS:

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
Answer
3 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.

POSTED BY: Paul Cleary
Answer
3 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.

POSTED BY: Udo Krause
Answer
3 years ago

Doing so, a little rebuild of Paul's code gives

Clear[dulgerciSquareSequence]
dulgerciSquareSequence[n_Integer] := 
 Module[{b = Subsets[Range[n], {2}], s, ns, o, g, g1, c, p,  bFound = False},
   s = Select[b, IntegerQ[Sqrt[Plus @@ #]] &];
   ns = Complement[b, s];
   (* try every from the ns non-square vertices *)
   For[o = 1, o <= Length[ns], ++o,
    g = Graph[Join[s, {ns[[o]]}]];
    g1 = UndirectedGraph[g];
    c = FindHamiltonianCycle[g1];
    If[Length[c] > 0,
     bFound = True;
     c = ToString /@ Flatten[c];
     c = StringReplace[c, "\[UndirectedEdge]" .. -> ","];
     p = DeleteDuplicates[Flatten[StringCases[c, RegularExpression["\\d+"]]]];
     (* should cut the non-square vertex *)
     Print[p]
     ]
    ];
   If[! bFound, Print["No sequence found for n = ", n]]
   ] /; n > 5

lets test this

dulgerciSquareSequence[15]
{1,15,10,6,3,13,12,4,5,11,14,2,7,9 | 8}

this is your solution for n=15 in reverse order: 9+8=17, here is the split.

dulgerciSquareSequence[16]    
{1,15,10,6,3,13,12,4,5,11,14,2,7,9,16 | 8}

dulgerciSquareSequence[17]
{1,15,10,6,3,13,12,4,5,11,14,2,7,9,16 | 17,8}

dulgerciSquareSequence[18]
No sequence found for n = 18

dulgerciSquareSequence[19]
No sequence found for n = 19

dulgerciSquareSequence[20]
No sequence found for n = 20

dulgerciSquareSequence[21]
No sequence found for n = 21

dulgerciSquareSequence[22]
No sequence found for n = 22

dulgerciSquareSequence[23]
{1,3,22,14,11,5,20,16,9,7,18 | 2,23,13,12,4,21,15,10,6,19,17,8}
{1,3,22,14,11,5,20,16,9 | 18,7,2,23,13,12,4,21,15,10,6,19,17,8}
{1,3,22 | 18,7,9,16,20,5,11,14,2,23,13,12,4,21,15,10,6,19,17,8}

dulgerciSquareSequence[24]
No sequence found for n = 24

dulgerciSquareSequence[25]
{1,3,22,14,11,25,24,12,13,23,2 | 18,7,9,16,20,5,4,21,15,10,6,19,17,8}
{1,24,25,11,5,20,16,9,7,18 | 3,22,14,2,23,13,12,4,21,15,10,6,19,17,8}
{1,3,22,14,2,23,13,12,24,25,11,5,20,16,9,7,18 | 4,21,15,10,6,19,17,8}
{1,3,22,14,2,23,13,12,4,21,15,10,6,19,17,8 | 18,7,9,16,20,5,11,25,24}
{1,3,22,14,11,25,24,12,13,23,2,7,18 | 9,16,20,5,4,21,15,10,6,19,17,8}
{1,8,17,19,6,3,22,14,2,23,13,12,4,21,15,10 | 18,7,9,16,20,5,11,25,24}
{1,3,22,14,2,23,13,12,24,25,11 | 18,7,9,16,20,5,4,21,15,10,6,19,17,8}
{1,3,22,14,2,23,13 | 18,7,9,16,20,5,11,25,24,12,4,21,15,10,6,19,17,8}
{1,3,13,23,2,14,22 | 18,7,9,16,20,5,11,25,24,12,4,21,15,10,6,19,17,8}
{1,8,17,19,6,10,15,21,4,12,13,3,22,14,2,23 | 18,7,9,16,20,5,11,25,24}

the 18 is the at one end of a sequence.

There are many solutions for 25 < n < 32. So experimentally the situation is clear (mod errors).

POSTED BY: Udo Krause
Answer
3 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
Answer
3 years ago

Might this work For n=17----> 16-9-7- 2- 14-11- 5- 4-12- 13- 3-6-10- 15- 1- 8-8......... Then you Get n=18----->16-9-7- 2- 14-11- 5- 4-12- 13- 3-6-10- 15- 1- 8-8-17 Please see attached pic of a analysis I used sorting this out. In this analysis is seen a pattern and how extending that pattern can become a calculator generating next a term iteratively. depicted in the pic and shown are several elements generated past 8-8-17 utilizing this method

Attachment

Attachments:
POSTED BY: Anonymous User
Answer
3 years ago

Sorry wrong pic See better pic attached

Attachment

Attachments:
POSTED BY: Anonymous User
Answer
3 years ago

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

Attachment

Attachments:
POSTED BY: Anonymous User
Answer
3 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
Answer
3 years ago

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

POSTED BY: Okkes Dulgerci
Answer
3 years ago

Group Abstract Group Abstract