Why is there no PositionFunction in Mathematica?
I see no mention of the new-in-10 PositionIndex
in the other answers, which takes a list (or association) of values and returns a 'reverse lookup' that maps from values in the list to the positions where they occur:
In[1]:= index = PositionIndex[{a, b, c, a, c, a}]
Out[1]= <|a -> {1, 4, 6}, b -> {2}, c -> {3, 5}|>
It doesn't take a level spec yet (though I do want to add that).
In any case, the returned association is already a function in some sense because of the function application way of doing key lookup in associations.
So in the above example you could write index[a]
to get a list of places where a
occurred.
This is perhaps a place to start:
position[expr_, level_: 1] :=
With[{positionData =
SortBy[
#[[1, 1]] -> #[[All, 2]] & /@
GatherBy[Extract[expr, #, Verbatim] -> # & /@ Position[expr, _, level], First],
Min[Length /@ #[[2]]] &
] // Dispatch},
Replace[#, positionData] &
]
The second argument controls the depth of the indexing. An example:
f = position[x^2 + y^2 + q_^r_, 3];
f[2]
{{1, 2}, {2, 2}}
Due to the use of Verbatim
patterns are matched literally, which deviates from normal Position
behavior:
f[_]
{{3, 1, 2}, {3, 2, 2}}
In the function I propose, I build an association with keys that are not supposed to be evaluated. There are some issues with this, see this answer by Taliesin, with the following quote.
generally this just sounds like a dangerous and confusing game to play, to me.
I think the function presented in this answer deals with the complications you mention reasonably well. It uses an option to set the levelspec. To see how patterns are handled, see the section Verbatim.
Concerning point (1),(2) and (3): Before there were a lot of additional complications. But I now that we have Association
we no longer have to deal with those. Making this work with held expressions is just a matter of being thorough in surrounding expressions with Hold
and Unevaluated.
My intuition is also that Association
should have better performance than a Dispatch
table or something similar. An Association
should be unbeatable in terms of how long it takes to look up a particular sub-expression. But maybe we should do a proper comparison.
ClearAll[positionIndexGeneral]
Options[positionIndexGeneral] = {Heads -> True};
SetAttributes[positionIndexGeneral, HoldAll];
positionIndexGeneral[expr_, lev_: {1,Infinity}, OptionsPattern[]] :=
Module[{subExprs, positions, len, together, gathered, hGathered,
gatheredSubExprs, gatheredPos},
subExprs =
Level[Unevaluated@expr, lev, Hold, Heads -> OptionValue[Heads]];
positions =
Position[Unevaluated@expr, _, lev, Heads -> OptionValue[Heads]];
len = subExprs // Length;
together = Transpose[{List @@ Hold /@ subExprs, positions}];
gathered = GatherBy[together, First];
hGathered = Hold@Evaluate@gathered;
gatheredSubExprs = hGathered[[All, All, 1, 1, 1]];
gatheredPos = gathered[[All, All, 2]];
AssociationThread @@ {Unevaluated @@ gatheredSubExprs, gatheredPos}]
Example:
a = 3;
positionAssoc =
positionIndexGeneral[{a, 2, {3, 4, a}}]
positionAssoc[Unevaluated[a]]
{{1},{3,3}}
corresponding to
Position[Unevaluated@{a, 2, {3, 4, a}}, Unevaluated[a]]
{{1},{3,3}}
Verbatim
Note that in general we are simulating how Position
works with Verbatim
.
positionAssoc = positionIndexGeneral[{a, 2, {3, 4, a_}}]
positionAssoc[a_]
{{3,3}}
Corresponding to
Position[Unevaluated@{a, 2, {3, 4, a_}}, Verbatim[a_]]
{{3,3}}
To simulate how Position
works without Verbatim
in this way is probably not very useful. There are infinitely many patterns against which an expression can be tested, so of course we cannot make a big lookup table. For a very specific pattern like List | Hold
we might make some specialised code that looks up both List
and Hold
in the association.
Timing
My function can kind of compete with a specialised function by Mr.Wiz in the 1D case, and of course it dwarfs the built in PositionIndex
for large data.
f[x_] := AssociationThread @@ {Hold[
Unevaluated[x]][[1, {1}, #[[All, 1]]]], #} &@
GatherBy[Range@Length@x, Hold[x][[{1}, #]] &]
Now let's make some data and compare
data = RandomInteger[999, 1*^5];
(jacobGen =
positionIndexGeneral[Evaluate@data, {1, 1}, Heads -> False]) //
Timing // First
(mma1D = PositionIndex[data]) // Timing // First
(wiz1D = f[data]) // Timing // First
Position[data, 115] === jacobGen[115] === List /@ wiz1D[115] ===
List /@ mma1D[115]
0.214873 0.174309 0.164100 True
data = RandomInteger[10, 1*^5];
(jacobGen =
positionIndexGeneral[Evaluate@data, {1, 1}, Heads -> False]) //
Timing // First
(mma1D = PositionIndex[data]) // Timing // First
(wiz1D = f[data]) // Timing // First
0.235508 4.119624 0.153041
data = RandomInteger[10, 1*^6];
(jacobGen = positionIndexGeneral[data, {1, 1}, Heads -> False]) //
Timing // First
(wiz1D = f[data]) // Timing // First
2.294256 1.703060
Possible improvement
When we only want the expressions at level 1, the function provided by Mr.Wizard is faster. With some good metaprogramming it should be possible to get the best of both worlds.
Appendix
It would of course have been cooler to write something like
ClearAll[positionIndexGeneral]
Options[positionIndexGeneral] = {Heads -> True};
positionIndexGeneral[expr_, lev_: {1,Infinity}, OptionsPattern[]] :=
AssociationThread @@
{
Unevaluated @@ #2[[All, All, 1, 1, 1]]
,
Function[{x}, x[[#]] & /@ #[[All, All, 2]]]@
Position[expr, _, lev, Heads -> OptionValue[Heads]]
} &[#, Hold@Evaluate@#] &@
GatherBy[Transpose[{List @@ Hold /@ #, Range[# // Length]}] &@
Level[expr, lev, Hold, Heads -> OptionValue[Heads]], First]
but I prefer the style with Module
(/Block
when possible) for debugging, as well as to immediately see what happens first.