Other potential sources of variability of SpectroRasp spectra

• Agustin.Lobo@geo3bcn.csic.es
• 20221222, 20230103, 20230109, 20230206

Click on “Code” symbols to unfold code (folded by default).

require(ggplot2)
require(grid)
require(gridExtra)
require(gganimate)
require(plotly)
require(lubridate)
require(colorRamps)
require(lmodel2)
require(broom)
require(pander)
source("selSessionRefs.R")
#Certified
load("/home/alobo/owncloudRSpect/RSpect/RefMCAA01.rda")
#load("C:/Users/Specim/ownCloud/RSpect/RefMCAA01.rda")

3. Other potential sources of variability (20230110 data)

3.1 Size of White reference (20230123 data)

Given the similar size of the small white reference () and the probe, we conjectured that some variability at positioning the white reference under the probe could imply a variable part of the black casing interfering the white reading. Nevertheless, results show that while there is a notorious difference in the mean because the larger White reference () is not as bright as the small one (see SpR_Wcomparison_np.Rmd), the standard deviations are very similar.

#with/without monitor
fdir <- "../Test20230110"
lista <- data.frame(fname=list.files(fdir, patt=glob2rx("*.txt")), fdir=fdir)[7:16,]
selRefs <- selSessionRefs(selflist=lista)
selRefs$W <- selRefs$sample
selRefs$W <- plyr::mapvalues(selRefs$sample, from=unique(selRefs$sample), to=rep(c("Big W", "Small W"),c(5,5) ))

d <- selRefs[,c(1:6,15)]
ds <- plyr::ddply(d, c("W","Wavelength"), summarise, 
                  Reflectance.m = mean(Reflectance), Reflectance.sd = sd(Reflectance),
                  Radiance.m = mean(Radiance-Dark), Radiance.sd = sd(Radiance-Dark),
                  WRadiance.m = mean(WhiteRad), WRadiance.sd = sd(WhiteRad))

# ggRefl <- ggplot(ds) +
#   geom_point(aes(x=Wavelength, y=Reflectance.m, color=W)) +
#   geom_line(aes(x=Wavelength, y=Reflectance.m+Reflectance.sd, color=W)) +
#   geom_line(aes(x=Wavelength, y=Reflectance.m-Reflectance.sd, color=W)) +
#   ylab("Reflectance (mean +/- sd)") +
#   ggtitle("Standard reference")
# ggRefl + xlim(c(1500, 2000))
# #+ylim(c(25000, 50000))
# 
# RadStd <- ggplot(ds) +
#   geom_point(aes(x=Wavelength, y=Radiance.m, color=W)) +
#   geom_line(aes(x=Wavelength, y=Radiance.m+Radiance.sd, color=W)) +
#   geom_line(aes(x=Wavelength, y=Radiance.m-Radiance.sd, color=W)) +
#   ylab("Radiance (averag +/- sd)") +
#   ggtitle("Standard reference")
# RadStd+xlim(c(1500, 2000))+ylim(c(25000, 50000))
 
 
RadW <- ggplot(ds) +
   geom_point(aes(x=Wavelength, y=WRadiance.m, color=W))+
   geom_line(aes(x=Wavelength, y=WRadiance.m + WRadiance.sd, color=W)) +
   geom_line(aes(x=Wavelength, y=WRadiance.m - WRadiance.sd, color=W)) +
   ylab("Radiance (averag +/- sd)") +
   ggtitle("White references")
RadW

RadW+xlim(c(1500, 2000))+ylim(c(30000, 50000))

# grid.arrange(RadStd, RadW, RadStd+xlim(c(1500, 2000))+ylim(c(25000, 50000)),  RadW+xlim(c(1500, 2000))+ylim(c(25000, 50000)))

3.2 Instrument

NOTE: the problem of the Reflectance factor for the Big W must be solved, otherwise Reflectance can be > 1

Two different units of the NIRQUEST spectrometer acquired similar spectra, including no improvement in the absorption at 1260 nm. SpR found different optimum IT for each unit (57 ms vs. 45 ms).

fdir <- "../Test20230110"
lista <- data.frame(fname=list.files(fdir, patt=glob2rx("*.txt")), fdir=fdir)[17:26,]
selRefs <- selSessionRefs(selflist=lista)
selRefs$Instrument <- plyr::mapvalues(selRefs$sample, from=unique(selRefs$sample), to=rep(c("GEO3BCN", "UAB"), c(5,5)))

ggRefRefl <- ggplot(data=selRefs,aes(x=Wavelength, y=Reflectance, label1=intT1, label2=intT2)) +
  geom_point(alpha=1, size=0.5,aes(group=sample,color=Instrument)) +
  geom_line (alpha=1, linewidth=0.5, aes(group=sample, color=Instrument)) +
  #geom_line(data=Radcont[Radcont$Sample==2,]) +
  #geom_line(data=RefMCAA01, aes(x=Wavelength, y=Reflectance),col="grey") +
  xlim(c(400, 2600)) +
  #theme(legend.position="bottom") +
  labs(color="") +
  ggtitle("Reflectance (Standard Target)", subtitle = "")
#ggRefRefl
ggplotly(ggRefRefl)  %>%
  layout(legend = list(orientation = "h", x = 0.4, y = 0.1))

Major axis regression among both NIRQUEST units resulted in a linear relationship with slope not significantly different to 1 and a very close to 0 intercept:

d <- selRefs[,c(1:6,15)]

ds <- plyr::ddply(d, c("Instrument","Wavelength"), summarise, 
                  Reflectance.m = mean(Reflectance), Reflectance.sd = sd(Reflectance),
                  Radiance.m = mean(Radiance-Dark), Radiance.sd = sd(Radiance-Dark),
                  WRadiance.m = mean(WhiteRad), WRadiance.sd = sd(WhiteRad))
                  
dsw <- data.frame(Wavelength=ds$Wavelength[ds$Instrument=="GEO3BCN"],
                  GEO3BCN_Refl.m=ds$Reflectance.m[ds$Instrument=="GEO3BCN"],
                  UAB_Refl.m=ds$Reflectance.m[ds$Instrument=="UAB"])

lm2Refl1 <- lmodel2(UAB_Refl.m~GEO3BCN_Refl.m, data=dsw)

ggRefl <- ggplot(data=dsw, aes(x= GEO3BCN_Refl.m, y=UAB_Refl.m)) +
  geom_point() +
  geom_abline(aes(intercept=lm2Refl1$regression.results[2,2], slope=lm2Refl1$regression.results[2,3])) +
  geom_abline(aes(intercept=0, slope=1), linetype=4)+
  xlab("Reflectance (GEO3BCN NIRQUEST unit)") +  ylab("Reflectance (UAB NIRQUEST unit)") + 
  theme(legend.position = c(.85,.15), aspect.ratio=1) +
  ggtitle("Standard Reference (2 different NIRQUEST units)")
ggRefl

pander::pander(arrange(lm2Refl1$regression.results[2,2:3])) #

--------------------
 Intercept   Slope  
----------- --------
  0.00887    0.9975 
--------------------

pander::pander(arrange(lm2Refl1$confidence.intervals[2,2:5]))

-------------------------------------------------------------
 2.5%-Intercept   97.5%-Intercept   2.5%-Slope   97.5%-Slope 
---------------- ----------------- ------------ -------------
    0.002034          0.01566         0.9908        1.004    
-------------------------------------------------------------

3.3 Integration Time (20230102 data)

We analysed the effect of IT in NIRQUEST reflectance measurements, by varying IT around the optimum value as calculated by SpR, while keeping the IT of the STS-IT system constant at the optimum:

• STS IT: 46 (optimum value as calculated by SpR software)
• NIRQUEST IT: 16 (optimum), 6, 10, 11, 21, 26

fdir <- "../time_measures20230102"
lista <- data.frame(fname=list.files(fdir, patt=glob2rx("*.txt")), fdir=fdir)[-(1:121),] #exclude auto-capture readings
listasel2 <- lista[2:8,]
selRefs <- selSessionRefs(selflist=listasel2)
ggRefRefl <- ggplot(data=selRefs,aes(x=Wavelength, y=Reflectance)) +
  geom_point(alpha=1, size=0.5,aes(group=sample,color=intT2)) +
  geom_line (alpha=1, linewidth=0.5,aes(group=sample,color=intT2)) +
  #geom_line(data=Radcont[Radcont$Sample==2,]) +
  #geom_line(data=RefMCAA01, aes(x=Wavelength, y=Reflectance),col="grey" ) +
  xlim(c(400, 2600)) +
  ggtitle("Reflectance (Standard Target)", subtitle = "Initial and final reading (IT: 46 ms, 15 ms)")
#ggplotly(ggRefRefl + scale_fill_continuous_diverging(palette = "Purple-Green"))
ggplotly(ggRefRefl + scale_color_gradientn(colours = blue2green2red(7)))  %>%
  layout(legend = list(orientation = "h", x = 0.4, y = 0.1))

#21 and 26 clearly have too long an IT
#STS variabilty ~ NIRQUEST variability, despite the fact that IT in STS was kept constant (46 ms)

IT of 21 ms and 26 ms were clearly too long, but discarding these two values, the variability of NIRQUEST spectra (with variable IT) was close to that of STS Reflectance spectra, which were acquired with constant IT. This implies that fluctuations around the optimum IT are not translated into reflectance fluctuations as long as they are moderate, do not imply saturation or under-exposure, and the IT value is kept the same for the target and the white reference.

#note that values calculated with the large white reference are less variable.
#listasel3 <- lista[c(3,9:11),]
#selRefs <- selSessionRefs(selflist=listasel3)

#selRefs$sample <- plyr::mapvalues(selRefs$sample, from=c(paste0("Ref_", 1:4)), to=c("small_46_16","big_46_16","big_51_16","small_37_12_contact" ))
#selRefs$Reflectance[selRefs$sample=="big_46_16"] <- selRefs$Reflectance[selRefs$sample=="big_46_16"] * 0.8
#selRefs$Reflectance[selRefs$sample=="big_51_16"] <- selRefs$Reflectance[selRefs$sample=="big_51_16"] * 0.8
#ggRefRefl <- ggplot(data=selRefs) +
#  geom_point(aes(x=Wavelength, y=Reflectance, group=sample,color=sample), alpha=1, size=0.5) +
#  geom_line (aes(x=Wavelength, y=Reflectance, group=sample,color=sample), alpha=1, linewidth=0.5) +
#  geom_line(data=RefMCAA01, aes(x=Wavelength, y=Reflectance),col="grey" ) +
#  xlim(c(400, 2600)) +
#  ggtitle("Reflectance (Standard Target)", subtitle = "Initial and final reading (IT: 46 ms, 15 ms)")
#ggplotly(ggRefRefl)

3.4 Light from PC monitor

We tested the eventual effect of the light from the PC monitor, which light was always set to a minimum and oriented to the opposite direction of the measuring setup (and also note we were using a probe with its own light source). Results indicated no difference between having the PC monitor on/off during the measurements:

#with/without monitor
fdir <- "../Test20230110"
lista <- data.frame(fname=list.files(fdir, patt=glob2rx("*.txt")), fdir=fdir)[1:2,]
selRefs <- selSessionRefs(selflist=lista)
selRefs$monitor <- selRefs$sample
selRefs$monitor[selRefs$sample=="Ref_1"] <- "ON" 
selRefs$monitor[selRefs$sample=="Ref_2"] <- "OFF"

d <- selRefs[,c(1:6, 15)]
ds <- plyr::ddply(d, c("monitor","Wavelength"), summarise, 
                  Reflectance.m = mean(Reflectance), Reflectance.sd = sd(Reflectance),
                  Radiance.m = mean(Radiance-Dark), Radiance.sd = sd(Radiance-Dark),
                  WRadiance.m = mean(WhiteRad), WRadiance.sd = sd(WhiteRad))
                  
dsw <- data.frame(Wavelength=ds$Wavelength[ds$monitor=="ON"],
                  ON_Refl.m=ds$Reflectance.m[ds$monitor=="ON"],
                  OFF_Refl.m=ds$Reflectance.m[ds$monitor=="OFF"])

lm2Refl1 <- lmodel2(OFF_Refl.m ~ ON_Refl.m, data=dsw)

pander(arrange(lm2Refl1$regression.results[2,2:3]))

-------------------
 Intercept   Slope 
----------- -------
 0.0009625     1   
-------------------

pander(arrange(lm2Refl1$confidence.intervals[2,-1]))

-------------------------------------------------------------
 2.5%-Intercept   97.5%-Intercept   2.5%-Slope   97.5%-Slope 
---------------- ----------------- ------------ -------------
    -0.00109          0.00301         0.9979        1.002    
-------------------------------------------------------------

ggRefRefl <- ggplot(data=selRefs,aes(x=Wavelength, y=Reflectance)) +
  geom_point(alpha=1, size=0.5,aes(group=sample,color=monitor)) +
  geom_line (alpha=1, linewidth=0.5, aes(group=sample, color=monitor)) +
  #geom_line(data=Radcont[Radcont$Sample==2,]) +
  #geom_line(data=RefMCAA01, aes(x=Wavelength, y=Reflectance),col="grey") +
  xlim(c(400, 2600)) +
  theme(legend.position=c(0.9, 0.1)) +
  labs(color="") +
  ggtitle("Reflectance (Standard Target)", subtitle = "(IT: 53 ms, 17 ms)")
ggRefRefl

3.5 Holder (20230130 Data)

In order to protect the white reference, we take the white reading with the reference within a black holder that attaches to the probe leaving a constant distance of 5 mm from the probe to the reference. We carried out the following measurements:

Table 1 Setup of measurements of white and target (standard) references

spectrum name	White holder	White distance	Target holder	Target distance
contact	No	0.0	No	0.0
holder0	No	5.0	No	5.0
holder1	Yes	5.0	Yes	10.0
holder2	Yes	5.0	No	10.0
holder3	Yes	5.0	No	5.0
field	Yes	5.0	No	0.0

Even such a short distance as 5 mm has a significant impact in the Radiance measurements of both the white and the standard references (compare “contact” and “holder0” in the figures). In the case of the white reference, the holder itself has some influence in the reading, probably because some light is actually absorbed: radiance spectra acquired with the holder (spectra “holder1” to “holder3”) are darker than those acquired without the holder at the same distance (5 mm).

fdir <- "../Test20230130"
lista <- data.frame(fname=list.files(fdir, patt=glob2rx("*.txt")), fdir=fdir)
#lista[17,1]
#file.rename(file.path(fdir, lista[17,1]),file.path(fdir, "20180201_130532_017_StdRef_adapt3_spectrum.txt")) #not following naming convention; only once
lista <- data.frame(fname=list.files(fdir, patt=glob2rx("*.txt")), fdir=fdir)
#lista
a <- strsplit(lista[,1], "_")
a <- sapply(a, function(x){x[5]})
a[a=="mind"] <- "contact"
a[a=="adapt4"] <- "holder0"
a <- sub("adapt","holder",a)
selRefs <- selSessionRefs(selflist=lista)
selRefs$holder <- selRefs$sample
selRefs$holder <- plyr::mapvalues(selRefs$holder, from=unique(selRefs$sample), to=a)
Wavelength2 <- selRefs$Wavelength[selRefs$holder=="holder3"]
WhiteRad2 <- selRefs$WhiteRad[selRefs$holder=="holder3"]
Reflectance2 <- (selRefs$Radiance-selRefs$Dark)[selRefs$holder=="contact"]/WhiteRad2
Reflectance <- selRefs$Reflectance[selRefs$holder=="contact"]

ggRefWRad <- ggplot(data=selRefs,aes(x=Wavelength, y=WhiteRad)) +
  geom_point(alpha=1, size=0.5,aes(group=sample,color=holder)) +
  geom_line (alpha=1, linewidth=0.5,aes(group=sample,color=holder)) +
  xlim(c(400, 2600)) + ylim(0, 60000) + ylab("Radiance")
  #ggtitle("Radiance (White reference)", subtitle = "")
ggRefRad <- ggplot(data=selRefs,aes(x=Wavelength, y=Radiance-Dark)) +
  geom_point(alpha=1, size=0.5,aes(group=sample,color=holder)) +
  geom_line (alpha=1, linewidth=0.5,aes(group=sample,color=holder)) +
  xlim(c(400, 2600)) + ylim(0, 60000) + ylab("Radiance")
  #ggtitle("Radiance (Standard Target)", subtitle = "")
ggRefRefl <- ggplot(data=selRefs,aes(x=Wavelength, y=Reflectance)) +
  geom_point(alpha=1, size=0.5,aes(group=sample,color=holder)) +
  geom_line (alpha=1, linewidth=0.5,aes(group=sample,color=holder)) +
  #geom_line(data=Radcont[Radcont$Sample==2,]) +
  geom_line(data=RefMCAA01, aes(x=Wavelength, y=Reflectance),col="grey" ) +
  xlim(c(400, 2600)) + 
  theme(legend.position=c(0.92, 0.2)) +
  ggtitle("Reflectance of Standard Reference", subtitle = "")
#d2 <- data.frame(Wavelength=Wavelength2, Reflectance=Reflectance2)
d2 <- data.frame(Wavelength=Wavelength2, Reflectance=c(Reflectance,Reflectance2), 
                 holder=c(rep("contact", length(Wavelength2)),
                          rep("field",   length(Wavelength2))))
RefMCAA01$sample <- "Certification"
x <- RefMCAA01[,c(1,3,4)]
names(x)[3] <- "holder"
d2 <- rbind(d2,x)                                                     
ggRefRefl2 <- ggplot(data=d2,
                     aes(x=Wavelength, y=Reflectance, color=holder)) +
  geom_point(alpha=1, size=0.5) +
  geom_line (alpha=1, linewidth=0.5) +
  #geom_line(data=Radcont[Radcont$Sample==2,]) +
  geom_line(data=RefMCAA01, aes(x=Wavelength, y=Reflectance),col="grey" ) +
  xlim(c(400, 2600)) +
  ggtitle("Reflectance of Standard Reference", subtitle = "")

#ggRefRefl 
#+ geom_point(data=d2,alpha=1, size=0.5) + geom_line (data=d2,alpha=1, linewidth=0.5)
#ggRefRefl2

#subplot() does not display ggtitle() info:
subplot(style(ggplotly(ggRefWRad), showlegend=FALSE), ggplotly(ggRefRad), nrows = 2, titleY = TRUE, titleX = TRUE, margin = 0.1 ) %>%
  #layout(legend = list(title="", orientation = "h", x = 0.15, y = 0.38),
  layout(legend = list(title="", orientation = "v", x = 0.05, y = 0.98),
         annotations=list(
           list(
              x = 0.1,  
              y = 1.0,  
              text = "White reference",  
              xref = "paper",  
              yref = "paper",  
              xanchor = "center",  
              yanchor = "bottom",  
              showarrow = FALSE),
            list(
              x = 0.1,  
              y = 0.40,  
              text = "Standard reference",  
              xref = "paper",  
              yref = "paper",  
              xanchor = "center",  
              yanchor = "bottom",  
              showarrow = FALSE)))

Radiance spectra “holder1” and “holder2” were acquired at longer a distance (1 cm) of the Standard reference, and were too dark to actually record the spectral features in their respective Reflectance spectra. This fact highlights the importance of keeping the probe in contact with (or at least closer than 5 mm to) the target.

#ggplotly(ggRefWRad)
#ggplotly(ggRefRad)
ggplotly(ggRefRefl)  %>%
  layout(legend = list(title="", orientation = "h", x = 0.1, y = 0.05))

Field measurements introduce a concern. The common procedure in the field is to keep the holder on for the White reference (as a mean to protect it, which implies 5mm distance from the probe to the white reference). The probe, instead, is kept in contact with the target (ensuring a constant 5 mm distance from probe to target is impossible by freehand in the field). Therefore, the white reference and the target are not acquired with identical probe-to-target distance. Replicating this procedure in the lab results on the reflectance spectrum “field”, which is clearly shifted upwards: target radiance is measured in contact but white radiance is measured at 5 mm. While no natural target is as bright as the Standard Referenc (thus Reflectance reading > 1 as in here are highly unlikely) the offset is too high and we should modify the holder to keep a distance < 5 mm.

ggplotly(ggRefRefl2)  %>%
  layout(legend = list(title="", orientation = "h", x = 0.4, y = 0.05))

d3 <- data.frame(Wavelength=selRefs$Wavelength[selRefs$holder=="holder3"],
                 WhiteRadContact = selRefs$WhiteRad[selRefs$holder=="contact"],
                 WhiteRadHolder0 = selRefs$WhiteRad[selRefs$holder=="holder0"],
                 WhiteRadHolder3 = selRefs$WhiteRad[selRefs$holder=="holder3"])
d3$Instrument <- "STS-IT"
d3$Instrument[dsw$Wavelength>850] <- "NIRQUEST"

lm2WRad1a <- lmodel2(WhiteRadHolder0 ~ WhiteRadContact, data=d3[d3$Instrument=="STS-IT",])
lm2WRad1b <- lmodel2(WhiteRadHolder0 ~ WhiteRadContact, data=d3[d3$Instrument=="NIRQUEST",])
lm2WRadH3a <- lmodel2(WhiteRadHolder3 ~ WhiteRadContact, data=d3[d3$Instrument=="STS-IT",])
lm2WRadH3b <- lmodel2(WhiteRadHolder3 ~ WhiteRadContact, data=d3[d3$Instrument=="NIRQUEST",])

gglm2H0 <- ggplot(data=d3[d3$Instrument=="STS-IT",], aes(label=Wavelength)) +
  geom_point(aes(x=WhiteRadContact, y=WhiteRadHolder0, color=Instrument),alpha=0.5) +
  geom_abline(aes(intercept=lm2WRad1a$regression.results[2,2], slope=lm2WRad1a$regression.results[2,3])) +
  geom_abline(aes(intercept=lm2WRad1b$regression.results[2,2], slope=lm2WRad1b$regression.results[2,3])) +
  geom_abline(aes(intercept=0, slope=1), linetype=4) +
  #xlim(c(0,3000)) + ylim(c(0,3000)) +
  xlab("Radiance (contact)") +  ylab("Radiance (5 mm)") + 
  theme(legend.position = c(.8,.15), aspect.ratio=1) + 
  ggtitle("White Reference") 
gglm2H3 <- ggplot(data=d3) +
  geom_point(aes(x=WhiteRadContact, y=WhiteRadHolder3, color=Instrument)) +
  geom_abline(aes(intercept=lm2WRadH3a$regression.results[2,2], slope=lm2WRadH3a$regression.results[2,3])) +
  geom_abline(aes(intercept=lm2WRadH3b$regression.results[2,2], slope=lm2WRadH3b$regression.results[2,3])) +
  geom_abline(aes(intercept=0, slope=1), linetype=4) +
  xlim(c(0,3000)) + ylim(c(0,3000)) +
  xlab("Radiance (contact)") +  ylab("Radiance (5 mm holder on)") + 
  theme(legend.position = c(.8,.15), aspect.ratio=1) + 
  ggtitle("White Reference") 
gglm2H3H0 <- ggplot(data=d3) +
  geom_point(aes(x=WhiteRadHolder0, y=WhiteRadHolder3, color=Instrument)) +
  #geom_abline(aes(intercept=lm2WRadH3a$regression.results[2,2], slope=lm2WRadH3a$regression.results[2,3])) +
  #geom_abline(aes(intercept=lm2WRadH3b$regression.results[2,2], slope=lm2WRadH3b$regression.results[2,3])) +
  geom_abline(aes(intercept=0, slope=1), linetype=4) +
  xlim(c(0,3000)) + ylim(c(0,3000)) +
  xlab("Radiance (5 mm)") +  ylab("Radiance (5 mm holder on)") + 
  theme(legend.position = c(.8,.15), aspect.ratio=1) + 
  ggtitle("White Reference") 

#grid.arrange(gglm2H0, gglm2H3, gglm2H3H0, ncol=3)

TBD

• spectra of holder material
• plot Wcontact vs W5mm holder0, and vs. W holder3
• a full analysis of distance effect (from 5 mm to 5cm)
• illuminate with ASD bulb

5. Conclusions

• Every target reading must have a white reference reading shortly before.
• The insufficient response in some absorption features is not caused by procedural errors and is not an specific trait of our NIRQUEST unit. It is advised to take a reading with the standard reference (in addition to the white reference), and implement a correction at post-processing.
• Probe to target distance has a major effect, even for 5 mm (we use a contact probe). We should try to modify the holder to reduce the probe-to-white reference distance.