added ws202425 courses
This commit is contained in:
@@ -0,0 +1,133 @@
|
||||
#Read hyperspectral image
|
||||
im <- stack('hymap_subset_hr.bsq') #load stack
|
||||
|
||||
#Vector of the wavelength bands in nm of the hyperspectral image (from header file)
|
||||
im.wl <- c(
|
||||
0.455400, 0.469400, 0.484300, 0.499100, 0.513800, 0.528800, 0.543600,
|
||||
0.558400, 0.573100, 0.588100, 0.602900, 0.617600, 0.632000, 0.646500,
|
||||
0.660900, 0.675500, 0.690000, 0.704500, 0.718900, 0.733200, 0.747600,
|
||||
0.761800, 0.775900, 0.790100, 0.804600, 0.818800, 0.832900, 0.847100,
|
||||
0.861100, 0.874700, 0.887800, 0.893000, 0.908500, 0.923900, 0.939400,
|
||||
0.955200, 0.970400, 0.985800, 1.001400, 1.016600, 1.031800, 1.046900,
|
||||
1.062000, 1.076600, 1.091300, 1.106200, 1.120800, 1.135300, 1.149700,
|
||||
1.164100, 1.178600, 1.192800, 1.206900, 1.221000, 1.235100, 1.249200,
|
||||
1.263100, 1.277000, 1.290700, 1.304300, 1.318300, 1.330100, 1.505000,
|
||||
1.518800, 1.532600, 1.546300, 1.559800, 1.573200, 1.586400, 1.599500,
|
||||
1.612700, 1.625900, 1.638900, 1.651700, 1.664400, 1.677100, 1.689600,
|
||||
1.702100, 1.714600, 1.726900, 1.739300, 1.751500, 1.763600, 1.775600,
|
||||
1.787600, 1.798100, 2.027500, 2.046700, 2.065500, 2.084100, 2.102500,
|
||||
2.120900, 2.139000, 2.157000, 2.174700, 2.191700, 2.210300, 2.228100,
|
||||
2.245600, 2.263400, 2.280400, 2.297400, 2.314400, 2.331400, 2.348300,
|
||||
2.365000, 2.381500, 2.397700, 2.414100, 2.430300, 2.446500)*1000
|
||||
|
||||
#Plot the image
|
||||
plotRGB (im, r=255, g=255, b=255, stretch='lin')
|
||||
|
||||
#Open vector data
|
||||
trees <- readOGR('trees_selection_sp_withoutNA.shp')
|
||||
|
||||
#Plot the tree data on top of the hyperspectral data
|
||||
plotRGB(im, 25,14,5, stretch = 'lin')
|
||||
plot(trees, cex=0.5, pch=19, col = 'yellow', add=TRUE)
|
||||
|
||||
#Summary
|
||||
summary(trees)
|
||||
|
||||
#View attribute table
|
||||
View(trees@data)
|
||||
|
||||
#Access column of attribute table
|
||||
trees$GATTUNG_DE
|
||||
|
||||
#Access all unique values of one column
|
||||
levels(as.factor(trees$GATTUNG_DE))
|
||||
|
||||
#Access one row or point
|
||||
trees[5,]@data
|
||||
|
||||
#Plot one Tree on the image
|
||||
plotRGB(im, 25, 14, 5, stretch = 'lin')
|
||||
plot(trees[5,], cex=2, pch=19, col = "yellow", add = TRUE)
|
||||
|
||||
#Plot only AHORN & ROSSKASTANIE trees on the image
|
||||
|
||||
plotRGB(im, 25,14,5, stretch = 'lin')
|
||||
plot(trees[trees$GATTUNG_DE == 'AHORN',], cex=1, pch=19, col="yellow", add = TRUE)
|
||||
plot(trees[trees$GATTUNG_DE == 'ROSSKASTANIE',], cex=1, pch=19, col = 'blue', add = TRUE)
|
||||
|
||||
#Extract pixel values from raster
|
||||
pixel_extract <- extract(im, trees, df = TRUE)
|
||||
|
||||
#Establish relationship between the ID of each pixel and the class
|
||||
pixel_extract_gattung_de <- as.factor(trees$GATTUNG_DE[match(pixel_extract$ID, seq(nrow(trees)))])
|
||||
|
||||
#Delete the ID column
|
||||
pixel_extract <- pixel_extract[-1]
|
||||
|
||||
#Calculate mean spectral profiles
|
||||
sp <- aggregate( . ~ gattung_de, data = pixel_extract, FUN = mean, na.rm = TRUE)
|
||||
|
||||
##### Plot mean spectral profiles
|
||||
# plot empty plot of a defined size
|
||||
plot(1, ylim = c(0,0.5),
|
||||
xlim = c(7, nlayers(im)),
|
||||
type = 'n',
|
||||
xlab = "Hymap bands",
|
||||
ylab = "reflectance",
|
||||
)
|
||||
|
||||
# define colors for class representation - one color per class necessary!
|
||||
mycolors <- rainbow(nrow(sp))
|
||||
|
||||
# draw one line for each class
|
||||
for (i in 1:nrow(sp)){
|
||||
lines(as.numeric(sp[i, -1]),
|
||||
lwd = 2,
|
||||
col = mycolors[i]
|
||||
)
|
||||
}
|
||||
|
||||
# add a grid
|
||||
grid()
|
||||
|
||||
# add a legend
|
||||
legend(as.character(sp$gattung),
|
||||
x = "topleft",
|
||||
col = mycolors,
|
||||
lwd = 1,
|
||||
bty = "n",
|
||||
cex = 0.75,
|
||||
ncol = 3
|
||||
)
|
||||
|
||||
# plot empty plot of a defined size
|
||||
plot(1, ylim = c(0,0.5),
|
||||
xlim = c(min(im.wl), max(im.wl)),
|
||||
type = 'n',
|
||||
xlab = "wavelength (nm)",
|
||||
ylab = "reflectance",
|
||||
)
|
||||
|
||||
# define colors for class representation - one color per class necessary!
|
||||
mycolors <- rainbow(nrow(sp))
|
||||
|
||||
# draw one line for each class
|
||||
for (i in 1:nrow(sp)){
|
||||
lines(im.wl, as.numeric(sp[i, -1]),
|
||||
lwd = 2,
|
||||
col = mycolors[i]
|
||||
)
|
||||
}
|
||||
|
||||
# add a grid
|
||||
grid()
|
||||
|
||||
# add a legend
|
||||
legend(as.character(sp$gattung),
|
||||
x = "topleft",
|
||||
col = mycolors,
|
||||
lwd = 1,
|
||||
bty = "n",
|
||||
cex = 0.75,
|
||||
ncol = 3
|
||||
)
|
||||
@@ -0,0 +1,125 @@
|
||||
install.packages ("hsdar")
|
||||
install.packages ("raster")
|
||||
install.packages ("rgdal")
|
||||
|
||||
library (hsdar)
|
||||
library (raster)
|
||||
library (rgdal)
|
||||
|
||||
spec.berlin <- read.delim2("/Users/huaqo/Nextcloud/Fernerkundung/Projektbezogenes Arbeiten/03/SpecLib_Berlin_Urban_Gradient_2009.txt", header=TRUE)
|
||||
|
||||
class(spec.berlin)
|
||||
|
||||
View(spec.berlin)
|
||||
|
||||
#load a spectral matrix
|
||||
specs <- t(as.matrix(spec.berlin))
|
||||
|
||||
class(specs)
|
||||
|
||||
?speclib
|
||||
|
||||
#create a spectral library
|
||||
sl.berlin <- speclib(specs[-1, ], (specs[1, ])*1000)
|
||||
|
||||
class(sl.berlin)
|
||||
|
||||
sl.berlin
|
||||
|
||||
# Create a plot
|
||||
plot (sl.berlin, FUN=1, ylim=c (0, 0.8))
|
||||
|
||||
# add verticel lines at the wavelength of blue, green and red
|
||||
abline (v=450, col="blue")
|
||||
abline (v=550, col="green")
|
||||
abline (v=630, col="red")
|
||||
|
||||
# create a vector of colors
|
||||
colbar = rainbow(10)
|
||||
|
||||
# Choose soectra to be plotted
|
||||
spectra = c(1,10,15,18,22,25,30,35,40)
|
||||
|
||||
# Add these spectra to a plot
|
||||
plot (sl.berlin, FUN=1, ylim=c ( 0, 0.8), col=colbar[1], lwd=2) ## plot
|
||||
plot (sl.berlin, FUN=10 , new=F, col=colbar[2], lwd=2) ## add
|
||||
plot (sl.berlin, FUN= 15, new=F, col=colbar[3], lwd=2)
|
||||
plot (sl.berlin, FUN=18 , new=F, col=colbar[4], lwd=2)
|
||||
plot (sl.berlin, FUN=22, new=F, col=colbar[5], lwd=2)
|
||||
plot (sl.berlin, FUN=25, new=F, col=colbar[6], lwd=2)
|
||||
plot (sl.berlin, FUN=30 , new=F, col=colbar[7], lwd=2)
|
||||
plot (sl.berlin, FUN=35, new=F, col=colbar[8], lwd=2)
|
||||
plot (sl.berlin, FUN=35, new=F, col=colbar[9], lwd=2)
|
||||
|
||||
#Add a legend
|
||||
legend ("topright", legend=idSpeclib(sl.berlin[spectra]) , col=colbar, lwd=2, ncol=2, cex=0.7)
|
||||
|
||||
#Load hyperstectral image
|
||||
im <- stack("/Users/huaqo/Nextcloud/Fernerkundung/Projektbezogenes Arbeiten/03/hymap_subset2/hymap_subset.bsq")
|
||||
|
||||
im.wl <- c(
|
||||
0.455400, 0.469400, 0.484300, 0.499100, 0.513800, 0.528800, 0.543600,
|
||||
0.558400, 0.573100, 0.588100, 0.602900, 0.617600, 0.632000, 0.646500,
|
||||
0.660900, 0.675500, 0.690000, 0.704500, 0.718900, 0.733200, 0.747600,
|
||||
0.761800, 0.775900, 0.790100, 0.804600, 0.818800, 0.832900, 0.847100,
|
||||
0.861100, 0.874700, 0.887800, 0.893000, 0.908500, 0.923900, 0.939400,
|
||||
0.955200, 0.970400, 0.985800, 1.001400, 1.016600, 1.031800, 1.046900,
|
||||
1.062000, 1.076600, 1.091300, 1.106200, 1.120800, 1.135300, 1.149700,
|
||||
1.164100, 1.178600, 1.192800, 1.206900, 1.221000, 1.235100, 1.249200,
|
||||
1.263100, 1.277000, 1.290700, 1.304300, 1.318300, 1.330100, 1.505000,
|
||||
1.518800, 1.532600, 1.546300, 1.559800, 1.573200, 1.586400, 1.599500,
|
||||
1.612700, 1.625900, 1.638900, 1.651700, 1.664400, 1.677100, 1.689600,
|
||||
1.702100, 1.714600, 1.726900, 1.739300, 1.751500, 1.763600, 1.775600,
|
||||
1.787600, 1.798100, 2.027500, 2.046700, 2.065500, 2.084100, 2.102500,
|
||||
2.120900, 2.139000, 2.157000, 2.174700, 2.191700, 2.210300, 2.228100,
|
||||
2.245600, 2.263400, 2.280400, 2.297400, 2.314400, 2.331400, 2.348300,
|
||||
2.365000, 2.381500, 2.397700, 2.414100, 2.430300, 2.446500)*1000
|
||||
|
||||
plotRGB (im, 51, 34, 13, stretch="lin")
|
||||
|
||||
# Open the image in a new window
|
||||
plotRGB(im, r=70, g=50, b=14, scale=255, stretch="lin")
|
||||
|
||||
#``loactor()`` function
|
||||
pxy<-locator(4)
|
||||
|
||||
|
||||
# extract spectral information
|
||||
spectrum11<-extract(im, cbind(pxy$x[1], pxy$y[1]))
|
||||
spectrum12<-extract(im, cbind(pxy$x[2], pxy$y[2]))
|
||||
spectrum13<-extract(im, cbind(pxy$x[3], pxy$y[3]))
|
||||
spectrum14<-extract(im, cbind(pxy$x[4], pxy$y[4]))
|
||||
|
||||
#plot the spectra
|
||||
|
||||
plot(im.wl, spectrum11[1,], type = "b", col = "cyan", ylim=c(0,0.5),ylab="reflectance",
|
||||
xlab="wavelength [nm]")
|
||||
lines(im.wl, spectrum12[1,], type = "b", col = "red")
|
||||
lines(im.wl, spectrum13[1,], type = "b", col = "green")
|
||||
lines(im.wl, spectrum14[1,], type = "b", col = "blue")
|
||||
|
||||
legend("topright", legend = c("spectrum 1","spectrum 2", "spectrum 3","spectrum 4"), fill = c("cyan", "red", "green", "blue"))
|
||||
|
||||
#Calculate an index
|
||||
NDVI <- ((im[[34]] - im[[14]])/im[[34]] + im[[14]])
|
||||
#Plot the index
|
||||
plot(NDVI, main="NDVI August 2009")
|
||||
plot(NDVI, main="NDVI August 2009",zlim=c(-0.1,1))
|
||||
plot(NDVI, main="NDVI August 2009",zlim=c(-0.1,1), col=grey.colors(255))
|
||||
mycol = colorRampPalette(c("tan4", "yellow", "forestgreen"))
|
||||
plot(NDVI, main="NDVI August 2009",zlim=c(-0.1,1),col=mycol(255))
|
||||
mycol = colorRampPalette(c("tan4", "yellow", "forestgreen"))
|
||||
plot(NDVI, main="NDVI August 2009",zlim=c(-0.1,1),col= mycol(5))
|
||||
|
||||
#Create a matrix that has following structure:
|
||||
# min max newValue
|
||||
# min2 max2 new Value2
|
||||
|
||||
# I have started the first class with -Inf as this makes sure that any negative value is included in the first class.
|
||||
reclass_matrix <- matrix(c(-Inf,0.3,1,0.3,1,2),ncol=3, byrow=TRUE)
|
||||
reclass_matrix
|
||||
|
||||
NDVI_reclass <- reclassify(NDVI, reclass_matrix)
|
||||
|
||||
plot(NDVI_reclass, col=c("tan4", "forestgreen"))
|
||||
plot(NDVI_reclass, col=mycol(2))
|
||||
@@ -0,0 +1,103 @@
|
||||
#Intro
|
||||
|
||||
##Packages
|
||||
library(raster)
|
||||
library(rgdal)
|
||||
library(randomForest)
|
||||
|
||||
##Working directory
|
||||
setwd('/Users/huaqo/Nextcloud/Fernerkundung/Projektbezogenes Arbeiten/04')
|
||||
|
||||
##Load data
|
||||
img <- brick("landsat8_satellit_randomForest.tif")
|
||||
shp <- shapefile("Trainingsdaten_landsat8_RF.shp")
|
||||
getwd()
|
||||
dir()
|
||||
img
|
||||
shp
|
||||
|
||||
##Coordinate system
|
||||
compareCRS(shp, img) #Compare coordinate systems
|
||||
shp <-spTransform(shp, crs(img)) #Overwrite coordinate system
|
||||
|
||||
##Plot data
|
||||
plotRGB(img, r = 4, g = 3, b = 2, stretch = "lin")
|
||||
plot(shp, col = "yellow", add = TRUE)
|
||||
|
||||
#Preprocessing of shapefile
|
||||
levels(as.factor(shp$classes)) #Show all classes
|
||||
for (i in 1: length(unique(shp$classes))) {
|
||||
cat(paste0(i,"", levels(as.factor(shp$classes))[i], sep= "\n"))
|
||||
} #assignment of numerical values to classes
|
||||
|
||||
#Create trainingdata
|
||||
|
||||
##Extract Pixelvalues
|
||||
smp <- extract(img, shp, df = TRUE) #Extract and merge
|
||||
save(smp , file = "smp.rda") #save file in wd
|
||||
load(file = 'smp.rda') #load file from wd
|
||||
|
||||
##Merge trainingdate with classes
|
||||
smp$cl <- as.factor(shp$classes[match(smp$ID, seq(nrow(shp)))]) #merge
|
||||
smp <- smp[-1]
|
||||
summary(smp$cl) #show assignment
|
||||
str(smp) #show data
|
||||
|
||||
#Create random forest modell
|
||||
|
||||
##Downsampling and get sample size of classification
|
||||
smp.size <- rep(min(summary(smp$cl)), nlevels(smp$cl))
|
||||
smp.size
|
||||
|
||||
##Modell
|
||||
rfmodel <- tuneRF(x = smp[-ncol(smp)],
|
||||
y = smp$cl,
|
||||
sampsize = smp.size,
|
||||
strata = smp$cl,
|
||||
ntree = 250,
|
||||
importance = TRUE,
|
||||
doBest = TRUE)
|
||||
rfmodel #show modell
|
||||
|
||||
##Plot Statistical information
|
||||
x11()
|
||||
varImpPlot(rfmodel)
|
||||
|
||||
x11()
|
||||
plot(rfmodel, col = c("violet", "tan4", "blueviolet",
|
||||
"yellowgreen", "green4", "blue"))
|
||||
save(rfmodel, file = "rfmodel.RData")
|
||||
|
||||
#Classification
|
||||
##Show modell as image
|
||||
result <- predict(img,
|
||||
rfmodel,
|
||||
filename = 'Ergebnis.tif',
|
||||
overwrite = TRUE)
|
||||
|
||||
##Plot results
|
||||
plot(result,
|
||||
axes = FALSE,
|
||||
box = FALSE,
|
||||
col= c("violet",
|
||||
"tan4",
|
||||
"blueviolet",
|
||||
"yellowgreen",
|
||||
"green4",
|
||||
"blue"))
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
|
||||
@@ -0,0 +1,106 @@
|
||||
setwd("~/Nextcloud/Fernerkundung/Projektbezogenes Arbeiten/05")
|
||||
|
||||
install.packages('sf')
|
||||
install.packages('raster')
|
||||
install.packages('tidyverse')
|
||||
install.packages('hsdar')
|
||||
install.packages('magrittr')
|
||||
|
||||
library(sf)
|
||||
library(raster)
|
||||
library(tidyverse)
|
||||
library(hsdar)
|
||||
library(magrittr)
|
||||
|
||||
#Raster einladen
|
||||
home <- brick('X0066_Y0021.tif') / 10000
|
||||
|
||||
#Keine Ahnung
|
||||
names(home) <- paste0('B', 1:10)
|
||||
|
||||
#Plotten
|
||||
plotRGB(home, 3, 2, 1, stretch = 'lin')
|
||||
|
||||
#Ganz Berlin
|
||||
berlin_composite <- stack('/Users/huaqo/Nextcloud/Fernerkundung/Projektbezogenes Arbeiten/05/level3/complete_berlin.vrt') / 10000
|
||||
plotRGB(berlin_composite, 3, 2, 1, stretch = 'lin')
|
||||
|
||||
#Endmember
|
||||
image_endmember <- st_read('/Users/huaqo/Nextcloud/Fernerkundung/Projektbezogenes Arbeiten/05_SMA/Endmember.gpkg', quiet = TRUE) %>%
|
||||
st_transform(crs = st_crs(home))
|
||||
class(image_endmember)
|
||||
|
||||
#
|
||||
shade <- tribble(
|
||||
~B1, ~B2, ~B3, ~B4, ~B5, ~B6, ~B7, ~B8, ~B9, ~B10, ~Typ,
|
||||
.01, .01, .01, .01, .01, .01, .01, .01, .01, .01, "Schatten"
|
||||
)
|
||||
|
||||
extracted_spectra <- raster::extract(berlin_composite, image_endmember, df = TRUE) %>%
|
||||
bind_cols(Typ = image_endmember$Typ) %>%
|
||||
select(-ID) %>%
|
||||
set_colnames(c(paste0("B", 1:10), "Typ")) %>%
|
||||
group_by(Typ) %>%
|
||||
summarise(across(contains("B"), mean)) %>%
|
||||
add_row(shade)
|
||||
|
||||
#
|
||||
spectra_for_plot <- extracted_spectra %>%
|
||||
pivot_longer(cols = contains("B"), names_to = "var", values_to = "vals") %>%
|
||||
mutate(var = fct_relevel(var, function(x) paste0("B", sort(as.numeric(str_extract(x, "[0-9]+"))))))
|
||||
|
||||
ggplot(spectra_for_plot) +
|
||||
geom_line(aes(x = var, y = vals, color = Typ, group = Typ), lwd = 1) +
|
||||
scale_color_discrete(name = "Endmember") +
|
||||
labs(x = "Band",
|
||||
y = "Reflektanz") +
|
||||
theme(legend.position = "bottom")
|
||||
|
||||
#Entmischung
|
||||
em <- speclib(spectra = as.matrix(extracted_spectra[, -1]),
|
||||
wavelength = c(490, 560, 665, 705, 740, 783, 842, 865, 1610, 2190),
|
||||
continuousdata = FALSE)
|
||||
|
||||
image_spectra <- speclib(spectra = getValues(home),
|
||||
wavelength = c(490, 560, 665, 705, 740, 783, 842, 865, 1610, 2190),
|
||||
continuousdata = FALSE)
|
||||
|
||||
|
||||
sma <- unmix(image_spectra, em)
|
||||
|
||||
#Visualisierung und Validierung
|
||||
extent_s2 <- extent(home)
|
||||
|
||||
soil_mat <- matrix(sma$fractions[1, ], nrow = 250, ncol = 250, byrow = TRUE)
|
||||
|
||||
soil_ras <- raster(soil_mat, crs = crs(home), xmn = extent_s2[1],
|
||||
xmx = extent_s2[2], ymn = extent_s2[3], ymx = extent_s2[4])
|
||||
|
||||
veg_mat <- matrix(sma$fractions[2, ], nrow = 250, ncol = 250, byrow = TRUE)
|
||||
|
||||
veg_ras <- raster(veg_mat, crs = crs(home), xmn = extent_s2[1],
|
||||
xmx = extent_s2[2], ymn = extent_s2[3], ymx = extent_s2[4])
|
||||
|
||||
shadow_mat <- matrix(sma$fractions[3, ], nrow = 250, ncol = 250, byrow = TRUE)
|
||||
|
||||
shadow_ras <- raster(shadow_mat, crs = crs(home), xmn = extent_s2[1],
|
||||
xmx = extent_s2[2], ymn = extent_s2[3], ymx = extent_s2[4])
|
||||
|
||||
rmse_mat <- matrix(sma$error, nrow = 250, ncol = 250, byrow = TRUE)
|
||||
|
||||
rmse_ras <- raster(rmse_mat, crs = crs(home), xmn = extent_s2[1],
|
||||
xmx = extent_s2[2], ymn = extent_s2[3], ymx = extent_s2[4])
|
||||
|
||||
sma_raster <- brick(soil_ras, veg_ras, shadow_ras, rmse_ras)
|
||||
|
||||
names(sma_raster) <- c("Boden", "Vegetation", "Schatten", "RMSE")
|
||||
|
||||
# Alternative
|
||||
alt_sma_raster <- setValues(home[[1:4]], values = c(t(sma$fractions), sma$error))
|
||||
|
||||
names(alt_sma_raster) <- c("Boden", "Vegetation", "Schatten", "RMSE")
|
||||
|
||||
compareRaster(sma_raster, alt_sma_raster)
|
||||
|
||||
#Abspeichern
|
||||
writeRaster(sma_raster,"sma_stacked.tif", overwrite = TRUE)
|
||||
@@ -0,0 +1,83 @@
|
||||
#### 1. Vorbereitung ####
|
||||
install.packages('RStoolbox')
|
||||
install.packages('raster')
|
||||
library(raster)
|
||||
library(RStoolbox)
|
||||
setwd("~/OneDrive/Dokumente/Fernerkundung/PjS/06_Thermal/Daten Tag")
|
||||
|
||||
mtl <- 'LC08_L1TP_193023_20190726_20190801_01_T1_MTL.txt'
|
||||
metaData <- readMeta(mtl)
|
||||
|
||||
ls8_2020 <- stack(metaData$DATA$FILES[c(1:7)])
|
||||
names(ls8_2020) <- c("ultra_blue", "blue", "green", "red", "NIR", "SWIR1", "SWIR2")
|
||||
|
||||
#metaData$DATA$FILES
|
||||
|
||||
ls8_2020_thermal <- stack(metaData$DATA$FILES[9])
|
||||
names(ls8_2020_thermal) <- c('TIR1')
|
||||
|
||||
setwd("~/OneDrive/Dokumente/Fernerkundung/PjS/06_Thermal/Berlin Shapefile")
|
||||
BB_shape <- shapefile('Berlin_Bezirke.shp')
|
||||
|
||||
#### 2. Vorverarbeitung ####
|
||||
##### 2.1 Top-Of-Atmosphere Reflectance #####
|
||||
offset <- metaData$CALREF$offset[1:7]
|
||||
gain <- metaData$CALREF$gain[1:7]
|
||||
ls8_2020_toa1 <- gain * ls8_2020 + offset
|
||||
|
||||
sun_elev_day <- metaData$SOLAR_PARAMETERS['elevation']
|
||||
sun_earth_distance_day <- metaData$SOLAR_PARAMETERS['distance']
|
||||
ls8_2020_toa <- ls8_2020_toa1 * sun_earth_distance_day^2 / sin(sun_elev_day*pi/180)
|
||||
#ls8_2020_toa
|
||||
|
||||
|
||||
|
||||
##### 2.2 Brightness Temperature #####
|
||||
offset <- metaData$CALRAD$offset[10]
|
||||
gain <- metaData$CALRAD$gain[10]
|
||||
ls8_2020_thermal.RAD <- gain * ls8_2020_thermal + offset
|
||||
|
||||
K1 <- metaData$CALBT$K1[1]
|
||||
K2 <- metaData$CALBT$K2[1]
|
||||
ls8_2020_thermal.BT <- K2/log(K1/ls8_2020_thermal.RAD+1)
|
||||
#ls8_2020_thermal.BT
|
||||
|
||||
#### 3. Shapefile ####
|
||||
#plotRGB(ls8_2020_toa, r = 4, g = 3, b = 2, stretch = 'hist')
|
||||
#plot(BB_shape, lwd = 2, border = 'red', add = TRUE)
|
||||
|
||||
ls8_2020_toa.BB <- crop(ls8_2020_toa, BB_shape)
|
||||
ls8_2020_thermal.BT.BB <- crop(ls8_2020_thermal.BT, BB_shape)
|
||||
|
||||
#plotRGB(ls8_2020_toa.BB, r = 4, g = 3, b = 2, stretch = 'hist')
|
||||
#plot(BB_shape, lwd = 2, border = 'red', add = TRUE)
|
||||
|
||||
#plot(ls8_2020_thermal.BT.BB, zlim=c(290,320))
|
||||
#plot(BB_shape, lwd = 2, border = 'red', add = TRUE)
|
||||
|
||||
#### 4. Gleichung zur Berechnung der Oberflaechentemperatur ####
|
||||
#LST(°C)=Bt/[1+(w∗Bt/p)∗ln(e)]−273.15
|
||||
#e=0,017∗Pv+0,963
|
||||
#PV=[(NDVI−NDVImin)/(NDVImax−NDVImin)]
|
||||
#### 5. Berechnen des NDVI ####
|
||||
ls8.ndvi <- spectralIndices(ls8_2020_toa.BB, red = 'red', nir = 'NIR', indices = 'NDVI')
|
||||
#plot(ls8.ndvi)
|
||||
#ls8.ndvi
|
||||
|
||||
#### 6. Berechnen des PV ####
|
||||
NDVImin <- minValue(ls8.ndvi)
|
||||
NDVImax <- maxValue(ls8.ndvi)
|
||||
ls8.PV <- ((ls8.ndvi-NDVImin)/(NDVImax-NDVImin))^2
|
||||
#plot(ls8.PV)
|
||||
|
||||
#### 7. Berechnung des Emissionsgrades ####
|
||||
ls8.emissiv <- 0.017 * ls8.PV + 0.963
|
||||
plot(ls8.emissiv)
|
||||
#### 8. Berechnung der Oberflächentemperatur (LST) ####
|
||||
ls8.LST <- (ls8_2020_thermal.BT.BB / (1+(10.8 * ls8_2020_thermal.BT.BB/14388) * log(ls8.emissiv))) - 273.15
|
||||
#ls8.LST
|
||||
#plot(ls8.LST, zlim=c(20,40))
|
||||
#plot(BB_shape, lwd = 2, border = "red", add = TRUE)
|
||||
#### 9. Speichern des Ergebnisses ####
|
||||
setwd("~/OneDrive/Dokumente/Fernerkundung/PjS/06_Thermal")
|
||||
writeRaster(ls8.LST$layer, "ls8_LST.sdat", format = "SAGA", overwrite = TRUE)
|
||||
@@ -0,0 +1,87 @@
|
||||
#### 1. Vorbereitung ####
|
||||
setwd("~/OneDrive/Dokumente/Fernerkundung/PjS/08_Kastanie/Daten")
|
||||
install.packages('vioplot')
|
||||
library('vioplot')
|
||||
library(raster)
|
||||
library(rgdal)
|
||||
Kachel_2020 <- stack('Kachel_Suedwest.tif')
|
||||
names(Kachel_2020) <- c('NIR','RED','GREEN')
|
||||
#plotRGB(Kachel_2020, 1, 2, 3, stretch = 'lin')
|
||||
|
||||
par(mfrow = c(1,1))
|
||||
|
||||
Kronen <- readOGR('rkast_buffer_single.shp')
|
||||
#plot(Kronen, lwd = 5, border = 'yellow', add = TRUE)
|
||||
|
||||
NDVI <- stack('ndvi.tif')
|
||||
#plot(NDVI)
|
||||
|
||||
#### 2. Extrahieren von Pixeln ####
|
||||
extract_CIR <- extract(Kachel_2020, Kronen, df = TRUE)
|
||||
extract_NDVI <- extract(NDVI, Kronen, df = TRUE)
|
||||
|
||||
#### 3. Statistische Auswertung der extrahierten Pixel ####
|
||||
##### 3.1 Erstellen von Boxplots #####
|
||||
col = c('purple','red','green')
|
||||
boxplot(extract_CIR[2:4], col = col, ylab = 'Reflectance')
|
||||
##### 3.2 Erstellen von Violinplots #####
|
||||
vioplot(extract_CIR[2:4], col = col, horizontal = F)
|
||||
|
||||
#### 4. Mittelwerte pro Baum bestimmen ####
|
||||
sp <- aggregate(. ~ ID , data = extract_CIR, FUN = mean, na.rm = TRUE )
|
||||
##### 4.1 Mittelwerte der Kanäle plotten #####
|
||||
par(mfrow = c(1,3))
|
||||
|
||||
##NIR
|
||||
plot(sp[,2], ylim = c(0,250), ylab = "Reflectance", main ="NIR")
|
||||
abline(h = mean(sp$NIR), col ="red")
|
||||
##Rot
|
||||
plot(sp[,3], ylim = c(0,250), ylab = "Reflectance", main ="Red")
|
||||
abline(h = mean(sp$RED), col ="red")
|
||||
##Gruen
|
||||
plot(sp[,4], ylim = c(0,250), ylab = "Reflectance", main ="Green")
|
||||
abline(h = mean(sp$GREEN), col ="red")
|
||||
|
||||
#### 5. Vergleich mit der Referenzgattung Linde ####
|
||||
##### 5.1 Einladen der Daten #####
|
||||
Linden <- readOGR("Vergleichsbaum_Linde_singlepart.shp")
|
||||
summary(Linden)
|
||||
##### 5.2 Stichprobe ziehen #####
|
||||
sample_index <- sample(1:length(Linden),400)
|
||||
Linden_sample <- Linden[sample_index,]
|
||||
|
||||
plot(Linden)
|
||||
plot(Linden_sample, add=T, col="red")
|
||||
##### 5.3 Extrahieren der Linden Pixel #####
|
||||
extract_Linden <- extract(Kachel_2020, Linden_sample, buffer = 1, na.rm = TRUE, df = TRUE)
|
||||
|
||||
##optional für die die komischerweise keinen Dataframe erhalten (vielleicht Mac-User?)
|
||||
# Manuelles Umwandeln in einen Dataframe
|
||||
extract_Linden <- data.frame(extract_Linden)
|
||||
|
||||
##### 5.4 Violinplots von Kastanien und Linden vergleichen #####
|
||||
par(mfrow = c(1,2))
|
||||
|
||||
col= c("purple","red","green")
|
||||
vioplot(extract_CIR[2:4],col = col, horizontal=F, main ="Rosskastanien")
|
||||
|
||||
vioplot(extract_Linden[2:4],col = col, horizontal=F, main = "Linden")
|
||||
|
||||
##### 5.5 Mittelwerte pro Linde berechnen #####
|
||||
sp_Linden <- aggregate(. ~ ID , data = extract_Linden, FUN = mean, na.rm = TRUE )
|
||||
|
||||
##### 5.6 Mittelwerte des NIR der Gattungen vergleichen #####
|
||||
par(mfrow = c(1,2))
|
||||
|
||||
##NIR Kastanien
|
||||
plot(sp[,2], ylim = c(0,250))
|
||||
abline(h = mean(sp$NIR), col ="red")
|
||||
|
||||
##NIR Linden
|
||||
|
||||
plot(sp_Linden[,2], ylim = c(0,250))
|
||||
abline(h = mean(sp_Linden$NIR), col ="red")
|
||||
|
||||
|
||||
|
||||
|
||||
@@ -0,0 +1,119 @@
|
||||
#install packages
|
||||
#install.packages('RColorBrewer')
|
||||
#install.packages('rgeos')
|
||||
|
||||
|
||||
# load spatial packages
|
||||
library(raster)
|
||||
library(rgdal)
|
||||
library(rgeos)
|
||||
library(RColorBrewer)
|
||||
|
||||
setwd("/Users/hannascheiwe/Desktop/Geo4.Semester/PjS_urbanefernerkundun/Vortrag_Trockenstress/daten")
|
||||
|
||||
# turn off factors
|
||||
#options(stringsAsFactors = FALSE)
|
||||
|
||||
multispectral_st_2018 <- stack("/Users/hannascheiwe/Desktop/Geo4.Semester/PjS_urbanefernerkundun/Vortrag_Trockenstress/daten/sen2_20180901.tif")
|
||||
|
||||
plotRGB(multispectral_st_2018, 3,2,1, stretch="lin")
|
||||
|
||||
crop_extent <- readOGR("/Users/hannascheiwe/Desktop/Geo4.Semester/PjS_urbanefernerkundun/Vortrag_Trockenstress/daten/Berlin_Bezirke.shp")
|
||||
|
||||
charlottenburg_wilmersdorf <- crop_extent[crop_extent$ORTSTNAME=="Grunewald",]
|
||||
|
||||
plot(charlottenburg_wilmersdorf)
|
||||
|
||||
plot(charlottenburg_wilmersdorf,
|
||||
main = "Shapefile imported into R - crop extent",
|
||||
axes = TRUE,
|
||||
border = "blue")
|
||||
|
||||
#compare_CRS(charlottenburg_wilmersdorf, multispectral_st_2018)
|
||||
|
||||
shp<- spTransform(charlottenburg_wilmersdorf, crs(multispectral_st_2018))
|
||||
|
||||
ausschnitt_grunewald_2018<- crop(multispectral_st_2018, shp)
|
||||
|
||||
plotRGB(ausschnitt_grunewald_2018,3,2,1, stretch= "lin")
|
||||
|
||||
ndvi_2018 <- (ausschnitt_grunewald_2018[[7]] - ausschnitt_grunewald_2018[[3]]) / (ausschnitt_grunewald_2018[[7]] + ausschnitt_grunewald_2018[[3]])
|
||||
|
||||
plot(ndvi_2018, main = "ndvi_2018", axes = FALSE, box = FALSE)
|
||||
|
||||
hist(ndvi_2018,
|
||||
main = "ndvi_2018: Distribution of pixels",
|
||||
col = "springgreen",
|
||||
xlab = "NDVI Index Value")
|
||||
|
||||
#writeRaster(x = ndvi_2018,
|
||||
#filename="...",
|
||||
#format = "GTiff", # save as a tif
|
||||
#datatype='INT2S', # save as a INTEGER rather than a float
|
||||
#overwrite = TRUE) # OPTIONAL - be careful. This will OVERWRITE previous files.
|
||||
|
||||
ndwi_2018 <- (ausschnitt_grunewald_2018[[7]] - ausschnitt_grunewald_2018[[10]]) / (ausschnitt_grunewald_2018[[7]] + ausschnitt_grunewald_2018[[10]])
|
||||
|
||||
plot(ndwi_2018, main = "ndwi_2018", axes = FALSE, box = FALSE)
|
||||
|
||||
hist(ndwi_2018,
|
||||
main = "ndwi_2018: Distribution of pixels",
|
||||
col = "springgreen",
|
||||
xlab = "NDVI Index Value")
|
||||
|
||||
#writeRaster(x = ndwi_2018,
|
||||
#filename="...",
|
||||
#format = "GTiff", # save as a tif
|
||||
#datatype='INT2S', # save as a INTEGER rather than a float
|
||||
#overwrite = TRUE) # OPTIONAL - be careful. This will OVERWRITE previous files.
|
||||
|
||||
multispectral_2020 <- stack("/Users/hannascheiwe/Desktop/Geo4.Semester/PjS_urbanefernerkundun/Vortrag_Trockenstress/daten/S2A_20200816.tif")
|
||||
|
||||
plotRGB(multispectral_2020, 3,2,1, stretch="lin")
|
||||
|
||||
compare_CRS(charlottenburg_wilmersdorf_2020, multispectral_2020)
|
||||
|
||||
shp_2020<- spTransform(charlottenburg_wilmersdorf_2020, crs(multispectral_2020))
|
||||
|
||||
ausschnitt_grunewald_2018_2020<- crop(multispectral_2020, shp_2020)
|
||||
|
||||
plotRGB(ausschnitt_grunewald_2018_2020,3,2,1, stretch= "lin")
|
||||
|
||||
ndvi_2020 <- (ausschnitt_grunewald_2020[[7]] - ausschnitt_grunewald_2020[[3]]) / (ausschnitt_grunewald_2020[[7]] + ausschnitt_grunewald_2020[[3]])
|
||||
|
||||
plot(ndvi_2020, main = "ndvi_2020", axes = FALSE, box = FALSE)
|
||||
|
||||
hist(ndvi_2020,
|
||||
main = "NDVI: Distribution of pixels",
|
||||
col = "springgreen",
|
||||
xlab = "NDVI Index Value")
|
||||
|
||||
#writeRaster(x = ndvi_2020,
|
||||
#filename="...",
|
||||
#format = "GTiff", # save as a tif
|
||||
#datatype='INT2S', # save as a INTEGER rather than a float
|
||||
#overwrite = TRUE) # OPTIONAL - be careful. This will OVERWRITE previous files.
|
||||
|
||||
#NDWI:
|
||||
#(NIR-SWIR)/(NIR+SWIR)
|
||||
|
||||
ndwi_2020 <- (ausschnitt_grunewald_2020[[7]] - ausschnitt_grunewald_2020[[10]]) / (ausschnitt_grunewald_2020[[7]] + ausschnitt_grunewald_2020[[10]])
|
||||
|
||||
plot(ndwi_2020, main = "ndwi_2020", axes = FALSE, box = FALSE)
|
||||
|
||||
hist(ndwi_2020,
|
||||
main = "NDWI: Distribution of pixels",
|
||||
col = "springgreen",
|
||||
xlab = "NDVI Index Value")
|
||||
|
||||
#writeRaster(x = ndwi_2020,
|
||||
#filename="...",
|
||||
#format = "GTiff", # save as a tif
|
||||
#datatype='INT2S', # save as a INTEGER rather than a float
|
||||
#overwrite = TRUE) # OPTIONAL - be careful. This will OVERWRITE previous files.
|
||||
|
||||
difference_ndvi<- ndvi_2018 - ndvi_2020
|
||||
plot(difference_ndvi, main = "NDVI Difference", axes = FALSE, box = FALSE)
|
||||
|
||||
difference_ndvi<- ndvi_2018 - ndvi_2020
|
||||
plot(difference_ndvi, main = "NDVI Difference", axes = FALSE, box = FALSE)
|
||||
@@ -0,0 +1 @@
|
||||
Jede Zwei Spalten is eine Messung. Jede Reihe ist eine Wellenlaenge mit dem gemessenen reflection value.
|
||||
Binary file not shown.
Binary file not shown.
Binary file not shown.
@@ -0,0 +1,263 @@
|
||||
# Functions
|
||||
process_spectral_data <- function(file_path, grouping_size = 17, exclude_index = 13, encoding = "UTF-16LE", baum_ids = NULL) {
|
||||
spektren <- readLines(file(file_path, encoding = encoding))
|
||||
spektren <- gsub("\ufeff", "", spektren)
|
||||
spektren <- strsplit(spektren, "\t")
|
||||
wavelengths <- as.numeric(sapply(spektren, function(x) strsplit(x[1], ",")[[1]][1]))
|
||||
measurements <- do.call(rbind, lapply(spektren, function(row) {
|
||||
sapply(row, function(part) as.numeric(strsplit(part, ",")[[1]][2]))
|
||||
}))
|
||||
if (basename(file_path) == "export_20220721.dat") {
|
||||
whites <- c()
|
||||
for (j in 1:ncol(measurements)) {
|
||||
value <- measurements[1, j]
|
||||
if (!is.na(value) && floor(value) == 1) {
|
||||
whites <- c(whites,j)
|
||||
}
|
||||
}
|
||||
skipped <- c(88, 138, 139, 180, 293, 311, 312, 313, 317, 395)
|
||||
fix <- c(0:11)
|
||||
columns_to_remove <- unique(c(whites, skipped, fix))
|
||||
measurements <- measurements[, -columns_to_remove]
|
||||
spektren.df <- as.data.frame(measurements)
|
||||
if (!is.null(baum_ids)) {
|
||||
baum_ids_20220721 <- c(
|
||||
"ES8 (B 2-10-5-5)", "ES9 (B 2-10-2-4)", "IT8 (B 1-2-2-2)", "DE7 (B3-11-3-3)", "DE8 (B3-11-1-3)",
|
||||
"FR1 (A 1-7-2-5)", "FR2 (A 1-7-1-1)", "ES1 (A 2-3-3-3)", "ES2 (A 2-3-3-2)", "IT2 (A 1-9-3-5)",
|
||||
"IT3 (A 1-9-4-4)", "FR5 (A 1-1-2-5)", "FR6 (A 1-1-2-3)", "DE1 (B1-10-5-5)", "DE2 (B1-10-5-3)",
|
||||
"IT7 (B 1-2-3-3)", "DE4 (B1-10-4-5)", "DE10 (B 3-11-1-1)", "ES10 (B 2-10-3-1)", "IT9 (B 1-2-2-3)",
|
||||
"IT5 (A 1-9-5-2)", "ES5 (A 2-3-4-4)", "FR10 (A 1-1-5-4)", "FR4 (A 1-1-1-3)"
|
||||
)
|
||||
baum_order_20220721 <- match(baum_ids, baum_ids_20220721)
|
||||
reordered_columns <- unlist(lapply(baum_order_20220721, function(x) {
|
||||
start_col <- (x - 1) * 15 + 1
|
||||
end_col <- start_col + 14
|
||||
return(start_col:end_col)
|
||||
}))
|
||||
spektren.df <- spektren.df[, reordered_columns]
|
||||
}
|
||||
}
|
||||
if (basename(file_path) == "export_20220812.dat") {
|
||||
measurements_filtered <- list()
|
||||
for (i in seq(1, ncol(measurements), by = grouping_size)) {
|
||||
tree_index <- (i - 1) / grouping_size + 1
|
||||
if (tree_index != exclude_index) {
|
||||
measurements_filtered[[length(measurements_filtered) + 1]] <- measurements[, (i + 1):(i + grouping_size - 2)]
|
||||
}
|
||||
}
|
||||
measurements_filtered <- do.call(cbind, measurements_filtered)
|
||||
spektren.df <- as.data.frame(measurements_filtered)
|
||||
}
|
||||
rownames(spektren.df) <- wavelengths
|
||||
return(spektren.df)
|
||||
}
|
||||
|
||||
calculate_mean_values <- function(spektren.df, baum_id, spalten_pro_baum) {
|
||||
start_spalte <- (baum_id - 1) * spalten_pro_baum + 1
|
||||
end_spalte <- start_spalte + spalten_pro_baum - 1
|
||||
spalten_messungen <- start_spalte:end_spalte
|
||||
mean_values <- rowMeans(spektren.df[, spalten_messungen], na.rm = TRUE)
|
||||
return(mean_values)
|
||||
}
|
||||
|
||||
create_mean_values_df <- function(spektren.df, num_baeume, spalten_pro_baum) {
|
||||
mean_values_list <- list()
|
||||
for (baum_id in 1:num_baeume) {
|
||||
mean_values <- calculate_mean_values(spektren.df, baum_id, spalten_pro_baum)
|
||||
mean_values_list[[baum_id]] <- mean_values
|
||||
}
|
||||
mean_values_df <- as.data.frame(do.call(cbind, mean_values_list))
|
||||
colnames(mean_values_df) <- paste0("Tree_", 1:num_baeume)
|
||||
rownames(mean_values_df) <- rownames(spektren.df)
|
||||
return(mean_values_df)
|
||||
}
|
||||
|
||||
integrate_difference <- function(df1, df2, num_baeume, spalten_pro_baum) {
|
||||
if (ncol(df1) != ncol(df2) || nrow(df1) != nrow(df2)) {
|
||||
stop("The dataframes must have the same dimensions.")
|
||||
}
|
||||
wavelengths <- as.numeric(rownames(df1))
|
||||
integral_results <- numeric(num_baeume)
|
||||
for (baum_id in 1:num_baeume) {
|
||||
mean_values_df1 <- calculate_mean_values(df1, baum_id, spalten_pro_baum)
|
||||
mean_values_df2 <- calculate_mean_values(df2, baum_id, spalten_pro_baum)
|
||||
difference <- mean_values_df1 - mean_values_df2
|
||||
integral_results[baum_id] <- sum(diff(wavelengths) * (head(difference, -1) + tail(difference, -1)) / 2)
|
||||
}
|
||||
return(integral_results)
|
||||
}
|
||||
|
||||
calculate_wbi <- function(mean_values_df) {
|
||||
wavelengths <- 325:1075
|
||||
wavelength_900 <- which(wavelengths == 900)
|
||||
wavelength_970 <- which(wavelengths == 970)
|
||||
|
||||
wbi_values <- apply(mean_values_df, 2, function(column) {
|
||||
column[wavelength_900] / column[wavelength_970]
|
||||
})
|
||||
|
||||
return(wbi_values)
|
||||
}
|
||||
|
||||
calculate_wbi_differences <- function(wbi_values1, wbi_values2) {
|
||||
if (length(wbi_values1) != length(wbi_values2)) {
|
||||
stop("The two WBI datasets must have the same length.")
|
||||
}
|
||||
|
||||
wbi_diff <- wbi_values1 - wbi_values2
|
||||
return(wbi_diff)
|
||||
}
|
||||
|
||||
|
||||
plot_spectral_data <- function(mean_values_df, output_file = "all.png", baum_ids, xlim = c(400, 1050), ylim = c(0, 1), date_of_capture) {
|
||||
num_baeume <- ncol(mean_values_df)
|
||||
png(output_file, width = 1024, height = 720)
|
||||
colors <- rainbow(num_baeume)
|
||||
plot(as.numeric(rownames(mean_values_df)), rep(NA, nrow(mean_values_df)),
|
||||
xlab = "Wavelength (nm)", ylab = "Reflection (%)",
|
||||
type = "n", ylim = ylim, xlim = xlim,
|
||||
main = paste("Spectral Data -", date_of_capture)
|
||||
)
|
||||
for (baum_id in 1:num_baeume) {
|
||||
lines(as.numeric(rownames(mean_values_df)), mean_values_df[, baum_id], type = "l", col = colors[baum_id], lwd = 6)
|
||||
}
|
||||
legend("topleft",
|
||||
legend = baum_ids,
|
||||
text.col = colors,
|
||||
pch = rep("-", num_baeume),
|
||||
col = colors, lwd = 2
|
||||
)
|
||||
dev.off()
|
||||
}
|
||||
|
||||
|
||||
plot_side_by_side_spectral_data <- function(mean_values_df1, mean_values_df2, output_file = "side_by_side_plot.png", baum_ids, xlim = c(400, 1050), ylim = c(0, 1), dates) {
|
||||
num_baeume <- ncol(mean_values_df1)
|
||||
png(output_file, width = 1080, height = 1280)
|
||||
par(mfrow = c(2, 1))
|
||||
colors <- rainbow(num_baeume)
|
||||
|
||||
plot(as.numeric(rownames(mean_values_df1)), rep(NA, nrow(mean_values_df1)),
|
||||
xlab = "Wavelength (nm)", ylab = "Reflection (%)",
|
||||
type = "n", ylim = ylim, xlim = xlim,
|
||||
main = paste("Spectral Data -", dates[1])
|
||||
)
|
||||
for (baum_id in 1:num_baeume) {
|
||||
lines(as.numeric(rownames(mean_values_df1)), mean_values_df1[, baum_id], type = "l", col = colors[baum_id], lwd = 6)
|
||||
}
|
||||
legend("topleft",
|
||||
legend = baum_ids,
|
||||
text.col = colors,
|
||||
pch = rep("-", num_baeume),
|
||||
col = colors, lwd = 2
|
||||
)
|
||||
|
||||
plot(as.numeric(rownames(mean_values_df2)), rep(NA, nrow(mean_values_df2)),
|
||||
xlab = "Wavelength (nm)", ylab = "Reflection (%)",
|
||||
type = "n", ylim = ylim, xlim = xlim,
|
||||
main = paste("Spectral Data -", dates[2])
|
||||
)
|
||||
for (baum_id in 1:num_baeume) {
|
||||
lines(as.numeric(rownames(mean_values_df2)), mean_values_df2[, baum_id], type = "l", col = colors[baum_id], lwd = 6)
|
||||
}
|
||||
legend("topleft",
|
||||
legend = baum_ids,
|
||||
text.col = colors,
|
||||
pch = rep("-", num_baeume),
|
||||
col = colors, lwd = 2
|
||||
)
|
||||
|
||||
dev.off()
|
||||
}
|
||||
|
||||
plot_wbi_values <- function(wbi_values, baum_ids, output_file = "wbi_values_sorted_scaled.png", date_of_capture) {
|
||||
png(output_file, width = 1024, height = 720)
|
||||
par(mar = c(10, 5, 4, 2) + 0.1)
|
||||
sorted_indices <- order(wbi_values)
|
||||
sorted_wbi_values <- wbi_values[sorted_indices]
|
||||
sorted_baum_ids <- baum_ids[sorted_indices]
|
||||
min_wbi <- min(sorted_wbi_values) - 0.002
|
||||
max_wbi <- max(sorted_wbi_values) + 0.002
|
||||
barplot(
|
||||
sorted_wbi_values,
|
||||
names.arg = sorted_baum_ids,
|
||||
col = "steelblue",
|
||||
main = paste("Water Band Index (WBI) -", date_of_capture),
|
||||
xlab = "",
|
||||
ylab = "WBI Value",
|
||||
las = 2,
|
||||
ylim = c(min_wbi, max_wbi)
|
||||
)
|
||||
dev.off()
|
||||
}
|
||||
|
||||
plot_combined_wbi_values <- function(wbi_values_1, wbi_values_2, baum_ids, output_file = "combined_wbi_plot.png", dates = c("2022/07/21", "2022/08/12")) {
|
||||
combined_wbi <- cbind(wbi_values_1, wbi_values_2)
|
||||
colnames(combined_wbi) <- dates
|
||||
sorted_indices <- order(wbi_values_1)
|
||||
sorted_combined_wbi <- combined_wbi[sorted_indices,]
|
||||
sorted_baum_ids <- baum_ids[sorted_indices]
|
||||
png(output_file, width = 1024, height = 720)
|
||||
par(mar = c(10, 5, 4, 2) + 0.1)
|
||||
barplot(
|
||||
t(sorted_combined_wbi),
|
||||
beside = TRUE,
|
||||
names.arg = sorted_baum_ids,
|
||||
col = c("steelblue", "darkorange"),
|
||||
main = "Water Band Index (WBI) - 2022/07/22 & 2022/08/12",
|
||||
xlab = "",
|
||||
ylab = "WBI Value",
|
||||
las = 2,
|
||||
ylim = range(sorted_combined_wbi) * c(0.95, 1.05)
|
||||
)
|
||||
legend("topleft", legend = dates, fill = c("steelblue", "darkorange"))
|
||||
dev.off()
|
||||
}
|
||||
|
||||
plot_wbi_differences <- function(wbi_diff, baum_ids, output_file = "wbi_differences_sorted.png") {
|
||||
wbi_diff <- -wbi_diff
|
||||
sorted_indices <- order(wbi_diff)
|
||||
sorted_wbi_diff <- wbi_diff[sorted_indices]
|
||||
sorted_baum_ids <- baum_ids[sorted_indices]
|
||||
|
||||
png(output_file, width = 1024, height = 720)
|
||||
par(mar = c(10, 5, 4, 2) + 0.1)
|
||||
barplot(
|
||||
sorted_wbi_diff,
|
||||
names.arg = sorted_baum_ids,
|
||||
col = "steelblue",
|
||||
main = "Differenzen im Water Band Index (WBI)",
|
||||
xlab = "",
|
||||
ylab = "WBI Differenz",
|
||||
las = 2
|
||||
)
|
||||
|
||||
dev.off()
|
||||
}
|
||||
|
||||
|
||||
# Variables
|
||||
baum_ids_20220812 <- c(
|
||||
"DE1 (B1-10-5-5)", "DE2 (B1-10-5-3)", "DE4 (B1-10-4-5)", "DE7 (B3-11-3-3)", "DE8 (B3-11-1-3)",
|
||||
"DE10 (B 3-11-1-1)", "IT2 (A 1-9-3-5)", "IT3 (A 1-9-4-4)", "IT5 (A 1-9-5-2)", "IT7 (B 1-2-3-3)",
|
||||
"IT8 (B 1-2-2-2)", "IT9 (B 1-2-2-3)", "ES2 (A 2-3-3-2)", "ES5 (A 2-3-4-4)",
|
||||
"ES8 (B 2-10-5-5)", "ES9 (B 2-10-2-4)", "ES10 (B 2-10-3-1)", "FR1 (A 1-7-2-5)", "FR2 (A 1-7-1-1)",
|
||||
"FR4 (A 1-1-1-3)", "FR5 (A 1-1-2-5)", "FR6 (A 1-1-2-3)", "FR10 (A 1-1-5-4)"
|
||||
)
|
||||
|
||||
# Calculation
|
||||
spektren20220721.df <- process_spectral_data(file_path = "~/Developer/courses/2021\ Projektbezogenes\ Arbeiten/Abschlussarbeit/data/export_20220721.dat", grouping_size = 17, exclude_index = 8, encoding = "UTF-16LE", baum_ids = baum_ids_20220812)
|
||||
spektren20220812.df <- process_spectral_data(file_path = "~/Developer/courses/2021\ Projektbezogenes\ Arbeiten/Abschlussarbeit/data/export_20220812.dat", grouping_size = 17, exclude_index = 13, encoding = "UTF-16LE")
|
||||
mean_values_20220721.df <- create_mean_values_df(spektren20220721.df, num_baeume = 23, spalten_pro_baum = 15)
|
||||
mean_values_20220812.df <- create_mean_values_df(spektren20220812.df, num_baeume = 23, spalten_pro_baum = 15)
|
||||
wbi_20220721 <- calculate_wbi(mean_values_20220721.df)
|
||||
wbi_20220812 <- calculate_wbi(mean_values_20220812.df)
|
||||
wbi_diff <- calculate_wbi_differences(wbi_20220721,wbi_20220812)
|
||||
|
||||
# Plotting
|
||||
plot_spectral_data(mean_values_df = mean_values_20220721.df, output_file = "plots/spectrum_20220721.png", baum_ids = baum_ids_20220812, xlim = c(400, 1050), ylim = c(0, 1), date_of_capture = "2022/07/21")
|
||||
plot_spectral_data(mean_values_df = mean_values_20220812.df, output_file = "plots/spectrum_20220812.png", baum_ids = baum_ids_20220812, xlim = c(400, 1050), ylim = c(0, 1), date_of_capture = "2022/08/12")
|
||||
plot_wbi_values(wbi_20220721, baum_ids = baum_ids_20220812, output_file = "plots/wbi_20220721.png", date_of_capture = "2022/07/21")
|
||||
plot_wbi_values(wbi_20220812, baum_ids = baum_ids_20220812, output_file = "plots/wbi_20220812.png", date_of_capture = "2022/08/12")
|
||||
plot_combined_wbi_values(wbi_values_1 = wbi_20220721, wbi_values_2 = wbi_20220812, baum_ids = baum_ids_20220812, output_file = "plots/wbi_combined.png", dates = c("2022/07/21", "2022/08/12"))
|
||||
plot_wbi_differences(wbi_diff, baum_ids = baum_ids_20220812, output_file = "plots/wbi_differences.png")
|
||||
@@ -0,0 +1,8 @@
|
||||
source("main.R")
|
||||
|
||||
print(paste("Dimensions: ",length(wbi_20220721)))
|
||||
print(paste("Dimensions: ",length(wbi_20220812)))
|
||||
|
||||
print(paste("Values 20220721: ",wbi_20220721))
|
||||
print(paste("Values 20220812: ",wbi_20220812))
|
||||
print(paste("Values Difference: ", wbi_diff))
|
||||
@@ -0,0 +1,130 @@
|
||||
|
||||
###############################################
|
||||
# Spektrendatei oeffnen #
|
||||
###############################################
|
||||
|
||||
spektren <- read.table("export_20220714.dat", header=F, fileEncoding = "UTF16")
|
||||
|
||||
#View(spektren)
|
||||
|
||||
###############################################
|
||||
# Tabelle anpassen #
|
||||
###############################################
|
||||
|
||||
|
||||
spektren.df <- lapply(spektren, function(x) {gsub(",", "", x)})
|
||||
spektren.df <- lapply(spektren.df, function(x) as.numeric(x))
|
||||
spektren.df <- as.data.frame(spektren.df)
|
||||
|
||||
wl <- "wavelength"
|
||||
white <- as.character(1)
|
||||
messungen <- as.character(seq(1,290,1))
|
||||
|
||||
names <- c(rbind(wl, messungen))
|
||||
names(spektren.df) <- names
|
||||
|
||||
View(spektren.df)
|
||||
|
||||
#write.csv(spektren.df,"/cloud/project/20220721_dataframe.csv")
|
||||
|
||||
###############################################
|
||||
# Messungen mit Korrektur der Referenzmessung #
|
||||
###############################################
|
||||
|
||||
# Die Ueberpruefung der Plausibiltaet der Messungen ist ein wichtiger Schritt
|
||||
# Wir ueberpruefen hier die Referenzmessung und bekommen einen Eindruck
|
||||
# vom mittleren Reflexionsverhalten der gemessenen Blaetter
|
||||
|
||||
|
||||
### Angaben zur Messung des Baumes
|
||||
prov = "xyz"
|
||||
baum.id = "abc"
|
||||
|
||||
# Spalte der Referenzmessung
|
||||
spalte.ref = 1
|
||||
|
||||
# Vektor mit Blattmessungen
|
||||
spalten.messungen = seq(2,16,1)
|
||||
|
||||
# alternativ (falls es mal Fehlmessungen etc. gibt)
|
||||
#spalten.messungen = c(2,3,4,5,6,7,8,9,10,11,12,13,14,15,16)
|
||||
|
||||
# Spalte der weisen Referenz
|
||||
white=as.character(spalte.ref)
|
||||
|
||||
# Spalten der dazugeh?rigen Messungen
|
||||
mean <- rowMeans(spektren.df[, as.character(spalten.messungen)])
|
||||
|
||||
# Farbe Linie fuer das mittlere Spektrum
|
||||
col1 =" forest green"
|
||||
# Farbe fuer die Referenzmessung
|
||||
col2 = "gray"
|
||||
|
||||
# Plot mean
|
||||
plot(spektren.df$wavelength,
|
||||
#mean.ratio,
|
||||
xlab="Wellenlaenge (nm)", ylab="Reflexion (%)",
|
||||
type="l", col=col1, lwd=3,
|
||||
ylim= c(0,1), xlim=c(400,1050),
|
||||
main=paste("Baum ", baum.id, ", Provenienz ", prov, sep=""))
|
||||
lines(spektren.df$wavelength, unlist(spektren.df[white]), type="l", col=col2, lwd=3)
|
||||
|
||||
legend("bottomright",legend=c(paste("Baum ", baum.id, ", Provenienz ", prov, sep=""), "Referenz"),
|
||||
text.col=c(col1, col2),pch=c("-"),col=c(col1, col2), lwd=3)
|
||||
|
||||
|
||||
# Folgende Korrekture ist normalerweise nicht notwendig, wir muessen aber teilweise die Spektren
|
||||
# korrigieren, da die gemessene wei?e Referenz start von der "Einserlinie" abweicht.
|
||||
|
||||
# Bei den Messungen, wo die Referenz um 1 liegt, sieht man natuerlich keinen
|
||||
# gro?en Effekt,
|
||||
|
||||
# Es is aber fraglich, ob die Korrektur immer ausreichend ist.
|
||||
mean.ratio <- mean*1/unlist(spektren.df[white])
|
||||
|
||||
|
||||
|
||||
# Plot mean.ratio
|
||||
jpeg("mean_ratio.jpeg", quality = 100)
|
||||
plot(spektren.df$wavelength,
|
||||
mean.ratio,
|
||||
xlab="Wellenl?nge (nm)", ylab="Reflexion (%)",
|
||||
type="l", col=col1, lwd=3,
|
||||
ylim= c(0,1), xlim=c(400,1050),
|
||||
main=paste("Korrigiert - Baum ", baum.id, ", Provenienz ", prov, sep=""))
|
||||
lines(spektren.df$wavelength, unlist(spektren.df[white]), type="l", col=col2, lwd=3)
|
||||
|
||||
legend("bottomright",
|
||||
legend=c(paste("Baum ", baum.id, ", Provenienz ", prov, sep=""), "Referenz"),
|
||||
text.col=c(col1, col2), pch=c("-"),col=c(col1, col2), lwd=3)
|
||||
|
||||
|
||||
dev.off()
|
||||
|
||||
################################################
|
||||
# Plotten der Einzelmessungen fuer eine Messreihe #
|
||||
################################################
|
||||
|
||||
# Einzelmessungen einer Messreihe
|
||||
|
||||
# Hier koennen wir uns anschauen, ob alles mit den einzelnen Spektren passt un
|
||||
# wie variabel die Messungen sind. Ggf. k?nnen noch Fehlmessungen ausgeschlossen werden.
|
||||
|
||||
# Hier der Plot ohne Korrektur der Referenz, ist aber natürlich ohne Weiteres umsetzbar
|
||||
|
||||
jpeg("messreihe.jpeg", quality = 100)
|
||||
|
||||
plot(spektren.df$wavelength,
|
||||
spektren.df[, as.character(spalten.messungen)[1]],
|
||||
xlab="Wellenl?nge (nm)",
|
||||
ylab="Reflexion (%)",
|
||||
type="l", col=col2, lwd=1,
|
||||
ylim= c(0,0.6), xlim=c(400,1050),
|
||||
main=paste("Baum ", baum.id, ", Provenienz ", prov, sep=""))
|
||||
for (i in 2:length(spalten.messungen)){
|
||||
lines(spektren.df$wavelength,
|
||||
spektren.df[, as.character(spalten.messungen [i])],
|
||||
col=col2, lwd=1)
|
||||
}
|
||||
|
||||
dev.off()
|
||||
@@ -0,0 +1,127 @@
|
||||
|
||||
###############################################
|
||||
# Spektrendatei öffnen #
|
||||
###############################################
|
||||
|
||||
setwd("C:\\Users\\stellmes\\Documents\\202207")
|
||||
|
||||
spektren <- read.table("export_20220714.dat", header=F, fileEncoding = "UTF16")
|
||||
|
||||
View(spektren)
|
||||
|
||||
###############################################
|
||||
# Tabelle anpassen #
|
||||
###############################################
|
||||
|
||||
|
||||
spektren.df <- lapply(spektren, function(x) {gsub(",", "", x)})
|
||||
spektren.df <- lapply(spektren.df, function(x) as.numeric(x))
|
||||
spektren.df <- as.data.frame(spektren.df)
|
||||
|
||||
wl <- "wavelength"
|
||||
#white <- as.character(1)
|
||||
messungen <- as.character(seq(1,290,1))
|
||||
|
||||
names <- c(rbind(wl, messungen))
|
||||
names(spektren.df) <- names
|
||||
|
||||
View(spektren.df)
|
||||
|
||||
|
||||
###############################################
|
||||
# Messungen mit Korrektur der Referenzmessung #
|
||||
###############################################
|
||||
|
||||
# Die Überprüfung der Plausibiltät der Messungen ist ein wichtiger Schritt
|
||||
# Wir überprüfen hier die Referenzmessung und bekommen einen Eindruck
|
||||
# vom mittleren Reflexionsverhalten der gemessenen Blätter
|
||||
|
||||
|
||||
### Angaben zur Messung des Baumes
|
||||
prov = "xyz"
|
||||
baum.id = "abc"
|
||||
|
||||
# Spalte der Referenzmessung
|
||||
spalte.ref = 1
|
||||
|
||||
# Vektor mit Blattmessungen
|
||||
spalten.messungen = seq(2,16,1)
|
||||
|
||||
# alternativ (falls es mal Fehlmessungen etc. gibt)
|
||||
#spalten.messungen = c(2,3,4,5,6,7,8,9,10,11,12,13,14,15,16)
|
||||
|
||||
# Spalte der weißen Referenz
|
||||
white=as.character(spalte.ref)
|
||||
|
||||
# Spalten der dazugehörigen Messungen
|
||||
mean <- rowMeans(spektren.df[, as.character(spalten.messungen)])
|
||||
|
||||
# Farbe Linie für das mittlere Spektrum
|
||||
col1 =" forest green"
|
||||
# Farbe für die Referenzmessung
|
||||
col2 = "gray"
|
||||
|
||||
# Plot mean
|
||||
plot(spektren.df$wavelength,
|
||||
mean.ratio,
|
||||
xlab="Wellenlänge (nm)", ylab="Reflexion (%)",
|
||||
type="l", col=col1, lwd=3,
|
||||
ylim= c(0,1), xlim=c(400,1050),
|
||||
main=paste("Baum ", baum.id, ", Provenienz ", prov, sep=""))
|
||||
lines(spektren.df$wavelength, unlist(spektren.df[white]), type="l", col=col2, lwd=3)
|
||||
|
||||
legend("bottomright",legend=c(paste("Baum ", baum.id, ", Provenienz ", prov, sep=""), "Referenz"),
|
||||
text.col=c(col1, col2),pch=c("-"),col=c(col1, col2), lwd=3)
|
||||
|
||||
|
||||
# Folgende Korrekture ist normalerweise nicht notwendig, wir müssen aber teilweise die Spektren
|
||||
# korrigieren, da die gemessene weiße Referenz start von der "Einserlinie" abweicht.
|
||||
|
||||
# Bei den Messungen, wo die Referenz um 1 liegt, sieht man natürlich keinen
|
||||
# großen Effekt,
|
||||
|
||||
# Es is aber fraglich, ob die Korrektur immer ausreichend ist.
|
||||
mean.ratio <- mean*1/unlist(spektren.df[white])
|
||||
|
||||
|
||||
|
||||
# Plot mean.ratio
|
||||
plot(spektren.df$wavelength,
|
||||
mean.ratio,
|
||||
xlab="Wellenlänge (nm)", ylab="Reflexion (%)",
|
||||
type="l", col=col1, lwd=3,
|
||||
ylim= c(0,1), xlim=c(400,1050),
|
||||
main=paste("Korrigiert - Baum ", baum.id, ", Provenienz ", prov, sep=""))
|
||||
lines(spektren.df$wavelength, unlist(spektren.df[white]), type="l", col=col2, lwd=3)
|
||||
|
||||
legend("bottomright",
|
||||
legend=c(paste("Baum ", baum.id, ", Provenienz ", prov, sep=""), "Referenz"),
|
||||
text.col=c(col1, col2), pch=c("-"),col=c(col1, col2), lwd=3)
|
||||
|
||||
|
||||
|
||||
|
||||
################################################
|
||||
# Plotten der Einzelmessungen für eine Messreihe #
|
||||
################################################
|
||||
|
||||
# Einzelmessungen einer Messreihe
|
||||
|
||||
# Hier können wir uns anschauen, ob alles mit den einzelnen Spektren passt un
|
||||
# wie variabel die Messungen sind. Ggf. können noch Fehlmessungen ausgeschlossen werden.
|
||||
|
||||
# Hier der Plot ohne Korrektur der Referenz, ist aber natürlich ohne Weiteres umsetzbar
|
||||
|
||||
plot(spektren.df$wavelength,
|
||||
spektren.df[, as.character(spalten.messungen)[1]],
|
||||
xlab="Wellenlänge (nm)",
|
||||
ylab="Reflexion (%)",
|
||||
type="l", col=col2, lwd=1,
|
||||
ylim= c(0,0.6), xlim=c(400,1050),
|
||||
main=paste("Baum ", baum.id, ", Provenienz ", prov, sep=""))
|
||||
for (i in 2:length(spalten.messungen)){
|
||||
lines(spektren.df$wavelength,
|
||||
spektren.df[, as.character(spalten.messungen [i])],
|
||||
col=col2, lwd=1)
|
||||
}
|
||||
|
||||
Reference in New Issue
Block a user