5
$\begingroup$

Here is the problem:

I create a coordinate list as follows:

DegreeP = 5;
lst = DeleteDuplicates@
       Select[Flatten[
        Table[Permutations[{a, b}], {a, 0, DegreeP}, {b, 0, DegreeP}],
              2], #[[1]] + #[[2]] <=DegreeP &];

By assigning the index of each coordinate, I can represent the order as a listplot

ListPlot[{lst, lst},
Joined -> {True, False}, PlotStyle -> {Orange, Black}, 
ImageSize -> Medium, PlotRangeClipping -> False, ImagePadding -> 20,
Epilog -> (n = 1; Text[Style[n++, 11], #, {-1, -1}] & /@ lst)]

enter image description here

The real order (solution) in which the coordinates should be found, however, is as follows

sol = {{0, 0}, {0, 1}, {1, 0}, {0, 2}, {2, 0}, {1, 1}, {0, 3}, {3, 0}, {1, 2}, {2, 1}, {0, 4}, 
      {4, 0}, {2, 2}, {1, 3}, {3, 1}, {0, 5}, {5, 0}, {2, 3}, {3, 2}, {1, 4}, {4, 1}};

As a ListPlot

ListPlot[{sol, sol},
Joined -> {True, False}, PlotStyle -> {Orange, Black}, 
ImageSize -> Medium, PlotRangeClipping -> False, ImagePadding -> 20,
Epilog -> (n = 1; Text[Style[n++, 11], #, {-1, -1}] & /@ sol)]

enter image description here

I would like to find a way to sort my lst to get the same order as sol

For that, I tried with SortBy[] but I am unable to find the right pattern...

Any idea ?

*** UPDATE AFTER @kglr ANSWER***

DegreeP = 9;
lst = Join @@ Map[SortBy[{-Norm@# &}]@FrobeniusSolve[{1, 1}, #] &]@ Range[0, DegreeP];

ListPlot[{lst, lst}, Joined -> {True, False}, 
PlotStyle -> {Orange, Black}, ImageSize -> 600, 
PlotRangeClipping -> False, ImagePadding -> 20, 
Epilog -> (n = 1; Text[Style[n++, 11], #, {-1, -1}] & /@ lst)]

Let's print the result for DegreeP={8,9,10}, it seems that there is a "jump" in the pattern for DegreeP = 9. This case does not seem to occur anymore for 20>DegreeP>1.

Note :

  • I am only interested in DegreeP<20
  • I cannot manually change the position of the elements

DegreeP = 8

enter image description here

DegreeP = 9

enter image description here

DegreeP = 10

enter image description here

$\endgroup$

2 Answers 2

4
$\begingroup$

Update:

ClearAll[f, shuffle]
shuffle = If[Length @ # <= 2, #, 
    Join[#[[{1, -1}]], 
      Take[Riffle[#, Reverse @ #], Length @ #] & @ Delete[#, {{1}, {-1}, {-2}}], 
      {#[[-2]]}]] &;

f[dp_] := Join @@ Map[shuffle @ FrobeniusSolve[{1, 1}, #] &] @ Range[0, dp];

Examples:

degreeP = 5;

ListPlot[{f[degreeP], f[degreeP]}, Joined -> {True, False}, 
 PlotStyle -> {Orange, Black}, ImageSize -> 600, 
 PlotRangeClipping -> False, ImagePadding -> 20, 
 Epilog -> MapIndexed[Text[Style[#2[[1]], 11], #, {-1, -1}]&, f[degreeP]]]

enter image description here

With degreeP = 7 we get

enter image description here

and degreeP = 9 gives

enter image description here

and degreeP = 20 gives

enter image description here

Original answer:

degreeP = 5;

sol2 = Join @@ Map[SortBy[{- Norm @ # &}] @ 
   FrobeniusSolve[{1, 1}, #] &] @ Range[0, degreeP];

sol2 == sol
True
ListPlot[{sol2, sol2}, Joined -> {True, False}, 
 PlotStyle -> {Orange, Black}, ImageSize -> Medium, 
 PlotRangeClipping -> False, ImagePadding -> 20, 
 Epilog -> MapIndexed[Text[Style[#2[[1]], 11], #, {-1, -1}] &, sol2]]

enter image description here

With degreeP = 7 we get

enter image description here

$\endgroup$
5
  • $\begingroup$ Thanks for your answer, it works well for several DegreeP but there seems to be a problem with the patern for DegreeP = 7. It's a bit out of the scope of my question but do you think we could generalize that for DegreeP = N $\endgroup$ Commented Mar 3, 2022 at 12:31
  • $\begingroup$ @JocelynMinini, not sure what the correct ordering would be in general. Please try the new version. $\endgroup$
    – kglr
    Commented Mar 3, 2022 at 12:49
  • $\begingroup$ I have updated the question I hope it is more clear $\endgroup$ Commented Mar 3, 2022 at 13:37
  • $\begingroup$ @JocelynMinini, please see the update. $\endgroup$
    – kglr
    Commented Mar 3, 2022 at 14:33
  • $\begingroup$ It works perfectly. Elegant solution by the way $\endgroup$ Commented Mar 3, 2022 at 14:56
5
$\begingroup$
sol = SortBy[lst, {(First@# + Last@#) &, Norm}]

The above solution was me looking at the display pattern you added to your post.


A little bit more MMA-esque:

sol = SortBy[lst, {Total@# &, Norm}]

and then realizing that Norm has an additional parameter:

sol = SortBy[lst, {Norm[#, 1] &, Norm[#, 2] &}]

OK done.

$\endgroup$

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.