# Create unique position values

Given a list of integers I want to create unique position-values. The following rules apply:

Take first number. If first number exceeds list length, take 1.

Take next number.

1. If next number is lower than or equal to list length and hasn't
been taken yet: Take it.

2. If next number exceeds list length, take lowest number not yet
taken.

3. If next number (n) doesn't exceed list length, but already has
been taken, take n + 1.

Repeat these steps as shown in the following examples:

{2, 2, 2} -> {2, 3, 1}


Take 2 - Since 2 already has been taken, take 2 + 1 - Fill in missing element.

{2, 1, 2} -> {2, 1, 3}


Take 2 - Take 1 - Fill in missing element

{3, 3, 3} -> {3, 1, 2}


Take 3 - Since 3 + 1 would exceed list length, take smallest number not yet used (1) - Fill in missing element.

{3, 3, 1, 1} -> {3, 4, 1, 2}


Take 3 - Take 3 + 1 - Take 1 - Fill in missing element.

{2, 7, 2} -> {2, 1, 3}


Take 2 - Since 7 exceeds list length, take smallest number not yet used (1) - Fill in missing element

{4, 8, 1, 1} -> {4, 1, 2, 3}


Take 4 - Since 8 exceeds list length, take smallest number not yet used (1) - Since 1 now has been taken, take 1 + 1 - Fill in missing element.

Some other examples:

{1, 1, 1} -> {1, 2, 3};
{120, 1, 1} -> {1, 2, 3};
{120, 120, 120} -> {1, 2, 3};
{5, 7, 1, 5, 1, 7, 6} -> {5, 7, 1, 6, 2, 3, 4};
{3, 4, 3, 4, 3, 4} -> {3, 4, 5, 6, 1, 2};


I could probably find some looping construct for this, but don't have any idea how a functional solution could look like.

• I do not understand, why {2,2,2} does not evaluate to {2,3,3} Aug 15, 2023 at 21:00
• Because all numbers have to be different. After 2, 3 there is only one choice: 1
– eldo
Aug 15, 2023 at 22:01

ClearAll[nextV, positionValues]

nextV[n_, a_, b_] :=
First[Complement[Range[b, n], a], First @ Complement[Range @ n, a]]

positionValues[l_] := Fold[Join[#, {nextV[Length@l, ##]}] &] @ Prepend[{}] @ l


Examples:

lists = {{2, 2, 2}, {2, 1, 2}, {3, 3, 3}, {3, 3, 1, 1}, {2, 7, 2},
{4, 8, 1, 1}, {1, 1, 1}, {120, 1, 1}, {120, 120, 120},
{5, 7, 1, 5, 1, 7, 6}, {3, 4, 3, 4, 3, 4}};

Grid[Prepend[{"list", "positionValues@list"}][{#, positionValues@#} & /@ lists],
Dividers -> All]


Something like this?

UniquePositions[list_List] := UniquePositions[{}, Range[Length@list], list];
UniquePositions[taken_List, candidates_List, {}] := taken;
UniquePositions[taken_List, candidates_List, {next_, rest___}] :=
With[
{takePos = FirstPosition[candidates, _?(GreaterEqualThan[next]), {1}]},
UniquePositions[Append[taken, Extract[candidates, takePos]], Delete[candidates, takePos], {rest}]]