Function Repository Resource:

StandardOrderFromIndex

Get the standard ordering of the desired index

Contributed by: Ed Pegg Jr

ResourceFunction["StandardOrderFromIndex"][index,len]

gives the standard ordering of length len with position index.

Details and Options

Integers greater than zero in standard order start with 1, then can never be more than 1 higher than all previous integers.

The index is acquired by first noting the positions of the highest numbers to make a binary number.

The table below illustrates the process for determining an index for a standard order:

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

integers >0 in standard order start with 1, then can never be more than 1 higher than all previous integers.

{1,2,0,0,3,0,0,4,0}

some of the digits are new highest digits.

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

other digits acquire a mixed radix based on the previous highest digit.

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

without the initial 1, the sequence of highest digits mapped to 1 values makes a binary number B.

2²3²4¹

any binary number with 1's→{2,…,n} and sequential zeros acting as powers gives a Bell index.

BellB[n]

equals the sum of Bell indices of length n-1 binary numbers.

{146,86}→5867

the total of the first B Bell indices plus the mixed radix value gives the index.

Standard orderings are sorted based on binary index B.

The result follows the "standard order" described in the OEIS.

Examples

Basic Examples (2)

Return the index of a permutation:

In[1]:=

Out[1]=

The 52 standard orders of length 5:

In[2]:=

Out[2]=

Scope (3)

There are 10 billion standard orderings of length 16:

In[3]:=

Out[3]=

Give the length-16 standard ordering with position 5555555555:

In[4]:=

Out[4]=

Find the standard order with a given length and index:

In[5]:=

Out[5]=

Properties and Relations (3)

Define a Bell mask radix function:

In[6]:=

$BellMaskRadix[ len_] := {Flatten[{1, Split[#[[1]]][[2]] /. 0 -> 1, Drop[Split[#[[1]]], 2]}], #[[ 2]]} & /@ ({With[{zer = Table[0, {len}], rep = Normal[PositionIndex[Prepend[#, 1]]][[1, 2]]}, ReplacePart[zer, Thread[rep -> Range[Length[rep]]]]], Prepend[Select[ Flatten[MapIndexed[Table[#2[[1]], {(#1 - 1)}] &, Differences[Flatten[{1, Position[#, 1] + 1, len + 1}]]], 1], # > 1 &], 1]} & /@ Table[IntegerDigits[k, 2, len - 1], {k, 0, 2^(len - 1) - 1}]);$