# This example creates a block/diagonal for H that is close to a
# Matern covariance
# The example while lengthy is a practical run through of the process
# of creating a reasonable sparse representation for H.
M<- 16 # a 16X16 grid of locations
MM<- M**2
x<- 1:M
y<- 1:M
grid<- list( x=x, y=y)
cut.min<- 4
# H0 is father and mothers at first level
# with cut.min=4
# get indices associated with H0
I<-rep( 1:cut.min, cut.min)
J<- sort( I)
Wimage.s2i(I, J, flavor=0, level=0, cut.min=cut.min, m=M, n=M, mat=FALSE)-> ind0
Wimage.s2i(I, J, flavor=1, level=1, cut.min=cut.min, m=M, n=M, mat=FALSE)-> ind1
Wimage.s2i(I, J, flavor=2, level=1, cut.min=cut.min, m=M, n=M, mat=FALSE)-> ind2
Wimage.s2i(I, J, flavor=3, level=1, cut.min=cut.min, m=M, n=M, mat=FALSE)-> ind3
IND<- c( ind0, ind1, ind2, ind3)
NH<- length( IND) # H0 will be NH by NH in size.
# the Matern covariance function range=3, smoothness=1.
cov.obj<- stationary.image.cov( grid=grid, setup=TRUE, theta=3, smoothness=1)
# find elements of D0= H0**2 using the formula
# D0 = W Sigma W.t where W is the 2-d W transform ( the inverse of W.i above).
# and Sigma is the Matern covariance
#
# the following looping algorithms are a way to avoiding explicitly creating
# gigantic covariance matrices and wavelet basis matrices associated with large
# grids. Of course in this example the grid is small enough (16X16) that the
# matrices could be formed explicitly
#
D0<- matrix( 0, NH,NH)
# fill in D0
for ( k in 1:NH){
tmp<- matrix( 0, M,M)
tmp[IND[k]] <- 1
hold<- Wtransform.image( tmp, transpose=TRUE, cut.min=cut.min)
hold<- stationary.image.cov(Y=hold, cov.obj=cov.obj)
hold<- Wtransform.image(hold, cut.min=cut.min)
D0[k,] <- hold[IND]
}
# sqrt of D0
temp<- eigen( D0, symmetric=TRUE)
# next line should be
# H0<-temp$vectors%*%diag(sqrt(temp$values))%*%t(temp$vectors)
H0<- temp$vectors %*% diag(sqrt(temp$values))%*% t(temp$vectors)
# find H1
H1<- matrix(0,M,M)
for ( k in 1:MM){
tmp<- matrix( 0, M,M)
tmp[k] <- 1
hold<- Wtransform.image( tmp, transpose=TRUE, cut.min=cut.min)
hold<- matern.image.cov(Y=hold, cov.obj=cov.obj)
hold<- Wtransform.image(hold, cut.min=cut.min)
H1[k] <- sqrt(hold[k]) }
# remember that H1 has the H0 diagonal values set to 1.
H1[IND] <- 1
#OK good to go. Create the H.obj list
H.obj<- list( m=M, n=M, ind0=IND, cut.min=cut.min, H0=H0, H1=H1)
#
#
#
# mutliply the covariance matrix by a random vector
tmp<- matrix( rnorm( 256), 16,16)
Wimage.cov( tmp, H.obj=H.obj)-> look
# generate a random field
Wimage.sim(H.obj)-> look
image.plot( look)
#A check that this really works!
#find the 135 =(9-1)*16 +7 == (7,9) row of covariance matrix
# we know what this should look like.
Wimage.cov( ind= 135, H.obj=H.obj, find.row=TRUE)-> look
image.plot( x,y,look) # the covariance of the grid point (7,9) with
# all other grid points -- a bump centered at (7,9)
#multiply a vector by just a subset of Sigma
ind<- sample( 1:256,50) # random set of 50 indices
Y<- rnorm( 50) # random vector of length 50
Wimage.cov(Y, ind= ind, H.obj=H.obj)[ind]-> look
# look is now of length 50 -- as expected.
# In R notation, this finding Sigma[ind, ind] %*% Y
# OK suppose you really need Sigma[ind,ind]
# e.g. in order for solve( Sigma[ind,ind], u)
# here is a loop to do it.
Sigma<- matrix( NA, 50,50)
for ( k in 1:50){
# for each member of subset find row and subset to just the columns identified by ind
Sigma[k,] <- c( Wimage.cov( ind= ind[k], H.obj=H.obj, find.row=TRUE)[ind])
}
Run the code above in your browser using DataLab