5
$\begingroup$

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.

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

2 Answers 2

7
$\begingroup$
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]

enter image description here

$\endgroup$
7
$\begingroup$

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