Linear interpolation of 2-dimensional grid data and graphical representations

The following functions can be used to graphically represent sparse 2-dimensional grid data (structured such that there are M x N points with outputs for all pairs in the cartesian product – however the spacing between the points doesn’t have to be even).  For example, suppose we have M = {3,6,9,12,15} and N = {0, 300, 640, 1200, 1900) with the outputs given as follows:

15 0 11.3

15 300 15.4301

15 640 25.23079

15 1200 19.3136

15 1900 7.410628

12 300 13.60118

12 640 15.87192

12 1200 14.59608

12 1900 2.966801

9 1200 9.078537

9 1900 9.217389

6 1900 0.810527

6 0 0

6 300 0

6 640 0

6 1200 0

3 0 0

3 300 0

3 640 0

3 1200 0

3 1900 0

9 0 0

9 300 0

9 640 0

12 0 0

the fillgrid function interpolates the data linearly so that it is approximately of a given density.  It also has the option of making it square (there are some algs i use in maple etc for 3d pointplots that like things to be nice and square).  Then the colorgraph function plots the points with different colours corresponding with the zvalues.

So with the above data, setting the density to 70, will give a graph as belowImage

The colors of the graph can be changed too, so this shows a little more granularity

Image

This graph gives a 3d representation of the first graph with the same colouring scheme (there’s a rotation on the axis as well.

R-Code

fillgrid<-function(data,outfile,density = 50,square = 1,square.rem = 0) {
A<-data
# Sort by 1st then 2nd
Ap<-A[order(A[,2,]),,]
A12<-Ap[order(Ap[,1,]),,]
# Sort by 2nd then 1st
A21<-A12[order(A12[,2,]),,]
# determine big B
BB <- (max(A[,2])-min(A[,2]))/density
for(i in 1:(nrow(A12)-1)) 
if(A12[i,1]==A12[i+1,1]) {
B<-floor( (A12[i+1,2]-A12[i,2])/BB )
for(b in 1:(B-1)) 
A<-rbind(A, c(A12[i,1], (A12[i,2]*(b/B)+A12[i+1,2]*(1-b/B)), (A12[i,3]*(b/B)+A12[i+1,3]*(1-b/B)) )) }
# then resort and fill in gaps in other direction
Ap<-A[order(A[,2,]),,]
A12<-Ap[order(Ap[,1,]),,]
A21<-A12[order(A12[,2,]),,]
BB <- (max(A[,1])-min(A[,1]))/density
for(i in 1:(nrow(A21)-1)) 
if(A21[i,2]==A21[i+1,2]) {
B<-floor( (A21[i+1,1]-A21[i,1])/BB )
for(b in 1:(B-1)) 
A<-rbind(A, c((A21[i,1]*(b/B)+A21[i+1,1]*(1-b/B)), A21[i,2], (A21[i,3]*(b/B)+A21[i+1,3]*(1-b/B)) )) }
# sort for graphing structure
surf<-A[order(A[,2,]),,]
surf<-surf[order(surf[,1,]),,]
# if needed to be square, remove an upper or lower line
if(square==1){
howmany1<-0
howmany2<-0
for(i in 1:nrow(surf)) {if(surf[i,1]==surf[1,1]) howmany1<-howmany1+1}
for(i in 1:nrow(surf)) {if(surf[i,2]==surf[1,2]) howmany2<-howmany2+1}
if(howmany2 > howmany1) {
no.rems <- howmany2 - howmany1
surf<-surf[order(surf[,2,]),,]
if(square.rem == 0) {
surf<- surf[(no.rems*howmany1+1):nrow(surf),]}
if(square.rem == 1) {
surf<- surf[1:(nrow(surf)-(no.rems*howmany1)),]}
}
if(howmany1 > howmany2) {
no.rems <- howmany1 - howmany2
if(square.rem == 0) {
surf<- surf[(no.rems*howmany2+1):nrow(surf),]}
if(square.rem == 1) {
surf<- surf[1:(nrow(surf)-(no.rems*howmany2)),]}
}
# sort for graphing structure
surf<-surf[order(surf[,2,]),,]
surf<-surf[order(surf[,1,]),,]
}
# export to a table if you want
write.table(surf,outfile,row.names=FALSE, col.names=FALSE)
surf
}
colorgraph<-function(data,rb.size){
vals<-rainbow(rb.size)
data[,3]<- 25*(data[,3]-min(data[,3]))/(max(data[,3])-min(data[,3]))
zcols<-array(0,nrow(data))
for(i in 1:nrow(data)) zcols[i]<-vals[max(data[,3])+1-floor(data[i,3])]
# 2d plot with colours (heatmaplike)
plot(data[,1:2],col=zcols,pch=15)
}
Advertisements

Leave a Reply

Fill in your details below or click an icon to log in:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out /  Change )

Google+ photo

You are commenting using your Google+ account. Log Out /  Change )

Twitter picture

You are commenting using your Twitter account. Log Out /  Change )

Facebook photo

You are commenting using your Facebook account. Log Out /  Change )

Connecting to %s