How can I convert sequences to sharings and vice versa?

Question

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?

Answer 1

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

Answer 2

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*)

Answer 3

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}