Construct an unique index from two integer (Pairing Function)

R-bloggers 2013-04-04

(This article was first published on R HEAD, and kindly contributed to R-bloggers)

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.31       0      0      0   0            0            0            02       1      0      0   2            1            0            03       2      0      0   5            2            0            04       0      1      0   3            0            1            05       1      1      0   7            1            1            06       2      1      0  12            2            1            07       0      2      0  15            0            2            08       1      2      0  22            1            2            09       2      2      0  30            2            2            010      0      0      1   1            0            0            111      1      0      1   4            1            0            112      2      0      1   8            2            0            113      0      1      1  10            0            1            114      1      1      1  16            1            1            115      2      1      1  23            2            1            116      0      2      1  36            0            2            117      1      2      1  46            1            2            118      2      2      1  57            2            2            119      0      0      2   6            0            0            220      1      0      2  11            1            0            221      2      0      2  17            2            0            222      0      1      2  28            0            1            223      1      1      2  37            1            1            224      2      1      2  47            2            1            225      0      2      2  78            0            2            226      1      2      2  92            1            2            227      2      2      2 107            2            2            2

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

R-bloggers.com offers daily e-mail updates about R news and tutorials on topics such as: visualization (ggplot2, Boxplots, maps, animation), programming (RStudio, Sweave, LaTeX, SQL, Eclipse, git, hadoop, Web Scraping) statistics (regression, PCA, time series,ecdf, trading) and more...