Revisions to Find position without iterating

Notice removed Authoritative reference needed by Hubble07

occurred Jan 7, 2019 at 2:30

Bounty Ended with MikeY's answer chosen by Hubble07

occurred Jan 7, 2019 at 2:30

edited tags

Link

edited Jan 7, 2019 at 1:23

MikeY

7.2k
18
27

Changed the sorting function used

Source Link

edited Jan 6, 2019 at 3:09

Hubble07

3.6k
14
23

Edit 2

New Sorting

I have now realised that the sorting I used was not ideal. So I have changed it slightly.

sol[Nm_ sol2[Nm_, Mm_] :=
 SortBy[{m1, m2, m3, 
 m4} /. (Solve[
 m1 + m2 + m3 + m4 == Mm && 
  Abs[m1] + Abs[m2] + Abs[m3] + Abs[m4] == Nm, {m1, m2, m3, m4}, 
 Integers]), {Count[#, _?Negative] &,Select[#, NonNegative] &,Negative}]

For e.g.So now with this sorting a few example solutions are as follows:

  sol[1sol2[1, -1]
 (*{{0, 0, 0, -1}, {0, 0, -1, 0}, {0, -1, 0, 0}, {-1, 0, 0, 0}}*)

  
 sol[3sol2[3,-1]
 (*{{0, 0, 1, -2}, {0, 1, 0, -2}, {1}, {0, -2, 0, -21}, {0-2, 0, -20, 1}, {0, 1, -20, 0-2}, {10, 01, -2, 0}, {0, 1-2, -1, -10}, {1-2, 0, -1, -10}, {01, -20, 0,1 -2}, {1, 0, -2, 1, 0}, {1, -2, 0, 0}, {0-2, -1, 10, -10}, {10, -1, 0-1, -1}, {0, -1, -1, -1}, {10, -1, -1, 01}, {-21, 0, 01, -1}, {-21, 0, -1, 01}, {-21, -1, 0, 01}, {-1, 0, -1, -1}, {-1, -1, 0, -1}, {-1, 0-1, -1, 10}, {-1, 1, -10, 0-1}, {-1, -1, 0-1, 10}, {-1, -1, 1, 0}}*)

  sol[3sol2[3,1]
(*{{0, 0, 2, -1}, {0, 10, -1, -12}, {0, 2-1, 0, -12}, {-1, 0, 10, -12}, {10, 1, 01, -1}, {2, 0, 01, -1, 1}, {0, 0-1, -1, 21}, {-1, 0, 1, -1}, {0, 2, 0, -1}, {0, 2, -1, 0}, {1, 0, -1, 12, 0}, {-1, 10, -12, 0}, {21, 0, -1, 0-1}, {1, 0, -1, 0, 21}, {01, -1, 10, 1}, {0, -1, 21, 0, 1}, {1, -1, 0, -1}, {1, -1, -1, 0}, {21, -1, 01, 0}, {-1, 01, 01, 20}, {-12, 0, 10, -1}, {-1, 0, 2, 0}, {-1,1, 0, 1}, {-12, -1, 10, 0}, {-1, 2, 0, 0}}*)

 sol[2sol2[2,2]
 (*{{0, 0, 0, 2}, {0, 0, 1, 1}, {0, 0, 2, 0}, {0, 1, 0, 1}, {0, 1, 1, 0}, {0, 2, 0, 0}, {1, 0, 0, 1}, {1, 0, 1, 0}, {1, 1, 0, 0}, {2, 0, 0, 0}}*)

 sol[2sol2[2,-2]
(*{{0, 0, 0, -2}, {0, 0, -2, 0}, {0, 0, -12, -1}0, {0}, {-2, 0, 0, 0}, {0, -10, 0-1, -1}, {0, -1, -10, 0-1}, {-20, 0-1, 0-1, 0}, {-1, 0, 0, -1}, {-1, 0, -1, 0}, {-1, -1, 0, 0}})*)

 sol[3sol2[3,-3]
(*{{0, 0, 0, -3}, {0, 0, -3, 0}, {0, -3, 0, -20}, {-13, 0, 0, 0}, {0, 0, -12, -21}, {0, -3,0, 0-1, -2}, {0, -2, 0, -1}, {0, -1, 0, -2}, {0, -2, -1, 0}, {0, -1, -2, 0}, {0-2, -10, -10, -1}, {-31, 0, 0, 0-2}, {-2, 0, 0, -1, 0}, {-1, 0, 0, -2, 0}, {-2, 0, -1, 0, 0}, {-1, 0, -2, 0}, {-10}, {0, -1, -1}, {-21}, {-1, 0, 0}, {-1, -2, 0, 01}, {-1, -1, 0, -1}, {-1, -1, -1, 0}}*)

Original Sorting

sol[Nm_, Mm_] :=
 SortBy[{m1, m2, m3, 
 m4} /. (Solve[
 m1 + m2 + m3 + m4 == Mm && 
  Abs[m1] + Abs[m2] + Abs[m3] + Abs[m4] == Nm, {m1, m2, m3, m4}, 
 Integers]), Negative]

Based on the original sorting used in sol

findPosition[{0, 0, -1, 0}] = 2
findPosition[{0, 0, 1, 1}] = 2  (* see sol[2,2]*)
findPosition[{-10, 0, -1, 0-1}] = 93 (* see sol[2,-2]*)
findPosition[{0, 0, -2, -1}] = 3  (* see sol[3,-3]*)

Based on the new sorting in sol2

findPosition[{0, 0, -1, 0}] = 2
findPosition[{0, 0, 1, 1}] = 2  (* see sol2[2,2]*)
findPosition[{0, 0, -1, -1}] = 5 (* see sol2[2,-2]*)
findPosition[{0, 0, -2, -1}] = 5  (* see sol2[3,-3]*)

  solf[Nm_, Mm_] := 
  SortBy[Partition[
  Flatten[Permutations /@ 
  Select[IntegerPartitions[Mm, {4}, 
   Range[-Nm - 1, 
    Nm + 1]], (Abs[#[[1]]] + Abs[#[[2]]] + Abs[#[[3]]] + 
      Abs[#[[4]]] == Nm) &]], 4], {Count[#, _?Negative] &, Select[#, NonNegative] &, Negative}]


 findPosition[mlist_] := 
 Position[solf[
 Abs[mlist[[1]]] + Abs[mlist[[2]]] + Abs[mlist[[3]]] + 
 Abs[mlist[[4]]], Total[mlist]], mlist];

 findPosition[{-1, 0, -1, 1}] // AbsoluteTiming
 (*{0.000282, {{2117}}} *)

sol[Nm_, Mm_] :=
 SortBy[{m1, m2, m3, 
 m4} /. (Solve[
 m1 + m2 + m3 + m4 == Mm && 
  Abs[m1] + Abs[m2] + Abs[m3] + Abs[m4] == Nm, {m1, m2, m3, m4}, 
 Integers]), Negative]

For e.g.

  sol[1, -1]
 (*{{0, 0, 0, -1}, {0, 0, -1, 0}, {0, -1, 0, 0}, {-1, 0, 0, 0}}*)

  sol[3,-1]
 (*{{0, 0, 1, -2}, {0, 1, 0, -2}, {1, 0, 0, -2}, {0, 0, -2, 1}, {0, 1, -2, 0}, {1, 0, -2, 0}, {0, 1, -1, -1}, {1, 0, -1, -1}, {0, -2, 0,1}, {0, -2, 1, 0}, {1, -2, 0, 0}, {0, -1, 1, -1}, {1, -1, 0, -1}, {0, -1, -1, 1}, {1, -1, -1, 0}, {-2, 0, 0, 1}, {-2, 0, 1, 0}, {-2, 1, 0, 0}, {-1, 0, 1, -1}, {-1, 1, 0, -1}, {-1, 0, -1, 1}, {-1, 1, -1, 0}, {-1, -1, 0, 1}, {-1, -1, 1, 0}}*)

  sol[3,1]
(*{{0, 0, 2, -1}, {0, 1, 1, -1}, {0, 2, 0, -1}, {1, 0, 1, -1}, {1, 1, 0, -1}, {2, 0, 0, -1}, {0, 0, -1, 2}, {0, 1, -1, 1}, {0, 2, -1, 0}, {1, 0, -1, 1}, {1, 1, -1, 0}, {2, 0, -1, 0}, {0, -1, 0, 2}, {0, -1, 1, 1}, {0, -1, 2, 0}, {1, -1, 0, 1}, {1, -1, 1, 0}, {2, -1, 0, 0}, {-1, 0, 0, 2}, {-1, 0, 1, 1}, {-1, 0, 2, 0}, {-1,1, 0, 1}, {-1, 1, 1, 0}, {-1, 2, 0, 0}}*)

 sol[2,2]
 (*{{0, 0, 0, 2}, {0, 0, 1, 1}, {0, 0, 2, 0}, {0, 1, 0, 1}, {0, 1, 1, 0}, {0, 2, 0, 0}, {1, 0, 0, 1}, {1, 0, 1, 0}, {1, 1, 0, 0}, {2, 0, 0, 0}}*)

 sol[2,-2]
(*{{0, 0, 0, -2}, {0, 0, -2, 0}, {0, 0, -1, -1}, {0, -2, 0, 0}, {0, -1, 0, -1}, {0, -1, -1, 0}, {-2, 0, 0, 0}, {-1, 0, 0, -1}, {-1, 0, -1, 0}, {-1, -1, 0, 0}})*)

 sol[3,-3]
(*{{0, 0, 0, -3}, {0, 0, -3, 0}, {0, 0, -2, -1}, {0, 0, -1, -2}, {0, -3,0, 0}, {0, -2, 0, -1}, {0, -1, 0, -2}, {0, -2, -1, 0}, {0, -1, -2, 0}, {0, -1, -1, -1}, {-3, 0, 0, 0}, {-2, 0, 0, -1}, {-1, 0, 0, -2}, {-2, 0, -1, 0}, {-1, 0, -2, 0}, {-1, 0, -1, -1}, {-2, -1, 0, 0}, {-1, -2, 0, 0}, {-1, -1, 0, -1}, {-1, -1, -1, 0}}*)

findPosition[{0, 0, -1, 0}] = 2
findPosition[{0, 0, 1, 1}] = 2  (* see sol[2,2]*)
findPosition[{-1, 0, -1, 0}] = 9 (* see sol[2,-2]*)
findPosition[{0, 0, -2, -1}] = 3  (* see sol[3,-3]*)

  solf[Nm_, Mm_] := 
  SortBy[Partition[
  Flatten[Permutations /@ 
  Select[IntegerPartitions[Mm, {4}, 
   Range[-Nm - 1, 
    Nm + 1]], (Abs[#[[1]]] + Abs[#[[2]]] + Abs[#[[3]]] + 
      Abs[#[[4]]] == Nm) &]], 4], Negative]


 findPosition[mlist_] := 
 Position[solf[
 Abs[mlist[[1]]] + Abs[mlist[[2]]] + Abs[mlist[[3]]] + 
 Abs[mlist[[4]]], Total[mlist]], mlist];

 findPosition[{-1, 0, -1, 1}] // AbsoluteTiming
 (*{0.000282, {{21}}} *)

Edit 2

New Sorting

I have now realised that the sorting I used was not ideal. So I have changed it slightly.

 sol2[Nm_, Mm_] :=
 SortBy[{m1, m2, m3, 
 m4} /. (Solve[
 m1 + m2 + m3 + m4 == Mm && 
  Abs[m1] + Abs[m2] + Abs[m3] + Abs[m4] == Nm, {m1, m2, m3, m4}, 
 Integers]), {Count[#, _?Negative] &,Select[#, NonNegative] &,Negative}]

So now with this sorting a few example solutions are as follows:

 sol2[1, -1]
 (*{{0, 0, 0, -1}, {0, 0, -1, 0}, {0, -1, 0, 0}, {-1, 0, 0, 0}}*)

 
 sol2[3,-1]
 (*{{0, 0, 1, -2}, {0, 0, -2, 1}, {0, -2, 0, 1}, {-2, 0, 0, 1}, {0, 1, 0, -2}, {0, 1, -2, 0}, {0, -2, 1, 0}, {-2, 0, 1, 0}, {1, 0, 0, -2}, {1, 0, -2, 0}, {1, -2, 0, 0}, {-2, 1, 0, 0}, {0, 1, -1, -1}, {0, -1, 1, -1}, {0, -1, -1, 1}, {-1, 0, 1, -1}, {-1, 0, -1, 1}, {-1, -1, 0, 1}, {1, 0, -1, -1}, {1, -1, 0, -1}, {1, -1, -1, 0}, {-1, 1, 0, -1}, {-1, 1, -1, 0}, {-1, -1, 1, 0}}*)

  sol2[3,1]
(*{{0, 0, 2, -1}, {0, 0, -1, 2}, {0, -1, 0, 2}, {-1, 0, 0, 2}, {0, 1, 1, -1}, {0, 1, -1, 1}, {0, -1, 1, 1}, {-1, 0, 1, 1}, {0, 2, 0, -1}, {0, 2, -1, 0}, {0, -1, 2, 0}, {-1, 0, 2, 0}, {1, 0, 1, -1}, {1, 0, -1, 1}, {1, -1, 0, 1}, {-1, 1, 0, 1}, {1, 1, 0, -1}, {1, 1, -1, 0}, {1, -1, 1, 0}, {-1, 1, 1, 0}, {2, 0, 0, -1}, {2, 0, -1, 0}, {2, -1, 0, 0}, {-1, 2, 0, 0}}*)

 sol2[2,2]
 (*{{0, 0, 0, 2}, {0, 0, 1, 1}, {0, 0, 2, 0}, {0, 1, 0, 1}, {0, 1, 1, 0}, {0, 2, 0, 0}, {1, 0, 0, 1}, {1, 0, 1, 0}, {1, 1, 0, 0}, {2, 0, 0, 0}}*)

 sol2[2,-2]
(*{{0, 0, 0, -2}, {0, 0, -2, 0}, {0, -2, 0, 0}, {-2, 0, 0, 0}, {0, 0, -1, -1}, {0, -1, 0, -1}, {0, -1, -1, 0}, {-1, 0, 0, -1}, {-1, 0, -1, 0}, {-1, -1, 0, 0}}*)

 sol2[3,-3]
(*{{0, 0, 0, -3}, {0, 0, -3, 0}, {0, -3, 0, 0}, {-3, 0, 0, 0}, {0, 0, -2, -1}, {0, 0, -1, -2}, {0, -2, 0, -1}, {0, -1, 0, -2}, {0, -2, -1, 0}, {0, -1, -2, 0}, {-2, 0, 0, -1}, {-1, 0, 0, -2}, {-2, 0, -1, 0}, {-1, 0, -2, 0}, {-2, -1, 0, 0}, {-1, -2, 0, 0}, {0, -1, -1, -1}, {-1, 0, -1, -1}, {-1, -1, 0, -1}, {-1, -1, -1, 0}}*)

Original Sorting

sol[Nm_, Mm_] :=
 SortBy[{m1, m2, m3, 
 m4} /. (Solve[
 m1 + m2 + m3 + m4 == Mm && 
  Abs[m1] + Abs[m2] + Abs[m3] + Abs[m4] == Nm, {m1, m2, m3, m4}, 
 Integers]), Negative]

Based on the original sorting used in sol

findPosition[{0, 0, -1, 0}] = 2
findPosition[{0, 0, 1, 1}] = 2  (* see sol[2,2]*)
findPosition[{0, 0, -1, -1}] = 3 (* see sol[2,-2]*)
findPosition[{0, 0, -2, -1}] = 3  (* see sol[3,-3]*)

Based on the new sorting in sol2

findPosition[{0, 0, -1, 0}] = 2
findPosition[{0, 0, 1, 1}] = 2  (* see sol2[2,2]*)
findPosition[{0, 0, -1, -1}] = 5 (* see sol2[2,-2]*)
findPosition[{0, 0, -2, -1}] = 5  (* see sol2[3,-3]*)

  solf[Nm_, Mm_] := 
  SortBy[Partition[
  Flatten[Permutations /@ 
  Select[IntegerPartitions[Mm, {4}, 
   Range[-Nm - 1, 
    Nm + 1]], (Abs[#[[1]]] + Abs[#[[2]]] + Abs[#[[3]]] + 
      Abs[#[[4]]] == Nm) &]], 4], {Count[#, _?Negative] &, Select[#, NonNegative] &, Negative}]


 findPosition[mlist_] := 
 Position[solf[
 Abs[mlist[[1]]] + Abs[mlist[[2]]] + Abs[mlist[[3]]] + 
 Abs[mlist[[4]]], Total[mlist]], mlist];

 findPosition[{-1, 0, -1, 1}] // AbsoluteTiming
 (*{0.000282, {{17}}} *)

added 715 characters in body

Source Link

edited Jan 3, 2019 at 6:47

Hubble07

3.6k
14
23

Edit 1

Also I'm looking for an answer that should be somewhat faster than the trivial approach shown below where you simply scan over all the results and find the match.

  solf[Nm_, Mm_] := 
  SortBy[Partition[
  Flatten[Permutations /@ 
  Select[IntegerPartitions[Mm, {4}, 
   Range[-Nm - 1, 
    Nm + 1]], (Abs[#[[1]]] + Abs[#[[2]]] + Abs[#[[3]]] + 
      Abs[#[[4]]] == Nm) &]], 4], Negative]


 findPosition[mlist_] := 
 Position[solf[
 Abs[mlist[[1]]] + Abs[mlist[[2]]] + Abs[mlist[[3]]] + 
 Abs[mlist[[4]]], Total[mlist]], mlist];

 findPosition[{-1, 0, -1, 1}] // AbsoluteTiming
 (*{0.000282, {{21}}} *)

Edit 1

Also I'm looking for an answer that should be somewhat faster than the trivial approach shown below where you simply scan over all the results and find the match.

  solf[Nm_, Mm_] := 
  SortBy[Partition[
  Flatten[Permutations /@ 
  Select[IntegerPartitions[Mm, {4}, 
   Range[-Nm - 1, 
    Nm + 1]], (Abs[#[[1]]] + Abs[#[[2]]] + Abs[#[[3]]] + 
      Abs[#[[4]]] == Nm) &]], 4], Negative]


 findPosition[mlist_] := 
 Position[solf[
 Abs[mlist[[1]]] + Abs[mlist[[2]]] + Abs[mlist[[3]]] + 
 Abs[mlist[[4]]], Total[mlist]], mlist];

 findPosition[{-1, 0, -1, 1}] // AbsoluteTiming
 (*{0.000282, {{21}}} *)

added 1487 characters in body

Source Link

edited Jan 1, 2019 at 18:40

Hubble07

3.6k
14
23

Loading

Notice added Authoritative reference needed by Hubble07

occurred Jan 1, 2019 at 10:37

Bounty Started worth 100 reputation by Hubble07

occurred Jan 1, 2019 at 10:37

Tweeted twitter.com/StackMma/status/1078984086230876160

occurred Dec 29, 2018 at 12:00

Source Link

asked Dec 28, 2018 at 13:28

Hubble07

3.6k
14
23

Loading

Stack Exchange Network

Return to Question

Edit 2

New Sorting

Original Sorting

Edit 2

New Sorting

Original Sorting

Edit 1

Edit 1