Ordering 15 Team Members

Introduction

There are 15 people in my team at Stats NZ. Each week, we have a team meeting, and it’s the chair person (by rotation) who decides the order of the 15 team members to update the team about their work. Here is a problem: Suppose you are the chair person, how do you order the 15 people?

My team members have got various ideas about the orderings, and the most extraordinary one thus far probably is: Order based on lengths of people’s hair!

In this note, I will try to solve the problem, using an algorithm that I just learned.

Solution

As preparation, let’s firstly understand the “space”, i.e. the set of all possible orderings. Obviously, here I am talking about permutations—there are $15!=1,307,674,368,000$—this is a large number, and can be read as: 1 trillion 307 billion 674 million 368 thousand—possible orderings. How to have all of these orderings? My desired solution is: If I input a number between 1 and 1,307,674,368,000, then the output is an ordering in the space. To be exact, what I want is a function, which maps an integer to an ordering. Luckily, I have found the paper [1] “Ranking and Unranking Permutations in Liner Time”, which provides the algorithms for creating the function that I want.

R code

To protect privacy, in my R code, I rename my team members as “a”, “b”, …, “n” and “o”.

# setting ------------------------------------------------------------------
my_team <- letters[1:15]
n <- length(my_team)
s <- 0:(n-1)

# functions ---------------------------------------------------------------
swap <- function(s, index_1, index_2)
{temp <- s[index_1]
 s[index_1] <- s[index_2]
 s[index_2] <- temp
 return(s)
}

my_unrank <- function(n, r, s)
{if(n > 0) {
  s <- swap(s, index_1 = n - 1 + 1, index_2 = r %% n + 1) # index starts from 1
  my_unrank(n - 1, floor(r / n), s)
 } else {return(s)
  }
}

my_ordering <- function(input_nbr)
{permu <- my_unrank(n, input_nbr - 1, s) + 1 # index starts from 1
 my_team[permu]
}


# testing -----------------------------------------------------------------
## test 1
lapply(1:5, my_ordering)

## [[1]]
##  [1] "b" "c" "d" "e" "f" "g" "h" "i" "j" "k" "l" "m" "n" "o" "a"
## 
## [[2]]
##  [1] "o" "c" "d" "e" "f" "g" "h" "i" "j" "k" "l" "m" "n" "a" "b"
## 
## [[3]]
##  [1] "b" "o" "d" "e" "f" "g" "h" "i" "j" "k" "l" "m" "n" "a" "c"
## 
## [[4]]
##  [1] "b" "c" "o" "e" "f" "g" "h" "i" "j" "k" "l" "m" "n" "a" "d"
## 
## [[5]]
##  [1] "b" "c" "d" "o" "f" "g" "h" "i" "j" "k" "l" "m" "n" "a" "e"

## test 2
(my_ordering(1234567))

##  [1] "b" "n" "j" "k" "f" "o" "h" "l" "a" "d" "e" "i" "c" "m" "g"

## test 3
N <- 1307674368000
lapply((N - 4):N, my_ordering)

## [[1]]
##  [1] "a" "b" "c" "d" "e" "f" "g" "h" "i" "j" "o" "l" "m" "n" "k"
## 
## [[2]]
##  [1] "a" "b" "c" "d" "e" "f" "g" "h" "i" "j" "k" "o" "m" "n" "l"
## 
## [[3]]
##  [1] "a" "b" "c" "d" "e" "f" "g" "h" "i" "j" "k" "l" "o" "n" "m"
## 
## [[4]]
##  [1] "a" "b" "c" "d" "e" "f" "g" "h" "i" "j" "k" "l" "m" "o" "n"
## 
## [[5]]
##  [1] "a" "b" "c" "d" "e" "f" "g" "h" "i" "j" "k" "l" "m" "n" "o"

Real Application

The above R code works fine. However, in a real application, people may have trouble choosing a proper input_nbr. In that case, I have the following extra R code, where the input required is not a number but a date; this makes the real application a little bit easier.

my_ordering_easy <- function(input_date = "2023-10-21")
{the_date <- as.POSIXct(input_date)
 input_nbr <- as.numeric(the_date) %% 1307674368000 + 1
 my_ordering(input_nbr)
}

## testing
(my_ordering_easy("2023-10-21"))

##  [1] "j" "c" "m" "h" "f" "n" "g" "k" "d" "b" "l" "e" "i" "o" "a"

References

[1] Myrvold, W. and Ruskey, F. (2001). Ranking and Unranking Permutations in Linear Time, Information Processing Letters, 79, pp. 281–284.