[Zooimage-commits] r119 - pkg/zooimage/R
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Mon Apr 27 15:06:41 CEST 2009
Author: romain
Date: 2009-04-27 15:06:40 +0200 (Mon, 27 Apr 2009)
New Revision: 119
Modified:
pkg/zooimage/R/zie.r
Log:
tidy things up
Modified: pkg/zooimage/R/zie.r
===================================================================
--- pkg/zooimage/R/zie.r 2009-04-27 12:57:30 UTC (rev 118)
+++ pkg/zooimage/R/zie.r 2009-04-27 13:06:40 UTC (rev 119)
@@ -720,7 +720,7 @@
# Possibly get Nmin and Nmax from the template file
Nmin <- Nrange[1] # Min number of images for each sample
- Nmax <- Nrange[2] # Max number of images for each sample
+ Nmax <- Nrange[2] # Max number of images for each sample
# We start from the template
file.copy(Template, Filemap, overwrite = TRUE)
@@ -728,13 +728,13 @@
Cat("\n")
Cat("[Map]\n")
- CBF <- -1
- CBFNum <- 0
- COD <- -1
- CODNum <- 0
- CSp <- -1
- CSpNum <- 0
- for (i in 1:nrow(Data)) {
+
+ CBF <- -1 ; CBFNum <- 0
+ COD <- -1 ; CODNum <- 0
+ CSp <- -1 ; CSpNum <- 0
+
+ for (i in 1:nrow(Data)) {
+
# Get calibration data
CalibBF <- Data$CalibBF[i]
if (!is.na(CalibBF) && !is.null(CalibBF) && CalibBF != "" && CalibBF != CBF) {
@@ -743,6 +743,7 @@
Cat(text, "\n")
CBF <- CalibBF
}
+
CalibOD <- Data$CalibOD[i]
if (!is.na(CalibOD) && !is.null(CalibOD) && CalibOD != "" && CalibOD != COD) {
CODNum <- CODNum + 1
@@ -750,6 +751,7 @@
Cat(text, "\n")
COD <- CalibOD
}
+
CalibSp <- Data$CalibSP[i]
if (!is.na(CalibSp) && !is.null(CalibSp) && CalibSp != "" && CalibSp != CSp) {
CSpNum <- CSpNum + 1
@@ -757,8 +759,9 @@
Cat(text, "\n")
CSp <- CalibSp
}
+
+ # Calculate list of all images
num <- Data$Image[i]
- # Calculate list of all images
num <- gsub(";", ",", num, extended = FALSE)
num <- gsub("-", ":", num, extended = FALSE)
num <- paste("c(", num, ")", sep = "")
@@ -782,6 +785,7 @@
}
}
}
+
#Insert corresponding images
for (j in 1:length(num)) {
text <- paste(num[j], "=.", j, sep = "")
@@ -797,8 +801,9 @@
file.rename(Tablefile, file.path(path, "_raw", basename(Tablefile)))
# Move also possibly the .xls equivalent
Tablexls <- sub("\\.[tT][xX][tT]$", ".xls", Tablefile)
- if (Tablexls != Tablefile && file.exists(Tablexls))
+ if (Tablexls != Tablefile && file.exists(Tablexls)){
file.rename(Tablexls, file.path(path, "_raw", basename(Tablexls)))
+ }
file.rename(Template, file.path(path, "_raw", basename(Template)))
}
}
@@ -869,8 +874,9 @@
dif <- "Not same size for both Exif data!"
} else {
difpos <- sort(Exif1) != sort(Exif2)
- if (any(difpos))
+ if (any(difpos)){
dif <- "Exif data are not identical!"
+ }
}
return(dif)
}
@@ -898,7 +904,9 @@
checkFileExists( BFfile, "Blank-field file '%s' not found!")
# Is it a test file?
- if (isTestFile(BFfile)) return(character(0)) # We behave like if the file was correct!
+ if (isTestFile(BFfile)){
+ return(character(0)) # We behave like if the file was correct!
+ }
msg <- character(0)
filedir <- dirname(BFfile)
@@ -934,18 +942,24 @@
# Look at darkest value with at least 10 points
BF <- BF[BF$Count >= 10, ]
darkpart <- min(BF$Count)
+
# Eliminate values with low number of points
BF <- BF[BF$Count >= 100, ]
+
# Check range for these values
rngBF <- range(BF$Gray)
- if (rngBF[2] > 65500)
+ if (rngBF[2] > 65500){
msg <- c(msg, "Blank-field is overexposed")
- if (rngBF[2] < 60000)
+ }
+ if (rngBF[2] < 60000){
msg <- c(msg, "Blank-field is underexposed or contains too dark areas")
- if ((rngBF[2] - rngBF[1]) > 15000)
- msg <- c(msg, "Blank-field is too heterogeneous")
- if ((rngBF[1] - darkpart) > 15000)
+ }
+ if ((rngBF[2] - rngBF[1]) > 15000){
+ msg <- c(msg, "Blank-field is too heterogeneous")
+ }
+ if ((rngBF[1] - darkpart) > 15000){
msg <- c(msg, "Blank-field contains dark zones (dust?)")
+ }
}
return(msg)
}
@@ -988,6 +1002,7 @@
on.exit(setwd(inidir))
ODfile <- basename(ODfile)
}
+
# The command to use depends on the format of the image (determined on the extension)
ext <- tolower(rev(strsplit(ODfile, "\\.")[[1]])[1])
pgmfile <- ODfile
@@ -1009,18 +1024,24 @@
} else {
# Eliminate values with low number of points
OD <- OD[OD$Count > 100, ]
+
# Look at range: should be widespread enough, but without saturation
rngOD <- range(OD$Gray)
- if (rngOD[2] > 65500)
+ if (rngOD[2] > 65500){
msg <- c(msg, "Images are overexposed, or whitepoint is already calibrated")
- if (rngOD[2] < 55000)
+ }
+ if (rngOD[2] < 55000){
msg <- c(msg, "Images are underexposed")
+ }
+
# Here, saturation on the left-side of the histogram is not much a problem!
- if (rngOD[2] - rngOD[1] < 40000)
- msg <- c(msg, "Images lack contrast")
+ if (rngOD[2] - rngOD[1] < 40000){
+ msg <- c(msg, "Images lack contrast")
+ }
# We should end up with four segments
graylev <- OD$Gray
gap <- (diff(graylev) > 500)
+
# If there are not *exactly* four gaps, there is a problem with the image!
if (sum(gap) != 4) {
msg <- c(msg, "Impossible to calibrate O.D.: wrong image")
@@ -1029,52 +1050,72 @@
peaks <- as.factor(cumsum(c(0, gap)) + 1)
peaksgray <- split(graylev, peaks)
names(peaksgray) <- c("Black", "NDx8", "NDx4", "NDx2", "White")
+
# These are supposed to be all narrow peaks... check this
peakspan <- sapply(peaksgray, range)
peaksrange <- peakspan[2, ] - peakspan[1, ]
+
# 1.2-2: width of black peak is much larger for Epson 4990 => be more tolerant for that peak
if (any(peaksrange > c(20000, rep(5000, 4)))) {
wrongpeaks <- paste(names(peaksrange)[peaksrange > 5000], collapse = ", ")
msg <- c(msg, paste("Wrong O.D. image: lack of homogeneity for", wrongpeaks))
}
+
# Look for the gray levels at the top of the peaks
peaksheight <- split(OD$Count, peaks)
names(peaksheight) <- c("Black", "NDx8", "NDx4", "NDx2", "White")
findmax <- function(x) which.max(lowess(x, f = 0.05, iter = 1)$y)
peaksval <- sapply(peaksheight, findmax)
+
# Get the number of pixels in the white peak
nbrwhite <- peaksheight$White[peaksval["White"]]
- # Replace the location by the actual gray level
+
+ # Replace the location by the actual gray level
for (i in 1:5) peaksval[i] <- peaksgray[[i]][peaksval[i]]
# If the number of pixels for pure white is larger than the white
- # peak found, replace it by pure white (65535)
- nbrpurewhite <- OD[nrow(OD), 2]
- if (nbrpurewhite > nbrwhite) peaksval["White"] <- 65535
+ # peak found, replace it by pure white (65535)
+ nbrpurewhite <- OD[nrow(OD), 2]
+ if (nbrpurewhite > nbrwhite){
+ peaksval["White"] <- 65535
+ }
+
# Now, we need to calibrate the black and white points
WhitePoint <- 65535 - peaksval["White"]
+
# Perform a correction for the white point
peaksval <- peaksval + WhitePoint
+
# Transform those gray levels into O.D.
peaksOD <- log(peaksval) * 65535 / log(65535)
+
# Create a data frame with gray levels and corresponding OD for White, NDx2, NDx4 and NDx8
calib <- data.frame(Gray = peaksOD[5:2], OD = c(0, 0.3, 0.6, 0.9))
+
# Fit a line on these data
calib.lm <- lm(OD ~ Gray, data = calib)
+
# Check that calibration line is fine (i.e., the ANOVA should reject H0 at alpha = 5%)
- if (anova(calib.lm)[["Pr(>F)"]][1] > 0.01)
+ if (anova(calib.lm)[["Pr(>F)"]][1] > 0.01){
msg <- c(msg, "Wrong OD calibration: not a straight line relation at alpha level = 0.01")
+ }
+
# Check also that R squared is at least 0.98
rsq <- summary(calib.lm)$r.squared
- if (rsq < 0.98)
+ if (rsq < 0.98){
msg <- c(msg, paste("Bad OD calibration (R squared = ", formatC(rsq, digits = 3), ")", sep = ""))
+ }
+
# Check linearity of the relationship by fitting a second order polynome and by looking at the
# significativity of the x square parameter
calib2.lm <- lm(OD ~ I(Gray^2) + Gray, data = calib)
- if (summary(calib2.lm)$coefficients["I(Gray^2)", "Pr(>|t|)"] < 0.01)
+ if (summary(calib2.lm)$coefficients["I(Gray^2)", "Pr(>|t|)"] < 0.01){
msg <- c(msg, "Nonlinear OD calibration at alpha level = 0.01")
+ }
+
# Calculate the value of the black point to get 0.004 OD per gray level after conversion (see the manual)
ccoef <- coef(calib.lm)
BlackPoint <- (1.024 - ccoef[1]) / ccoef[2]
+
# Get the calibration data
cal[1] <- round(WhitePoint)
cal[2] <- round(BlackPoint)
@@ -1131,10 +1172,10 @@
# }}}
# {{{ Determine the name of the various files
- imgFile <- paste(noext(File), "img", sep = ".")
+ imgFile <- paste(noext(File), "img", sep = ".")
imgcorrFile <- paste(noext(File), "coor.img", sep = "")
- tifFile <- paste(noext(File), "tif", sep = ".")
- imgBFfile <- paste(noext(basename(BFfile)), "img", sep = ".")
+ tifFile <- paste(noext(File), "tif", sep = ".")
+ imgBFfile <- paste(noext(basename(BFfile)), "img", sep = ".")
if (isWin()) {
BFfile <- shortPathName(BFfile)
}
More information about the Zooimage-commits
mailing list