[R] Asking Favor For the Script of Median Filter

robleaf robert.t.leaf at gmail.com
Thu May 12 15:33:48 CEST 2011


Here is one I wrote for the raster package. It searches a raster layer for
NA's and takes the median of the number of non NA adjacent cells determined
by neighbor count. You could turn your matrix into a raster to make it work
or change the code.

Hope you find it useful, Robert

neighbor.filter <- function(raster.layer,neighbor.count = 3)     {

require(raster)

base.rast <- raster.layer
count <- 1
NA.ind <- which(is.na(base.rast[]))
median.vals <- matrix(NA,length(NA.ind),3)
for (j in 1:length(NA.ind)) {

row.ind.NA <- rowFromCell(base.rast, NA.ind[j])
col.ind.NA <- colFromCell(base.rast, NA.ind[j])

row.ind <- c(row.ind.NA-1,row.ind.NA,row.ind.NA+1)
col.ind <- c(col.ind.NA-1,col.ind.NA,col.ind.NA+1)

row.ind.check <- expand.grid(row.ind,col.ind)[,1]
col.ind.check <- expand.grid(row.ind,col.ind)[,2]

ind.del.1 <- c(which(row.ind.check > dim(base.rast)[1]),which(row.ind.check
< 1))
if (length(ind.del.1) > 0) {
row.ind.check <- row.ind.check[-ind.del.1]
col.ind.check <- col.ind.check[-ind.del.1]  }

ind.del.2 <- c(which(col.ind.check < 1),which(col.ind.check >
dim(base.rast)[2]))
if (length(ind.del.2) > 0) {
row.ind.check <- row.ind.check[-ind.del.2]
col.ind.check <- col.ind.check[-ind.del.2]  }

if (length(which(base.rast[cellFromRowCol(base.rast, row.ind.check,
col.ind.check)] > 0)) >= neighbor.count) {

median.vals[count,c(1:3)] <- c(NA.ind[j],
                           median(base.rast[cellFromRowCol(base.rast,
row.ind.check, col.ind.check)], na.rm = T),
                           length(which(base.rast[cellFromRowCol(base.rast,
row.ind.check, col.ind.check)] > 0)))
count <- count + 1
}
}

median.vals <- median.vals[which(median.vals[,1] > 0),]
base.rast[median.vals[,1]] <- median.vals[,2]

return(base.rast)  }


Robert Leaf, PhD
NOAA Narragansett Laboratory

--
View this message in context: http://r.789695.n4.nabble.com/Asking-Favor-For-the-Script-of-Median-Filter-tp3409462p3517365.html
Sent from the R help mailing list archive at Nabble.com.



More information about the R-help mailing list