Construct an unique index from two integer (Pairing Function)

[This article was first published on R HEAD, and kindly contributed to R-bloggers]. (You can report issue about the content on this page here)
Want to share your content on R-bloggers? click here if you have a blog, or here if you don't.

Recently, I need to construct an unique index from two integer. The best solution I found is the Pairing function.

Pairing function is an one to one and onto function that map two integers to a single integer. The definition as follows:

pair<-function(x,y){
  0.5*(x+y)*(x+y+1) +  x
}
unpair<-function(z){
  w= floor( (sqrt(8*z+1) - 1)/2 )
  t = w*(w+1)/2
  cbind(z-t,w-z+t)
}

foreach (i = 0:4,.combine=rbind) %do% {
  x<-0:i
  y<-i:0

  key<-pair(x,y)
  unpair_key <- unpair(key)
  cbind(x,y,key=key,unpair_key=unpair_key)
}
      x y key x y
 [1,] 0 0   0 0 0
 [2,] 0 1   1 0 1
 [3,] 1 0   2 1 0
 [4,] 0 2   3 0 2
 [5,] 1 1   4 1 1
 [6,] 2 0   5 2 0
 [7,] 0 3   6 0 3
 [8,] 1 2   7 1 2
 [9,] 2 1   8 2 1
[10,] 3 0   9 3 0
[11,] 0 4  10 0 4
[12,] 1 3  11 1 3
[13,] 2 2  12 2 2
[14,] 3 1  13 3 1
[15,] 4 0  14 4 0

If ordering of x and y is not important, we can swap x and y if x>y. However, the Pairing function is not one to one and we can not back out x and y with z

pair<-cmpfun(function(x,y,ordering_matter=TRUE){
  if (ordering_matter){
    return(0.5*(x+y)*(x+y+1) + x)
  } else{
    swap <- x>y
    return(0.5*(x+y)*(x+y+1) +  (x* !swap) + (y*swap ))
  }
})

foreach (i = 0:4,.combine=rbind) %do% {
  x<-0:i
  y<-i:0

  key<-pair(x,y,ordering_matter=FALSE)
  unpair_key <- unpair(key)
  cbind(x,y,key=key,unpair_key=unpair_key)
}
      x y key x y
 [1,] 0 0   0 0 0
 [2,] 0 1   1 0 1
 [3,] 1 0   1 0 1
 [4,] 0 2   3 0 2
 [5,] 1 1   4 1 1
 [6,] 2 0   3 0 2
 [7,] 0 3   6 0 3
 [8,] 1 2   7 1 2
 [9,] 2 1   7 1 2
[10,] 3 0   6 0 3
[11,] 0 4  10 0 4
[12,] 1 3  11 1 3
[13,] 2 2  12 2 2
[14,] 3 1  11 1 3
[15,] 4 0  10 0 4
> 

If we have more than two integers, we can apply the Pairing function in a nested manner.

nestedPair<-function(x){
  ncol_x = ncol(x)
  if(ncol_x==1){
    return(x)
  } else if(ncol_x ==2) {
    return(pair(x[,1],x[,2]))
  } else if ( ncol_x > 2){
    return(pair( x[,1] ,nestedPair(x[,2:ncol_x]) ) )
  }
}

nestedUnpair<-function(x,order){
  if(order==1){
    return(unpair(x))
  } else if(order >1) {
    out <- unpair(x)

    return(cbind(out[,1],nestedUnpair(out[,2],order-1)))
  }
}

x<-expand.grid(0:2,0:2,0:2)
key <- nestedPair(x)
unpair_key <- nestedUnpair(key,2)
cbind(x=x,key=key,unpair_key=unpair_key)

   x.Var1 x.Var2 x.Var3 key unpair_key.1 unpair_key.2 unpair_key.3
1       0      0      0   0            0            0            0
2       1      0      0   2            1            0            0
3       2      0      0   5            2            0            0
4       0      1      0   3            0            1            0
5       1      1      0   7            1            1            0
6       2      1      0  12            2            1            0
7       0      2      0  15            0            2            0
8       1      2      0  22            1            2            0
9       2      2      0  30            2            2            0
10      0      0      1   1            0            0            1
11      1      0      1   4            1            0            1
12      2      0      1   8            2            0            1
13      0      1      1  10            0            1            1
14      1      1      1  16            1            1            1
15      2      1      1  23            2            1            1
16      0      2      1  36            0            2            1
17      1      2      1  46            1            2            1
18      2      2      1  57            2            2            1
19      0      0      2   6            0            0            2
20      1      0      2  11            1            0            2
21      2      0      2  17            2            0            2
22      0      1      2  28            0            1            2
23      1      1      2  37            1            1            2
24      2      1      2  47            2            1            2
25      0      2      2  78            0            2            2
26      1      2      2  92            1            2            2
27      2      2      2 107            2            2            2

To leave a comment for the author, please follow the link and comment on their blog: R HEAD.

R-bloggers.com offers daily e-mail updates about R news and tutorials about learning R and many other topics. Click here if you're looking to post or find an R/data-science job.
Want to share your content on R-bloggers? click here if you have a blog, or here if you don't.

Never miss an update!
Subscribe to R-bloggers to receive
e-mails with the latest R posts.
(You will not see this message again.)

Click here to close (This popup will not appear again)