6
$\begingroup$

Given positive integers $k,n$, a $k$-sequence of $I_n$ is a list of $k$ not necessarily distinct elements of $\{1,\dots, n\}$. And an $n$-sharing of $I_k$ is a list of $n$ possibly empty, disjoint subsets of $\{1,\dots, k\}$ that union up to $\{1,\dots, k\}$. There is a one-to-one correspondence between the $k$-sequences of $I_n$ and the $n$-sharings of $I_k$, where the $i$th element of the sharing contains all indices $j$ of the sequence that store the number $i$. For example, the $3$-sequence $$(4, 1, 1)$$ of $I_4$ is mapped to the $4$-sharing $$(\{2,3\}, \varnothing, \varnothing, \{1\})$$ of $I_3$ because the two indices storing a $1$ in the sequence are $2$ and $3$, the only index in the sequence storing a $4$ is $1$, and there are no indices storing $2$ or $3$. How can I convert between $k-$sequences of $I_n$ and $n$-sharings of $I_k$ in mathematica?

$\endgroup$

3 Answers 3

4
$\begingroup$

Looks like a case for PositionIndex:

ClearAll[toPositions]
toPositions = PositionIndex[#] /@ Range[Max@#] /. _Missing -> {} &;

Examples:

toPositions @ {4, 1, 1}
{{2, 3}, {}, {}, {1}}
toPositions @ {5, 2, 3, 2, 5, 3, 5, 5}
{{}, {2, 4}, {3, 6}, {}, {1, 5, 7, 8}}

To recover the input list from positions:

ClearAll[fromPositions]
fromPositions = Values @* KeySort @* 
  KeyValueMap[Sequence @@ Thread[List /@ # -> First@#2] &]
    @* KeyDrop[{{}}] @* PositionIndex;

Examples:

fromPositions@{{2, 3}, {}, {}, {1}}
 {4, 1, 1}
fromPositions@{{}, {2, 4}, {3, 6}, {}, {1, 5, 7, 8}}
 {5, 2, 3, 2, 5, 3, 5, 5}
SeedRandom[1]
list = RandomChoice[Range@6, 10]
{5, 3, 5, 1, 2, 1, 1, 3, 1, 1}
toPositions@list
{{4, 6, 7, 9, 10}, {5}, {2, 8}, {}, {1, 3}}
fromPositions @ %
{5, 3, 5, 1, 2, 1, 1, 3, 1, 1}
SeedRandom[1]
lists = RandomChoice[Range@7, {100, 20}];

AllTrue[fromPositions@toPositions@# == # &] @ lists
True
$\endgroup$
2
  • $\begingroup$ Thank you for the great answer! Just one question: what's the underscore in front of Missing in the toPositions function? Is it like the wildcard in Ocaml? $\endgroup$
    – user236343
    Feb 26, 2022 at 19:37
  • 1
    $\begingroup$ @user236343, see Blank (_) in the documentation center. $\endgroup$
    – kglr
    Feb 26, 2022 at 19:53
2
$\begingroup$
ToPositions[kseq_List] := Module[{sharing, idxseq},
sharing = Array[{} &, Max@kseq];
idxseq = {ConstantArray[#, Length@#], Range@Length@#} &@kseq;
MapThread[AppendTo[sharing[[#1[[#2]]]], #2] &, idxseq];
sharing]

FromPositions[sharing_List] := Module[{ord, srange, seq},
ord = Ordering[Catenate[sharing]];
srange = Range@Length@sharing;
seq = Splice@ConstantArray[#, Length[sharing[[#]]]] & /@ srange;
seq[[ord]]]

test1

l1 = {4, 1, 1};

ToPositions@l1

{{2, 3}, {}, {}, {1}}

FromPositions@ToPositions@l1 === l1

(*True*)

test2

l2 = {5, 2, 3, 2, 5, 3, 5, 5};

ToPositions@l2

{{}, {2, 4}, {3, 6}, {}, {1, 5, 7, 8}}

FromPositions@ToPositions@l2 === l2

(*True*)
$\endgroup$
1
$\begingroup$
ToPositions[x_] :=
 Lookup[PositionIndex @ x, Range @ Max @ x, {}]

FromPositions[x_] :=
 Map[First] @ SortBy[Last] @ Apply[Join] @ Map[Thread] @
     Transpose[{Range @ Length @ x, x}]

test 1

al = {4, 1, 1};

ToPositions @ al

{{2, 3}, {}, {}, {1}}

FromPositions @ ToPositions @ al

{4, 1, 1}

test 2

bl = {5, 2, 3, 2, 5, 3, 5, 5};

ToPositions @ bl

{{}, {2, 4}, {3, 6}, {}, {1, 5, 7, 8}}

FromPositions @ ToPositions @ bl

{5, 2, 3, 2, 5, 3, 5, 5}

$\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.