x <- y <- matrix( 0, 100, 200 )
x[ 45, 10 ] <- 1
x <- kernel2dsmooth( x, kernel.type = "disk", r = 4 )
y[ 50, 60 ] <- 1
y <- kernel2dsmooth( y, kernel.type = "disk", r = 10 )
censqdelta( x, y )
if (FALSE) {
# Example form Gilleland (2017).
#
# I1 = circle with radius = 20 centered at 100, 100
# I2 = circle with radius = 20 centered at 140, 100
# I3 = circle with radius = 20 centered at 180, 100
# I4 = circle with radius = 20 centered at 140, 140
I1 <- I2 <- I3 <- I4 <- matrix( 0, 200, 200 )
I1[ 100, 100 ] <- 1
I1 <- kernel2dsmooth( I1, kernel.type = "disk", r = 20 )
I1[ I1 > 0 ] <- 1
if( any( I1 < 0 ) ) I1[ I1 < 0 ] <- 0
I2[ 140, 100 ] <- 1
I2 <- kernel2dsmooth( I2, kernel.type = "disk", r = 20 )
I2[ I2 > 0 ] <- 1
if( any( I2 < 0 ) ) I2[ I2 < 0 ] <- 0
I3[ 180, 100 ] <- 1
I3 <- kernel2dsmooth( I3, kernel.type = "disk", r = 20 )
I3[ I3 > 0 ] <- 1
if( any( I3 < 0 ) ) I3[ I3 < 0 ] <- 0
I4[ 140, 140 ] <- 1
I4 <- kernel2dsmooth( I4, kernel.type = "disk", r = 20 )
I4[ I4 > 0 ] <- 1
if( any( I4 < 0 ) ) I4[ I4 < 0 ] <- 0
image( I1, col = c("white", "darkblue") )
contour( I2, add = TRUE )
contour( I3, add = TRUE )
contour( I4, add = TRUE )
# Each circle is the same size and shape, and the domain is square.
# I1 and I2, I2 and I3, and I2 and I4 are all the same distance
# away from each other. I1 and I4 and I3 and I4 are also the same distance
# from each other. I3 touches the edge of the domain.
#
# First, calculate the Baddeley delta metric on each
# comparison.
I1im <- as.im( I1 )
I2im <- as.im( I2 )
I3im <- as.im( I3 )
I4im <- as.im( I4 )
I1im <- solutionset( I1im > 0 )
I2im <- solutionset( I2im > 0 )
I3im <- solutionset( I3im > 0 )
I4im <- solutionset( I4im > 0 )
deltametric( I1im, I2im )
deltametric( I2im, I3im )
deltametric( I2im, I4im )
# Above are all different values.
# Below, they are all 28.84478.
censqdelta( I1, I2 )
censqdelta( I2, I3 )
censqdelta( I2, I4 )
# Similarly for I1 and I4 vs I3 and I4.
deltametric( I1im, I4im )
deltametric( I3im, I4im )
censqdelta( I1, I4 )
censqdelta( I3, I4 )
# To see why this problem exists.
dm1 <- distmap( I1im )
dm1 <- as.matrix( dm1 )
dm2 <- distmap( I2im )
dm2 <- as.matrix( dm2 )
par( mfrow = c( 2, 2 ) )
image.plot( dm1 )
contour( I1, add = TRUE, col = "white" )
image.plot( dm2 )
contour( I2, add = TRUE, col = "white" )
image.plot( abs( dm1 ) - abs( dm2 ) )
contour( I1, add = TRUE, col = "white" )
contour( I2, add = TRUE, col = "white" )
}
Run the code above in your browser using DataLab