[R] picture processing

[PIKAL Petr]

I am sorry, pictures did not went through. Using dput is not a way to go, the output file has over 3 MB. I try to find a suitable way where to put those pictures (they have about 100 kB) for you to be able to use the code.

Petr


> -----Original Message-----
> From: r-help-bounces at r-project.org [mailto:r-help-bounces at r-
> project.org] On Behalf Of PIKAL Petr
> Sent: Monday, January 21, 2013 10:01 AM
> To: r-help
> Subject: [R] picture processing
> 
> Dear all
> 
> I try to evaluate pictures and find positions, size and amount of
> dropouts (I enclose two pictures to play with and a code I used below).
> You can see that the first picture is smooth with only few dropouts in
> entire area. The second picture has many dropouts and even a scratch,
> with number of dropouts increasing to the bottom of the picture.
> 
> I go through the picture row by row and find a differences from supsmu
> or linear model, compare the differences to some threshold and count
> number of positive differences in the row, but here I am stuck.
> 
> I could find position of overall increased dropouts by smoothing
> rowSums data and evaluate this smoothed value but I do not know
> 
> 1	How to distinct between big and small dropouts
> 2	Distinct between scratch and dropout and find starting position
> of a scratch
> 3	Find number of small dropouts and find position where this number
> of small dropouts surpass some given threshold
> 
> I tried to play with rle but had not been successful yet.
> 
> If anybody has some clever idea how to proceed with those three tasks I
> will be grateful.
> 
> Best regards
> Petr
> 
> library(ReadImages)
> # read and plot those 2 images
> temp1<-read.jpeg("temp1.jpg")
> temp1<-rgb2grey(temp1)
> temp1<-normalize(temp1)
> temp2<-read.jpeg("temp2.jpg")
> temp2<-rgb2grey(temp2)
> temp2<-normalize(temp2)
> par(mfrow=c(1,2))
> plot(temp1)
> plot(temp2)
> 
> # one possible way to evaluate dropouts
> suma<-NA
> for(i in 1:nrow(temp1)) suma[i]<-sum(((temp1[i,]-
> supsmu(1:ncol(temp1),temp1[i,])$y)^2>.0005))
> plot(suma)
> 
> suma<-NA
> for(i in 1:nrow(temp2)) suma[i]<-sum(((temp2[i,]-
> supsmu(1:ncol(temp2),temp2[i,])$y)^2>.0005))
> plot(suma)
> 
> # the other way to evaluate dropouts
> x<-1:ncol(temp1)
> rozdil<-temp1
> for( i in 1:nrow(temp1)) {
> y<-temp1[i,]
> fit<-lm(y~x)
> rozdil[i,] <- (predict(fit)-y)^2}
> plot(rowSums(rozdil>.01))
> 
> x<-1:ncol(temp2)
> rozdil<-temp2
> for( i in 1:nrow(temp2)) {
> y<-temp2[i,]
> fit<-lm(y~x)
> rozdil[i,] <- (predict(fit)-y)^2}
> plot(rowSums(rozdil>.01))