NFINDR_log.Rmd

1. Example from https://github.com/r-hyperspec/unmixR

Both methods produce very similar results:

data("demo_data")
# Reduce data dimensionality with PCA
pca <- prcomp(demo_data)
x <- pca$x[, 1:2]
# Perform N-FINDR in reduced space
nf <- nfindr(x, p = 3)
# Get endmembers in original space
ems <- endmembers(nf, demo_data)
# Get endmembers in reduced space
ems_pca <- endmembers(nf, x)
# Calculate abundances using barycentric coordinates
# it works only in the reduced space
ab_bary <- abundances(nf, x, method = "bary")
# Calculate abundances using NNLS
# it works in both spaces but it is better to be applied in the original space
ab_nnls <- abundances(nf, demo_data, method = "nnls", normalize = TRUE)

print(summary(ab_bary))

       V1                   V2               V3        
 Min.   :-0.0008319   Min.   :0.0000   Min.   :0.0000  
 1st Qu.: 0.0135290   1st Qu.:0.1641   1st Qu.:0.2073  
 Median : 0.2637398   Median :0.2929   Median :0.2771  
 Mean   : 0.3200710   Mean   :0.3818   Mean   :0.2981  
 3rd Qu.: 0.4971472   3rd Qu.:0.6297   3rd Qu.:0.3234  
 Max.   : 1.0000000   Max.   :1.0000   Max.   :1.0000  

print(summary(ab_nnls))

       V1                V2               V3        
 Min.   :0.00000   Min.   :0.0000   Min.   :0.0000  
 1st Qu.:0.01664   1st Qu.:0.1449   1st Qu.:0.2062  
 Median :0.25512   Median :0.2946   Median :0.2784  
 Mean   :0.31918   Mean   :0.3810   Mean   :0.2998  
 3rd Qu.:0.48584   3rd Qu.:0.6305   3rd Qu.:0.3291  
 Max.   :1.00000   Max.   :1.0000   Max.   :1.0000  

ggplot(data=data.frame(bary=ab_bary[,1], nnls=ab_nnls[,1])) +
  geom_point(aes(x=bary, y=nnls))

2. ASTER image

“bary” and “nnls” methods produce very different result.

#remotes::install_github("r-hyperspec/unmixR")
library(terra)  
library(RStoolbox)
library(unmixR)
library(ggplot2)

rdir <- "../Tazoult_AST/AST-07XT_20020524"

2.1 Data input

ast <- rast(file.path(rdir, "AST_07XT_VNS2_aoi_sh.tif"))
#ast <- rast(file.path(rdir, "AST_07XT_VNS2_aoi_pangfFRccsm20.tif")) #COMPTE: NA values!!!
ast
names(ast) <- paste0("B0",1:9)
print(paste0("NA present? ", any(is.na(values(ast)))))
#table(values(ast==0))
#range(values(ast))
wl1 <- c(0.52, 0.63, 0.76, 1.6, 2.145, 2.185, 2.235, 2.295, 2.360)
wl2 <- c(0.6, 0.69, 0.86, 1.7, 2.185, 2.225, 2.285, 2.365, 2.430)
wl <- (wl2-wl1)/2 + wl1

2.2 PCA

X <- values(ast)
print(summary(prcomp(X)))

Importance of components:
                           PC1      PC2      PC3     PC4    PC5     PC6     PC7     PC8     PC9
Standard deviation     88.2258 24.53153 16.43535 7.18504 5.4601 3.34969 2.92804 2.24463 2.07628
Proportion of Variance  0.8879  0.06865  0.03081 0.00589 0.0034 0.00128 0.00098 0.00057 0.00049
Cumulative Proportion   0.8879  0.95657  0.98739 0.99327 0.9967 0.99796 0.99893 0.99951 1.00000

X_pc_demo <- prcomp(X)$x

2.3. Perform N-FINDR in reduced space

p=7
Xnfindrfinal<- nfindr(X_pc_demo[,1:p], p = p+1, n_init=50)

e <- endmembers(Xnfindrfinal, X)
df <- reshape2::melt(e)
colnames(df) <- c("EM", "Band", "Reflectance")
df$EM <- as.character(df$EM)
dict <- data.frame(Band=unique(df$Band), Wavelength=wl)
df$Wavelength <- plyr::mapvalues(df$Band, from=dict$Band, to=dict$Wavelength)
df$Wavelength <- as.numeric(as.character(df$Wavelength))
ggplot(data=df) + 
  geom_line(aes(x=Wavelength, y=Reflectance, group=EM,color=EM)) +
  facet_wrap(~EM,ncol=3)

2.4. Abundances

abnd_bary <- abundances(Xnfindrfinal, X_pc_demo[,1:7], method = "bary")
# Calculate abundances using NNLS
# it works in both spaces but it is better to be applied in the original space
abnd_nnls <- abundances(Xnfindrfinal, X, method = "nnls", normalize = TRUE)

2.5 Compare “bary” to “nnls”

options(width = 200)
print(summary(abnd_bary[,1:5])) #select 1:5 for a cleaner output

       V1                 V2                 V3                  V4                V5          
 Min.   :-0.39599   Min.   :-0.52147   Min.   :-0.534884   Min.   :-0.3615   Min.   :-0.52115  
 1st Qu.:-0.08633   1st Qu.: 0.07177   1st Qu.: 0.006923   1st Qu.: 0.2647   1st Qu.:-0.04271  
 Median :-0.03632   Median : 0.15139   Median : 0.095025   Median : 0.3428   Median : 0.01783  
 Mean   :-0.02787   Mean   : 0.14933   Mean   : 0.096283   Mean   : 0.3474   Mean   : 0.02192  
 3rd Qu.: 0.02484   3rd Qu.: 0.22475   3rd Qu.: 0.182124   3rd Qu.: 0.4295   3rd Qu.: 0.07937  
 Max.   : 1.00000   Max.   : 1.00000   Max.   : 1.000000   Max.   : 1.0000   Max.   : 1.00000  

print(summary(abnd_nnls[,1:5]))

       V1                V2                V3                V4               V5         
 Min.   :0.00000   Min.   :0.00000   Min.   :0.00000   Min.   :0.0000   Min.   :0.00000  
 1st Qu.:0.00000   1st Qu.:0.00000   1st Qu.:0.02470   1st Qu.:0.1975   1st Qu.:0.00000  
 Median :0.00000   Median :0.04996   Median :0.09918   Median :0.2943   Median :0.02202  
 Mean   :0.02089   Mean   :0.07052   Mean   :0.12047   Mean   :0.2899   Mean   :0.06056  
 3rd Qu.:0.03304   3rd Qu.:0.12889   3rd Qu.:0.18378   3rd Qu.:0.3891   3rd Qu.:0.09744  
 Max.   :1.00000   Max.   :1.00000   Max.   :1.00000   Max.   :1.0000   Max.   :1.00000  

df <- data.frame(bary=abnd_bary[,1], nnls=abnd_nnls[,1]) 
ggplot(data=df) +
  geom_bin2d(aes(x=bary, y=nnls),bins=70)

• Abundances <0 with bary method
• Resulting Abundances are very different