Project

General

Profile

Download (6.75 KB) Statistics
| Branch: | Revision:
1
# R code to plot latitudinal profiles of mean aspect, along with both
2
# RMSE and correlation coefficients comparing fused layers with both the
3
# raw ASTER and with the Canada DEM
4
#
5
# Jim Regetz
6
# NCEAS
7
# Created on 08-Jun-2011
8

    
9
library(raster)
10

    
11
datadir <- "/home/regetz/media/temp/terrain/aspect"
12

    
13
# load aspect rasters
14
s.aster <- raster(file.path(datadir, "aster_300straddle_a.tif"))
15
s.srtm <- raster(file.path(datadir, "srtm_150below_a.tif"))
16
s.uncor <- raster(file.path(datadir, "fused_300straddle_a.tif"))
17
s.eramp <- raster(file.path(datadir, "fused_300straddle_rampexp_a.tif"))
18
s.bg <- raster(file.path(datadir, "fused_300straddle_blendgau_a.tif"))
19
s.can <- raster(file.path(datadir, "cdem_300straddle_a.tif"))
20

    
21
# extract raster latitudes for later
22
lats300 <- yFromRow(s.aster, 1:nrow(s.aster))
23
lats150 <- yFromRow(s.srtm, 1:nrow(s.srtm))
24

    
25
# initialize output pdf device driver
26
pdf("aspect-assessment.pdf", height=8, width=11.5)
27

    
28

    
29
#
30
# plot latitudinal profiles of mean aspect
31
#
32

    
33
par(mfrow=c(2,2), omi=c(1,1,1,1))
34

    
35
ylim <- c(160, 180)
36

    
37
plot(lats300, rowMeans(as.matrix(s.uncor), na.rm=TRUE), type="l",
38
    xlab="Latitude", ylab="Mean aspect", ylim=ylim)
39
text(min(lats300), min(ylim)+0.5, pos=4, font=3, labels="uncorrected")
40
abline(v=60, col="red", lty=2)
41
mtext(expression(paste("Latitudinal profiles of mean aspect (",
42
    136*degree, "W to ", 96*degree, "W)")), adj=0, line=2, font=2)
43

    
44
plot(lats300, rowMeans(as.matrix(s.can), na.rm=TRUE), type="l",
45
    xlab="Latitude", ylab="Mean aspect", ylim=ylim)
46
text(min(lats300), min(ylim)+0.5, pos=4, font=3, labels="Canada DEM")
47
abline(v=60, col="red", lty=2)
48

    
49
plot(lats300, rowMeans(as.matrix(s.eramp), na.rm=TRUE), type="l",
50
    xlab="Latitude", ylab="Mean aspect", ylim=ylim)
51
text(min(lats300), min(ylim)+0.5, pos=4, font=3, labels="exponential ramp")
52
abline(v=60, col="red", lty=2)
53

    
54
plot(lats300, rowMeans(as.matrix(s.bg), na.rm=TRUE), type="l",
55
    xlab="Latitude", ylab="Mean aspect", ylim=ylim)
56
text(min(lats300), min(ylim)+0.5, pos=4, font=3, labels="gaussian blend")
57
abline(v=60, col="red", lty=2)
58

    
59

    
60
#
61
# plot latitudinal profiles of RMSE
62
#
63

    
64
# simple helper function to calculate row-wise RMSEs
65
rmse <- function(r1, r2, na.rm=TRUE) {
66
    sqrt(rowMeans(as.matrix((r1 - r2)^2), na.rm=na.rm))
67
}
68

    
69
par(mfrow=c(2,3), omi=c(1,1,1,1))
70

    
71
ylim <- c(0, 170)
72

    
73
# ...with respect to ASTER
74
plot(lats300, rmse(s.uncor, s.aster), type="l", xlab="Latitude",
75
    ylab="RMSE", ylim=ylim)
76
lines(lats150, rmse(crop(s.uncor, extent(s.srtm)), s.srtm), col="blue")
77
legend("topright", legend=c("ASTER", "SRTM"), col=c("black", "blue"),
78
    lty=c(1, 1), bty="n")
79
text(min(lats300), max(ylim)-5, pos=4, font=3, labels="uncorrected")
80
abline(v=60, col="red", lty=2)
81
mtext(expression(paste(
82
    "Aspect discrepancies with respect to separate ASTER/SRTM components (",
83
    136*degree, "W to ", 96*degree, "W)")), adj=0, line=2, font=2)
84

    
85
plot(lats300, rmse(s.eramp, s.aster), type="l", xlab="Latitude",
86
    ylab="RMSE", ylim=ylim)
87
lines(lats150, rmse(crop(s.eramp, extent(s.srtm)), s.srtm), col="blue")
88
legend("topright", legend=c("ASTER", "SRTM"), col=c("black", "blue"),
89
    lty=c(1, 1), bty="n")
90
text(min(lats300), max(ylim)-5, pos=4, font=3, labels="exponential ramp")
91
abline(v=60, col="red", lty=2)
92

    
93
plot(lats300, rmse(s.bg, s.aster), type="l", xlab="Latitude",
94
    ylab="RMSE", ylim=ylim)
95
lines(lats150, rmse(crop(s.bg, extent(s.srtm)), s.srtm), col="blue")
96
legend("topright", legend=c("ASTER", "SRTM"), col=c("black", "blue"),
97
    lty=c(1, 1), bty="n")
98
text(min(lats300), max(ylim)-5, pos=4, font=3, labels="gaussian blend")
99
abline(v=60, col="red", lty=2)
100

    
101
# ...with respect to CDEM
102
plot(lats300, rmse(s.uncor, s.can), type="l", xlab="Latitude",
103
    ylab="RMSE", ylim=ylim)
104
text(min(lats300), max(ylim)-5, pos=4, font=3, labels="uncorrected")
105
abline(v=60, col="red", lty=2)
106
mtext(expression(paste(
107
    "Aspect discrepancies with respect to Canada DEM (",
108
    136*degree, "W to ", 96*degree, "W)")), adj=0, line=2, font=2)
109

    
110
plot(lats300, rmse(s.eramp, s.can), type="l", xlab="Latitude",
111
    ylab="RMSE", ylim=ylim)
112
text(min(lats300), max(ylim)-5, pos=4, font=3, labels="exponential ramp")
113
abline(v=60, col="red", lty=2)
114

    
115
plot(lats300, rmse(s.bg, s.can), type="l", xlab="Latitude",
116
    ylab="RMSE", ylim=ylim)
117
text(min(lats300), max(ylim)-5, pos=4, font=3, labels="gaussian blend")
118
abline(v=60, col="red", lty=2)
119

    
120

    
121
#
122
# plot latitudinal profiles of correlation coefficients
123
#
124

    
125
# simple helper function to calculate row-wise correlation coefficients
126
corByLat <- function(r1, r2, rows) {
127
    if (missing(rows)) {
128
        rows <- 1:nrow(r1)
129
    }
130
    m1 <- as.matrix(r1)
131
    m2 <- as.matrix(r2)
132
    sapply(rows, function(row) cor(m1[row,], m2[row,],
133
        use="pairwise.complete.obs"))
134
}
135

    
136
par(mfrow=c(2,3), omi=c(1,1,1,1))
137

    
138
ylim <- c(0, 1)
139

    
140
# ...with respect to ASTER
141
plot(lats300, corByLat(s.uncor, s.aster), type="l", xlab="Latitude",
142
    ylab="Correlation", ylim=ylim)
143
lines(lats150, corByLat(crop(s.uncor, extent(s.srtm)), s.srtm), col="blue")
144
legend("bottomright", legend=c("ASTER", "SRTM"), col=c("black", "blue"),
145
    lty=c(1, 1), bty="n")
146
text(min(lats300), min(ylim), pos=4, font=3, labels="uncorrected")
147
abline(v=60, col="red", lty=2)
148
mtext(expression(paste(
149
    "Aspect correlations with respect to separate ASTER/SRTM components (",
150
    136*degree, "W to ", 96*degree, "W)")), adj=0, line=2, font=2)
151

    
152
plot(lats300, corByLat(s.eramp, s.aster), type="l", xlab="Latitude",
153
    ylab="Correlation", ylim=ylim)
154
lines(lats150, corByLat(crop(s.eramp, extent(s.srtm)), s.srtm), col="blue")
155
legend("bottomright", legend=c("ASTER", "SRTM"), col=c("black", "blue"),
156
    lty=c(1, 1), bty="n")
157
text(min(lats300), min(ylim), pos=4, font=3, labels="exponential ramp")
158
abline(v=60, col="red", lty=2)
159

    
160
plot(lats300, corByLat(s.bg, s.aster), type="l", xlab="Latitude",
161
    ylab="Correlation", ylim=ylim)
162
lines(lats150, corByLat(crop(s.bg, extent(s.srtm)), s.srtm), col="blue")
163
legend("bottomright", legend=c("ASTER", "SRTM"), col=c("black", "blue"),
164
    lty=c(1, 1), bty="n")
165
text(min(lats300), min(ylim), pos=4, font=3, labels="gaussian blend")
166
abline(v=60, col="red", lty=2)
167

    
168
# ...with respect to CDEM
169
plot(lats300, corByLat(s.uncor, s.can), type="l", xlab="Latitude",
170
    ylab="Correlation", ylim=ylim)
171
text(min(lats300), min(ylim), pos=4, font=3, labels="uncorrected")
172
abline(v=60, col="red", lty=2)
173
mtext(expression(paste(
174
    "Aspect correlations with respect to Canada DEM (",
175
    136*degree, "W to ", 96*degree, "W)")), adj=0, line=2, font=2)
176

    
177
plot(lats300, corByLat(s.eramp, s.can), type="l", xlab="Latitude",
178
    ylab="Correlation", ylim=ylim)
179
text(min(lats300), min(ylim), pos=4, font=3, labels="exponential ramp")
180
abline(v=60, col="red", lty=2)
181

    
182
plot(lats300, corByLat(s.bg, s.can), type="l", xlab="Latitude",
183
    ylab="Correlation", ylim=ylim)
184
text(min(lats300), min(ylim), pos=4, font=3, labels="gaussian blend")
185
abline(v=60, col="red", lty=2)
186

    
187
# close pdf device driver
188
dev.off()
    (1-1/1)