Re: [R] Asking Favor For the Script of Median Filter

From: robleaf <robert.t.leaf_at_gmail.com>
Date: Thu, 12 May 2011 06:33:48 -0700 (PDT)

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.

______________________________________________
R-help_at_r-project.org mailing list
https://stat.ethz.ch/mailman/listinfo/r-help
PLEASE do read the posting guide http://www.R-project.org/posting-guide.html
and provide commented, minimal, self-contained, reproducible code.
Received on Thu 12 May 2011 - 14:56:41 GMT

This quarter's messages: by month, or sorted: [ by date ] [ by thread ] [ by subject ] [ by author ]

All messages

Archive maintained by Robert King, hosted by the discipline of statistics at the University of Newcastle, Australia.
Archive generated by hypermail 2.2.0, at Thu 12 May 2011 - 15:00:06 GMT.

Mailing list information is available at https://stat.ethz.ch/mailman/listinfo/r-help. Please read the posting guide before posting to the list.

list of date sections of archive