7
$\begingroup$

I am wondering how to do in Mathematica the following:

Given as an input a large array, I want to output a list of top $n$ entries with largest absolute value + their location within the array.

To give a very simple explicit example, let us take

size = 3;
top = 5;
SeedRandom[1234];
H = RandomVariate[NormalDistribution[], {size, size, size}] + 
   I*RandomVariate[NormalDistribution[], {size, size, size}];
H // MatrixForm
Abs[H] // MatrixForm

This produces array elements as follows:

enter image description here

And these correspond to the following absolute values:

enter image description here

So as an output I would like to get a list as follows

{
{2.67802 + 1.28002 I,{1,2,2}},
{-2.16128 + 0.250312 I,{3,2,1}},
{-0.907637 + 1.71577 I,{3,3,1}},
{-1.31683 - 1.21146 I,{1,2,3}},
{1.53659 + 0.686038 I,{1,2,1}}
}

i.e. first the array element (which has very large absolute value), followed by a coordinate of that array element.

Any ideas how to do this with a concise piece of code?

$\endgroup$
8
$\begingroup$

You could use SparseArray to do this:

sa = SparseArray[H];
With[{ord = Reverse @ Ordering[Abs @ sa["NonzeroValues"], -5]},
    Thread[{
        sa["NonzeroValues"][[ord]],
        sa["NonzeroPositions"][[ord]]
    }]
]

{{2.67802 + 1.28002 I, {1, 2, 2}}, {-2.16128 + 0.250312 I, {3, 2, 1}}, {-0.907637 + 1.71577 I, {3, 3, 1}}, {-1.31683 - 1.21146 I, {1, 2, 3}}, {1.53659 + 0.686038 I, {1, 2, 1}}}

| improve this answer | |
$\endgroup$
  • 1
    $\begingroup$ I guess it assumes H won't have any zero values. --- I guess you could use a nonnumeric default SparseArray[H, Automatic, "NaN"] to take care of the zero case. $\endgroup$ – Michael E2 Dec 17 '19 at 19:51
  • $\begingroup$ Works like a charm. Thank you! $\endgroup$ – Tomas Bzdusek Dec 17 '19 at 22:46
5
$\begingroup$

Let h be the OP's H, to avoid single capital letters:

ClearAll[next, arrayPos];
next[{{q_, r_}, d_}] := {QuotientRemainder[r, Times @@ Rest[d]], Rest[d]};
arrayPos[dims_][idx_] := 
  NestList[step, {{0, idx - 1}, dims}, Length[dims]][[2 ;;, 1, 1]] + 1;

arrayPos[Dimensions@h] /@
   Reverse@OrderingBy[Flatten@h, Abs, -5] //
 Transpose[{Extract[h, #], #}] &
(*
{{2.67802 + 1.28002 I, {1, 2, 2}},
 {-2.16128 + 0.250312 I, {3, 2, 1}},
 {-0.907637 + 1.71577 I, {3, 3, 1}},
 {-1.31683 - 1.21146 I, {1, 2, 3}},
 {1.53659 + 0.686038 I, {1, 2, 1}}}
*)
| improve this answer | |
$\endgroup$
5
$\begingroup$

This is shorter and maybe a bit faster than SparseArray:

Ordering[- Flatten @ Abs @ H, top] //
  Tuples[Range @ Dimensions @ H][[#]] & //
  Thread[{Extract[H, #], #}] &
{
 {2.67802 + 1.28002 I, {1, 2, 2}},
 {-2.16128 + 0.250312 I, {3, 2, 1}},
 {-0.907637 + 1.71577 I, {3, 3, 1}},
 {-1.31683 - 1.21146 I, {1, 2, 3}},
 {1.53659 + 0.686038 I, {1, 2, 1}}
}
| improve this answer | |
$\endgroup$
2
$\begingroup$

Using a similar trick for getting a list of item-position pairs as @Mr.Wizard, here's a version where you first convert your entire array into the same format as you want your output to be (relying on the fact that Tuples gives you the indices in the same order as Flatten will leave them) and then use MaximalBy with your comparison function (Abs on the first element of that pair):

MaximalBy[
  Thread[{Flatten[H], Tuples[Range[Dimensions[H]]]}],
  Abs @* First,
  top
]

I'm using Composition (@*) in the function but eg Abs[First[#]]& would be equivalent.

| improve this answer | |
$\endgroup$

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

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