7
$\begingroup$

I have this problem: consider all the square numbers with exactly n digits, I want to arrange them such that the last digit of a square is equal to first digit of the next square and find the longest arrangement, how many elements contain and possibly how many of those longest arrangement are possible. Of course some squares will be sorted out, eg.

For n=2 the squares are {16, 25, 36, 49, 64, 81}. So the longest arrangement is {81, 16, 64, 49} with s=4 elements

For n=3 there are s=12 elements and one of the possible arrangements is

{841, 121, 144, 484, 441, 169, 961, 196, 676, 625, 529, 900}

Of course there are some criteria (at most 1 number can start with {2,3,7,8} and if so, must be in the 1st position; at most 1 with 0 as last digit)

I have found something similar here https://www.geeksforgeeks.org/arrange-array-elements-such-that-last-digit-of-an-element-is-equal-to-first-digit-of-the-next-element/ but if I insert multiple numbers with same first and last digit it gives me an error.

Maybe would be easier to construct a number like this: naming the squares with n digits {a₁, a₂, a₃,..., aₖ} (values of k for each n https://oeis.org/A049415)

P = aₕ+aᵢ10ⁿ+aⱼ10²ⁿ+...+ aₘ*10⁽ˢ⁻¹⁾ⁿ

h, I, j,...,m < k

and find the biggest possible number P, but I don't know how to set it up

$\endgroup$
4
  • $\begingroup$ Of course there are some criteria (no number starting with {2,3,7,8}; at most 1 with 0 as last digit) <-- why did you use the term "Of course"? $\endgroup$
    – imida k
    Mar 12, 2022 at 7:36
  • $\begingroup$ The condition you added(no number starting with {2,3,7,8}; at most 1 with 0 as last digit) does not seem so natural. Is there a special purpose for adding that condition ? $\endgroup$
    – imida k
    Mar 12, 2022 at 7:38
  • $\begingroup$ The last digit of every square number is {0,1,4,5,6,9} (math.stackexchange.com/questions/2795029/…), so no square with first digit {2,3,7,8} can appear in the arrangement if not in the first position (you can see the example with n= 3), so more precisely at most one number starting with {2,3,7,8} can appear in the arrangement and just in the first position. If you put a square with 0 as last digit you can't add others because the next one will not start with 0 $\endgroup$
    – user967210
    Mar 12, 2022 at 7:49
  • $\begingroup$ You have a lots of 11, b lots of 12, c lots of 21, d lots of 22. With these a+b+c+d numbers, by gluing some of them linearly, you are planning to make longest number. I think expressing the answer of this simplified problem in a,b,c,d can be a starting point. $\endgroup$
    – imida k
    Mar 12, 2022 at 8:23

2 Answers 2

7
$\begingroup$

Define a function to give the n digit squares

range[n_] := Range[Ceiling[Sqrt[10^(n - 1)]], Floor[Sqrt[10^n - 1]]]^2
range[3]
(* {100, 121, 144, 169, 196, 225, 256, 289, 324, 361, 400, 441, 484, \
529, 576, 625, 676, 729, 784, 841, 900, 961} *)

Define a function testing their adjacency

adjacent[x_, y_] := 
 Boole[Last[IntegerDigits[x]] == First[IntegerDigits[y]]]
{adjacent[10, 17], adjacent[12, 25], adjacent[25, 12]}
(* {0, 1, 0} *)

and create the adjacency matrix

adjacency[n_] := Outer[adjacent, #, #]&@range[n]

Use Mathematica's graph type

graph[n_] := 
 AdjacencyGraph[range[n], adjacency[n], VertexLabels -> Automatic]

graph[2]

enter image description here

Define a function to find all the paths between two end points

paths[{x_, y_}, g_Graph] := FindPath[g, x, y, Infinity, All]
paths[{324, 100}, graph[3]]
(* {{324, 441, 100}, {324, 484, 441, 100}, {324, 441, 121, 100}, {324, 
  484, 441, 121, 100}, {324, 441, 169, 961, 100}, {324, 484, 441, 169,
   961, 100}, {324, 441, 169, 961, 121, 100}, {324, 441, 121, 169, 
  961, 100}, {324, 484, 441, 169, 961, 121, 100}, {324, 484, 441, 121,
   169, 961, 100}, {324, 441, 196, 625, 529, 961, 100}, {324, 484, 
  441, 196, 625, 529, 961, 100}, {324, 441, 196, 676, 625, 529, 961, 
  100}, {324, 441, 196, 625, 529, 961, 121, 100}, {324, 441, 121, 196,
   625, 529, 961, 100}, {324, 484, 441, 196, 676, 625, 529, 961, 
  100}, {324, 484, 441, 196, 625, 529, 961, 121, 100}, {324, 484, 441,
   121, 196, 625, 529, 961, 100}, {324, 441, 196, 676, 625, 529, 961, 
  121, 100}, {324, 441, 121, 196, 676, 625, 529, 961, 100}, {324, 484,
   441, 196, 676, 625, 529, 961, 121, 100}, {324, 484, 441, 121, 196, 
  676, 625, 529, 961, 100}} *)

Define a helper function to extract the longest list from a list of lists

longest[u_List] := Module[{max = Max[Length /@ u]},
  SelectFirst[u, Length[#] == max &]]
longest[paths[{324, 100}, graph[3]]]
(* {324, 484, 441, 196, 676, 625, 529, 961, 121, 100} *)

Brute force search, trying every combination

globallongest[n_] := Module[{g = graph[n], r = range[n]},
  longest[Flatten[Outer[paths[{#1, #2}, g] &, r, r], 2]]]

We can easily see that this is the right answer for 2 digit squares

globallongest[2]
(* {81, 16, 64, 49} *)

As predicted the longest path for 3 digit squares has length 12

globallongest[3]
(* {225, 576, 676, 625, 529, 961, 144, 484, 441, 121, 169, 900} *)

Length[globallongest[3]]
(* 12 *)

For 4 digit squares, things slow down

globallongest[4]
(* Still not finished ... *)

I suspect that there is a better way to find the longest path than looking for all of them, but I'm not a graph theorist.

$\endgroup$
6
  • $\begingroup$ You have pasted 22 paths for n=3. Should be 26. $\endgroup$
    – Edmund
    Mar 12, 2022 at 18:48
  • $\begingroup$ @Edmund I don't think so. My solution doesn't count the number of paths, simply finds one of the longest candidates. (Perhaps you are mistaking where I show the all the paths from 324 to 100) $\endgroup$
    – mikado
    Mar 12, 2022 at 22:04
  • $\begingroup$ Thank you! How much time it took to calculate globallongest[4]? $\endgroup$
    – user967210
    Mar 13, 2022 at 9:49
  • $\begingroup$ It hadn't completed after a few hours and I needed to shut down. $\endgroup$
    – mikado
    Mar 13, 2022 at 10:34
  • $\begingroup$ Well I guess that for n=4 the length is 30, but I wanted to find out for sure. Of course I would like to generalize for every n, and I'm just trying to know the first few values, because maybe there is a pattern I'm not understanding right now. Thanks allot for your help! $\endgroup$
    – user967210
    Mar 13, 2022 at 12:31
4
$\begingroup$

Another Graph approach but by constructing a cyclic directed graph and then using brute force by FindPath.

Using mikado squares function.

f[n_Integer?Positive] := Range[Ceiling[Sqrt[10^(n - 1)]], Floor[Sqrt[10^n - 1]]]^2

gives

vals = f[3]
{100, 121, 144, 169, 196, 225, 256, 289, 324, 361, 400, 441, 484,
 529, 576, 625, 676, 729, 784, 841, 900, 961}

A cyclic directed graph from last digit to first digit can be created by

intFirstLastGraph[nums_] :=
 Module[
  {digits = IntegerDigits[nums][[All, {1, -1}]]}
  , DeleteCases[a_ \[DirectedEdge] a_]@
   Flatten@
    MapIndexed[
     Thread[
       First@#2 \[DirectedEdge] 
        Flatten@Position[digits, {Last@#, _}]] &
     , digits
     ]
  ]

giving

Graph[g = intFirstLastGraph[vals]
 , VertexLabels -> Automatic
 , GraphLayout -> "CircularEmbedding"
 ]

Mathematica graphics

Using FindPath and MaximalBy the longest paths can be extracted by brute force.

longestPathDCG[g_] :=
 Module[
  {vl = VertexList[g], paths}
  , paths = 
   Function[i, Flatten[FindPath[g, i, #, Infinity, All] & /@ vl, 1]] /@
     vl
  ; MaximalBy[Flatten[paths, 1], Length]
  ]

giving

longest = vals[[#]] & /@ longestPathDCG[g]

Mathematica graphics

which gives 26 paths of length 12

{Length@longest, DeleteDuplicates[Length /@ longest]}
{26, {12}}

Hope this helps.

$\endgroup$
4
  • $\begingroup$ Thank you! I'm just trying to use your approach, but for some reason the function intFistLastGraph gives me no result. I wonder why, I just pasted it $\endgroup$
    – user967210
    Mar 12, 2022 at 22:14
  • $\begingroup$ @user967210 Typo is fixed. Try now. $\endgroup$
    – Edmund
    Mar 12, 2022 at 22:19
  • $\begingroup$ Thank you! I'm trying to find the values of the length for f[4] and f[5]: the first one I speculate is 30, but I see I need alot of time to calculate. Is there a fastest way just to know the the length of the longest arrangement? $\endgroup$
    – user967210
    Mar 13, 2022 at 9:47
  • $\begingroup$ @user967210 I tried a ParallelMap approach on "FinestGrained" for f[4] but stopped it after two hours when not even one of the kernels returned with thier first result. You get a couple hundred million paths with path length set at 4; ran for a while and consumed my laptop's 128GB ram in the process with Intel Xeon 6 core CPU. I don't think brute force is viable unless you have access to a farm. Well, could look at some comple options. $\endgroup$
    – Edmund
    Mar 13, 2022 at 13:40

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.