6
$\begingroup$

What is the inverse of the Position?

I have an array which contains the positions of elements and I want a function which returns an List which contains 1 where those elements are and 0 elsewhere. For example, the List {1, 5} would return {1,0,0,0,1} or {2,1,4} would return {1,1,0,1}. Additional arguments might need to be supplied for length etc. (Technically, this function is a inverse of restricted version of the Position function)

I realize that I could do with Table but it seems like this would be a common enough process that there would be a built in function for this. However, I have not been able to find it in the documentation.

Improve this question
$\endgroup$
2
  • 3
    $\begingroup$ Am I missing something? Reverse[IntegerDigits[Tr[2^(#-1)],2]]& s/b quite efficient. Add the length argument to IntegerDigits if you want a mask matching some arbitrary length. $\endgroup$
    – ciao
    Sep 4, 2017 at 1:26
  • 3
    $\begingroup$ I would not call that the inverse of Position ... the true inverse of Position, i.e. a function that takes Position's output and returns its input, is Extract $\endgroup$
    – Szabolcs
    Sep 5, 2017 at 12:34

8 Answers 8

Reset to default
10
$\begingroup$

I don't know that you can do it in a single command. But it's easy enough to do in two. Say your list is list={2,1,4};

x = ConstantArray[0, Max[list]];
x[[list]] = 1;

x
{1, 1, 0, 1}

Effectively, Part (or the shortcut [[ ]]) acts as an approximate inverse of Position.

Improve this answer
$\endgroup$
5
  • $\begingroup$ Accepting this answer because it is the fastest in my limited testing $\endgroup$
    – The Square Cow
    Sep 5, 2017 at 14:00
  • $\begingroup$ @TheSquareCow This solution is silent about duplicates. (Also, it is hard to believe it is fastest. Can you post your tests?) $\endgroup$
    – Alan
    Sep 5, 2017 at 15:35
  • $\begingroup$ Yes, I would throw DeleteDuplicates at the list first before moving on. $\endgroup$
    – Sjoerd Smit
    Sep 5, 2017 at 15:54
  • $\begingroup$ Here are my tests: In[190]:= RepeatedTiming[(x = ConstantArray[0,Max[#]]; x[[#]] = 1; x)&[{2,1,4}], 20] Out[190]= {6.5*10^-6,{1,1,0,1}} In[191]:= RepeatedTiming[(Normal@SparseArray[Thread[#->1]])&[{2,1,4}], 20] Out[191]= {0.00002,{1,1,0,1}} In[192]:= RepeatedTiming[(Rest@BinCounts[#])&[{2,1,4}], 20] Out[192]= {0.00032,{1,1,0,1}} In[193]:= RepeatedTiming[Reverse[IntegerDigits[Tr[2^(#-1)],2]]&[{2,1,4}], 20] Out[193]= {0.00001,{1,1,0,1}} $\endgroup$
    – The Square Cow
    Sep 6, 2017 at 16:00
  • $\begingroup$ Sorry about the formatting, I couldn't get the newlines inside a comment box to work correctly. $\endgroup$
    – The Square Cow
    Sep 6, 2017 at 16:02
8
$\begingroup$ 
Normal@SparseArray[Thread[{1, 5} -> 1]]
(*  {1, 0, 0, 0, 1}  *)

Normal@SparseArray[Thread[{2, 1, 4} -> 1]]
(*  {1, 1, 0, 1}  *)
Improve this answer
$\endgroup$
2
$\begingroup$ 
list = {2, 1, 5};
Normal@SparseArray[Thread[list -> 1]]

or

dat = ConstantArray[0, Max@list];
dat[[{2, 1, 5}]] = 1;
dat
Improve this answer
$\endgroup$
0
2
$\begingroup$ 
In[253]:= Rest@BinCounts[{1, 5}]

Out[253]= {1, 0, 0, 0, 1}

In[254]:= Rest@BinCounts[{2, 1, 4}]

Out[254]= {1, 1, 0, 1}
Improve this answer
$\endgroup$
2
$\begingroup$

With ReplaceAt (since V 13.1)

list = {1, 5};

ReplaceAt[Table[0, Max @ list], _ :> 1, List /@ list]

{1, 0, 0, 0, 1}

With ReplacePart

list = {1, 2, 3, 6};

ReplacePart[Table[0, Max @ list], Thread[list -> 1]]

{1, 1, 1, 0, 0, 1}

Improve this answer
$\endgroup$
2
$\begingroup$ 
ClearAll[f]
f = x |-> Array[Boole @ MemberQ[#] @ x &, Max @ x];

Examples:

{#, f @ #} & /@ {{2, 1, 5}, {2, 1, 2, 4}, {1, 5}}
position f @ position
{2, 1, 5} {1, 1, 0, 0, 1}
{2, 1, 2, 4} {1, 1, 0, 1}
{1, 5} {1, 0, 0, 0, 1}
Improve this answer
$\endgroup$
1
$\begingroup$ 
f[pos_List] := 
 MapAt[# + 1 &, ConstantArray[0, Max[pos]], List /@ Union@pos]

or

g[pos_List] := Module[{temp = Max[pos] - # & /@ Union@pos},
  2^temp // Total // IntegerDigits[#, 2] &
  ]

Usage:

testcases = {{2, 1, 5}, {2, 1, 2, 4}, {1, 5}}

f /@ testcases
g /@ testcases

Result:

{{1, 1, 0, 0, 1}, {1, 1, 0, 1}, {1, 0, 0, 0, 1}}

Improve this answer
$\endgroup$
1
$\begingroup$

Using ReplaceAll:

f = Range@Max[#] /. Catenate[Thread /@ {Complement[Range@Max[#], #] -> 0, # -> 1}] &;

f@{1, 5}

(*{1, 0, 0, 0, 1}*)

f@{2, 1, 4}

(*{1, 1, 0, 1}*)
Improve this answer
$\endgroup$

Your Answer

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

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