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.
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.