Revision b67964e8
Added by Rick Reeves over 13 years ago
- ID b67964e8299b485c18e82f03e5748e9ad8591d0e
terrain/rscripts/makeMarkTable.r | ||
---|---|---|
1 |
############################################################################################## |
|
2 |
# |
|
3 |
# makeMarkTable.r |
|
4 |
# |
|
5 |
# R script generates table of adjacent ASTER / SRTM / Mosaic Border / CDEM pixel values |
|
6 |
# to be used to generate plots of 'delta elevation' vs 'pixel pair proximity' and 'elevation' |
|
7 |
# suggested by Mark Schildhauer on May 3. |
|
8 |
# |
|
9 |
# Author: Rick Reeves, NCEAS |
|
10 |
# May 4, 2011 |
|
11 |
############################################################################################## |
|
12 |
# |
|
13 |
makeMarkTable <- function() |
|
14 |
{ |
|
15 |
require(raster) |
|
16 |
require(rgdal) |
|
17 |
|
|
18 |
#inputFirstRaster <- raster(sFirstImageName) |
|
19 |
#inputSecondRaster <- raster(sSecondImageName) |
|
20 |
|
|
21 |
inputCgiarRaster <- raster("/data/project/organisms/rcr/AsterCgiarMerge/mergeCgiarAsterBdySRTM_BL.tif") |
|
22 |
inputAsterRaster <- raster("/data/project/organisms/rcr/AsterCgiarMerge/mergeCgiarAsterBdyASTER_BL.tif") |
|
23 |
inputMosaicRaster <- raster("/data/project/organisms/rcr/ValidateBoundary/mergeCgiarAsterBdyTuesdayClip.tif") |
|
24 |
inputCDEMRaster <- raster("/data/project/organisms/rcr/ValidateBoundary/CDemMosTuesdayClipMergeSpace.tif") |
|
25 |
# |
|
26 |
# Difference image for entire merged image takes a while to create, |
|
27 |
# so we created it once, now read it back in. |
|
28 |
# |
|
29 |
rDeltaWhole <- raster("/data/project/organisms/rcr/ValidateBoundary/DeltaEntireImage.tif") |
|
30 |
rDeltaWhole@data@values <-getValues(rDeltaWhole) |
|
31 |
|
|
32 |
# Create extent objects used to extract raster subimges. |
|
33 |
# The object will be centered along the 60 degree North latitude line, |
|
34 |
# and have varying depths (number of rows). |
|
35 |
# The Western Canada study area runs from -135 (west) to -100 (west) longitude, |
|
36 |
# and 55.0 to 64.00 degrees (north) latitude. |
|
37 |
# the ASTER and SRTM/CGIAR image components are merged at the 60 Deg N Latitude line. |
|
38 |
|
|
39 |
#eTestAreaExtent <- extent(-135.2,-100.2, 59.997,60.001) # Creates a 5 row subimage |
|
40 |
eTestAreaExtent <- extent(-135.2,-100.2, 59.995,60.005) # Creates a 12 row subimage |
|
41 |
|
|
42 |
# Extract a sub image corresponding to the selected extent. |
|
43 |
# Two different alternatives: |
|
44 |
# The extract() function returns a vector of cell values, |
|
45 |
# the crop() function returns a complete raster* object. |
|
46 |
|
|
47 |
#vEdgeRegionMosaic <- extract(inputMosaicRaster,eTestAreaExtent) |
|
48 |
#vEdgeRegionCDEM <- extract(inputCDEMRaster,eTestAreaExtent) |
|
49 |
|
|
50 |
rEdgeRegionAster <- crop(inputAsterRaster,eTestAreaExtent) |
|
51 |
rEdgeRegionCgiar <- crop(inputCgiarRaster,eTestAreaExtent) |
|
52 |
rEdgeRegionMosaic <- crop(inputMosaicRaster,eTestAreaExtent) |
|
53 |
rEdgeRegionCDEM <- crop(inputCDEMRaster,eTestAreaExtent) |
|
54 |
|
|
55 |
# Important: In order for the image subtraction to work, the extents |
|
56 |
# of the two images must be IDENTICAL. I used ArcMap GIS Raster Crop By Mask |
|
57 |
# to create subimages with identical extents. |
|
58 |
|
|
59 |
# Compute the difference image for the entire study area, and for the region along |
|
60 |
# the boundary (narrow, maybe 10 pixels either side) |
|
61 |
|
|
62 |
rEdgeRegionDelta <- rEdgeRegionMosaic - rEdgeRegionCDEM # not used in this version (yet) |
|
63 |
|
|
64 |
# Create this image one time, read it in thereafter. |
|
65 |
#rDeltaWhole <- inputMosaicRaster - inputCDEMRaster |
|
66 |
#writeRaster(rDeltaWhole,filename="DeltaMosaicCDEMSubmage.tif",format="GTiff",datatype="INT2S",overwrite=TRUE) |
|
67 |
|
|
68 |
# Using the large difference image, compute subimagee statistics for areas |
|
69 |
# North (ASTER) and South (SRTM) of the boundary. These give us an idea |
|
70 |
# re: differences between ASTER and CDEM and CGIAR/SRT and CDEM |
|
71 |
# what is raster package way of using subscripts to extract? |
|
72 |
|
|
73 |
# Now, the interesting part: using the boundary difference image, randomly select |
|
74 |
# one-degree N-S strips throughout the image, and compare adjacent pixel pairs |
|
75 |
# above and below the boundary with pixel pairs straddling the boundary. Subtract |
|
76 |
# the pairs, save the collection of (absolute value) of the differences in a vector, |
|
77 |
# so that we have a population of differences above, below, and straddling the boundary |
|
78 |
# line. Compare the populations. |
|
79 |
|
|
80 |
# get a vector of random column index numbers, constrained by column dimension of image |
|
81 |
# Loop three times, sampling pixel pairs from above, below, across the border |
|
82 |
|
|
83 |
nColsToGet <- 1000 |
|
84 |
iDiffVecNorth <- vector(mode="integer",length=nColsToGet) |
|
85 |
iDiffVecBorder <- vector(mode="integer",length=nColsToGet) |
|
86 |
iDiffVecSouth <- vector(mode="integer",length=nColsToGet) |
|
87 |
|
|
88 |
#colsToGet <-sample(1:50,nColsToGet) |
|
89 |
|
|
90 |
# Note: initially, sample the same columns in all regions to get a profile. |
|
91 |
# other 'sample()' calls can be commented out to sample differenct |
|
92 |
# coluns in each 'region'. |
|
93 |
|
|
94 |
# iDiffVecxxxx is a population of differences between adjacent cell pairs. |
|
95 |
# Compute iDiffVecNorth/Border/South on either side of border, and across it. |
|
96 |
# note that North and South samples taken from larger difference image for |
|
97 |
# entire mosaic (sub) image; iDiffBorder taken from the edge region extracted |
|
98 |
# from the center of the lerger image. |
|
99 |
|
|
100 |
# Remember, we are sampling a PAIR of pixels (same column from two adjacent rows) |
|
101 |
|
|
102 |
#browser() |
|
103 |
# debug |
|
104 |
#nColsToGet <- 2 |
|
105 |
#colsToGet <- c(20,100) |
|
106 |
#iFirstRow <- 300 |
|
107 |
#iCtr = 1 |
|
108 |
#for (iNextCol in colsToGet) |
|
109 |
#{ |
|
110 |
# rColVec <- cellFromRowCol(rDeltaWhole,iFirstRow:(iFirstRow+1),iNextCol:iNextCol) |
|
111 |
# neighborCells <- rDeltaWhole@data@values[rColVec] |
|
112 |
# iDiffVecNorth[iCtr] <- neighborCells[2] - neighborCells[1] |
|
113 |
#iCtr = iCtr + 1 |
|
114 |
#} |
|
115 |
# |
|
116 |
|
|
117 |
# Here is the output matrix, (nColSamples * 3) rows, four columns |
|
118 |
colsToGet <-sample(1:inputMosaicRaster@ncols,nColsToGet) |
|
119 |
message("North Sample") |
|
120 |
|
|
121 |
mOutTable <- matrix(nrow=(nColsToGet * 3), ncol=5) |
|
122 |
colnames(mOutTable) <- c("ColumnID","elevNorth","elevSouth","cdemNorth","cdemSouth") |
|
123 |
# in this difference image, the border edge occurs at column 6 |
|
124 |
message("Border Sample - different columns") |
|
125 |
#browser() |
|
126 |
#colsToGet <-sample(1:inputFirstRaster@ncols,nColsToGet) |
|
127 |
iFirstRow <- 4 # two rows before the border |
|
128 |
iLastRow <- 7 # two rows after the border |
|
129 |
iRowCtr = 1 # points to latest output table being written |
|
130 |
for (iNextCol in colsToGet) |
|
131 |
{ |
|
132 |
rColVecAster <- cellFromRowCol(rEdgeRegionAster,iFirstRow:(iLastRow),iNextCol:iNextCol) |
|
133 |
rColVecCgiar <- cellFromRowCol(rEdgeRegionCgiar,iFirstRow:(iLastRow),iNextCol:iNextCol) |
|
134 |
rColVecMosaic <- cellFromRowCol(rEdgeRegionMosaic,iFirstRow:(iLastRow),iNextCol:iNextCol) |
|
135 |
rColVecCDEM <- cellFromRowCol(rEdgeRegionCDEM,iFirstRow:(iLastRow),iNextCol:iNextCol) |
|
136 |
|
|
137 |
# Split the column vector into the pairs that Mark requested |
|
138 |
# For each column sampled, the output table has three rows: |
|
139 |
# |
|
140 |
# Row 1: from (input) Aster layer: Two pixels above border |
|
141 |
# Row 2: from (input) Mosaic layer: Two pixels straddling border |
|
142 |
# Row 3: from (input) Cgiar layer: Two pixels below border |
|
143 |
# |
|
144 |
# each with four columns, arranged into two column pairs: |
|
145 |
# |
|
146 |
# North Pixel and South Pixel elevation, North Pixel and South Pixel CDEM (baseline) |
|
147 |
# |
|
148 |
mOutTable[iRowCtr][1] <- iNextCol # The (radomly sampled) col ID (surrogate for longitude) |
|
149 |
mOutTable[iRowCtr][2:3] <- rColVecAster[1:2] # First column pair from extracted vector: |
|
150 |
mOutTable[iRowCtr][4:5] <- rColVecCDEM[1:2] # entirely top (ASTER) image |
|
151 |
iRowCtr = iRowCtr + 1 |
|
152 |
# |
|
153 |
mOutTable[iRowCtr][1] <- iNextCol # The (radomly sampled) col ID (surrogate for longitude) |
|
154 |
mOutTable[iRowCtr][2:3] <- rColVecMosaic[3:4] # Second column pair: |
|
155 |
mOutTable[iRowCtr][4:5] <- rColVecCDEM[3:4] # straddles border region (from Mosaic image) |
|
156 |
iRowCtr = iRowCtr + 1 |
|
157 |
# |
|
158 |
mOutTable[iRowCtr][1] <- iNextCol # The (radomly sampled) col ID (surrogate for longitude) |
|
159 |
mOutTable[iRowCtr][2:3] <- rColVecCgiar[5:6] # third column pair: |
|
160 |
mOutTable[iRowCtr][4:5] <- rColVecCDEM[5:6] # entirely bottom (SRTM) image |
|
161 |
iRowCtr = iRowCtr + 1 |
|
162 |
# |
|
163 |
} |
|
164 |
# |
|
165 |
# write the table out as CSV file |
|
166 |
# TODO: add the column ID (proximity indicator |
|
167 |
message("hit key to write output table..") |
|
168 |
browser() |
|
169 |
writeCSV(mOutTable,file="tableForMark.csv",row.names=FALSE) |
|
170 |
# |
|
171 |
#message("South Sample - different columns") |
|
172 |
#browser() |
|
173 |
#colsToGet <-sample(1:inputFirstRaster@ncols,nColsToGet) |
|
174 |
#iFirstRow <- 3600 |
|
175 |
#iCtr = 1 |
|
176 |
#for (iNextCol in colsToGet) |
|
177 |
#{ |
|
178 |
# rColVec <- cellFromRowCol(rDeltaWhole,iFirstRow:(iFirstRow+1),iNextCol:iNextCol) |
|
179 |
# neighborCells <- rDeltaWhole@data@values[rColVec] |
|
180 |
# iDiffVecSouth[iCtr] <- neighborCells[2] - neighborCells[1] |
|
181 |
# iCtr = iCtr + 1 |
|
182 |
#} |
|
183 |
# Compute iDiffVecs on either side of border, and across it. |
|
184 |
message("Check the cell difference vectors...") |
|
185 |
#browser() |
|
186 |
|
|
187 |
# summary stats for each population |
|
188 |
|
|
189 |
#sNorthSum <- sprintf("ASTER sample summary: Min: %f / Median: %d / Mean: %f / Max: %f / Variance: %f sDev: %f", |
|
190 |
# min(iDiffVecNorth,na.rm=TRUE),median(iDiffVecNorth,na.rm=TRUE),mean(iDiffVecNorth,na.rm=TRUE), |
|
191 |
# max(iDiffVecNorth,na.rm=TRUE),var(iDiffVecNorth,na.rm=TRUE),sd(iDiffVecNorth,na.rm=TRUE)) |
|
192 |
|
|
193 |
sBorderSum <- sprintf("Border sample summary: Min: %f / Median: %d / Mean: %f / Max: %f / Variance: %f sDev: %f", |
|
194 |
min(iDiffVecBorder,na.rm=TRUE),median(iDiffVecBorder,na.rm=TRUE),mean(iDiffVecBorder,na.rm=TRUE), |
|
195 |
max(iDiffVecBorder,na.rm=TRUE),var(iDiffVecBorder,na.rm=TRUE),sd(iDiffVecBorder,na.rm=TRUE)) |
|
196 |
|
|
197 |
#sSouthSum <- sprintf("STRM sample summary: Min: %f / Median: %d / Mean: %f / Max: %f / Variance: %f sDev: %f", |
|
198 |
# min(iDiffVecSouth,na.rm=TRUE),median(iDiffVecSouth,na.rm=TRUE),mean(iDiffVecSouth,na.rm=TRUE), |
|
199 |
# max(iDiffVecSouth,na.rm=TRUE),var(iDiffVecSouth,na.rm=TRUE),sd(iDiffVecSouth,na.rm=TRUE)) |
|
200 |
# |
|
201 |
message(sprintf("statistics for %d N/S adjacent pixel pairs from three mosaic image regions:",nColsToGet)) |
|
202 |
#message(sNorthSum) |
|
203 |
message(sBorderSum) |
|
204 |
#mssage(sSouthSum) |
|
205 |
|
|
206 |
} |
Also available in: Unified diff
First version, has issues with column indexing, I am fixing tonight.