added ws202425 courses
This commit is contained in:
@@ -0,0 +1,75 @@
|
||||
#install.packages("raster")
|
||||
#install.packages("rgdal")
|
||||
library(raster)
|
||||
library(rgdal)
|
||||
|
||||
#Assign .tif to an object
|
||||
dem <- raster("SRTM_ffB01_p045r032.tif")
|
||||
|
||||
#General information
|
||||
summary(dem)
|
||||
|
||||
#Structure of an object
|
||||
str(dem)
|
||||
|
||||
#Visualize the imagery
|
||||
plot(dem)
|
||||
##Set min and max value
|
||||
plot(dem, zlim=c(0,3000))
|
||||
##Change color schemes (greyscale)
|
||||
plot(dem, zlim=c(0,3000), col=grey.colors(255))
|
||||
##Change color schemes (terrain colors)
|
||||
plot(dem, zlim=c(0,3000), col=terrain.colors(255))
|
||||
|
||||
#Derive terrain features such as slope and aspect
|
||||
slp <- terrain(dem, opt="slope", unit="degrees")
|
||||
slp <- terrain(dem, opt="aspect", unit="degrees")
|
||||
|
||||
#Read single raster bands
|
||||
blue2011 <- raster ("./LT05_L1TP_045032_20110909_20160831_01_T1/LT05_L1TP_045032_20110909_20160831_01_T1_B1.TIF")
|
||||
green2011 <- raster ("./LT05_L1TP_045032_20110909_20160831_01_T1/LT05_L1TP_045032_20110909_20160831_01_T1_B2.TIF")
|
||||
red2011 <- raster ("./LT05_L1TP_045032_20110909_20160831_01_T1/LT05_L1TP_045032_20110909_20160831_01_T1_B3.TIF")
|
||||
nir2011 <- raster ("./LT05_L1TP_045032_20110909_20160831_01_T1/LT05_L1TP_045032_20110909_20160831_01_T1_B4.TIF")
|
||||
swira2011 <- raster ("./LT05_L1TP_045032_20110909_20160831_01_T1/LT05_L1TP_045032_20110909_20160831_01_T1_B5.TIF")
|
||||
swirb2011 <- raster ("./LT05_L1TP_045032_20110909_20160831_01_T1/LT05_L1TP_045032_20110909_20160831_01_T1_B7.TIF")
|
||||
|
||||
#Multiband raster
|
||||
ls52011 <- stack(blue2011,green2011,red2011,nir2011,swira2011,swirb2011)
|
||||
|
||||
#Plot multiband raster images
|
||||
plot(ls52011)
|
||||
plot(ls52011[[4]]) #only one layer
|
||||
plotRGB(ls52011, 3, 2, 1, stretch="lin") #plot RGB
|
||||
|
||||
#Raster image information
|
||||
res (ls52011) #Resulution
|
||||
projection (ls52011) #Projection
|
||||
dim (ls52011) #Dimention (rows & columns)
|
||||
nlayers (ls52011) #Number of layers
|
||||
extent (ls52011)
|
||||
ncell (ls52011)
|
||||
|
||||
#Display new extent (crop) with lines on a plot
|
||||
plot(nir2011)
|
||||
abline(v=510000)
|
||||
abline(v=580000)
|
||||
abline(h=4490000)
|
||||
abline(h=4543000)
|
||||
|
||||
#Define new extent (crop) with a box on a plot
|
||||
plot(nir2011)
|
||||
e <- extent(510000, 580000, 4490000, 4543000)
|
||||
plot(e, add=TRUE, col = "red")
|
||||
|
||||
#Crop the image
|
||||
ls52011.subs <- crop(ls52011, e)
|
||||
##plot
|
||||
plotRGB (ls52011.subs, 3, 2, 1, stretch="lin")
|
||||
|
||||
#Homework
|
||||
dim(ls52011.subs)
|
||||
ncell(ls52011.subs)
|
||||
extent(ls52011)
|
||||
636315-395685
|
||||
4571415 - 4355985
|
||||
215.430 * 240.630
|
||||
@@ -0,0 +1,147 @@
|
||||
##### 01 Uebung ######
|
||||
|
||||
#1.01 Install packages
|
||||
install.packages("rgdal")
|
||||
install.packages("raster")
|
||||
|
||||
#1.02 Load packages
|
||||
library(raster)
|
||||
library(rgdal)
|
||||
|
||||
#1.03 Set working directory
|
||||
setwd("/Users/huaqo/Nextcloud/Regionale Themen/02 uebung")
|
||||
|
||||
#1.04 Assign .tif to an object
|
||||
dem <- raster("SRTM_ffB01_p045r032.tif")
|
||||
|
||||
#1.05 General information
|
||||
summary(dem)
|
||||
|
||||
#1.06 Structure of an object
|
||||
str(dem)
|
||||
|
||||
#1.07 Visualize the imagery
|
||||
plot(dem)
|
||||
##1.08 Set min and max value
|
||||
plot(dem, zlim=c(0,3000))
|
||||
##1.09 Change color schemes (greyscale)
|
||||
plot(dem, zlim=c(0,3000), col=grey.colors(255))
|
||||
##1.10Change color schemes (terrain colors)
|
||||
plot(dem, zlim=c(0,3000), col=terrain.colors(255))
|
||||
|
||||
#1.11Derive terrain features such as slope and aspect
|
||||
slp <- terrain(dem, opt="slope", unit="degrees")
|
||||
slp <- terrain(dem, opt="aspect", unit="degrees")
|
||||
|
||||
#1.12Read single raster bands
|
||||
blue2011 <- raster ("/Users/fokus/Nextcloud/Regionale Themen/LT05_L1TP_045032_20110909_20160831_01_T1/LT05_L1TP_045032_20110909_20160831_01_T1_B1.TIF")
|
||||
green2011 <- raster ("/Users/fokus/Nextcloud/Regionale Themen/LT05_L1TP_045032_20110909_20160831_01_T1/LT05_L1TP_045032_20110909_20160831_01_T1_B2.TIF")
|
||||
red2011 <- raster ("/Users/fokus/Nextcloud/Regionale Themen/LT05_L1TP_045032_20110909_20160831_01_T1/LT05_L1TP_045032_20110909_20160831_01_T1_B3.TIF")
|
||||
nir2011 <- raster ("/Users/fokus/Nextcloud/Regionale Themen/LT05_L1TP_045032_20110909_20160831_01_T1/LT05_L1TP_045032_20110909_20160831_01_T1_B4.TIF")
|
||||
swira2011 <- raster ("/Users/fokus/Nextcloud/Regionale Themen/LT05_L1TP_045032_20110909_20160831_01_T1/LT05_L1TP_045032_20110909_20160831_01_T1_B5.TIF")
|
||||
swirb2011 <- raster ("/Users/fokus/Nextcloud/Regionale Themen/LT05_L1TP_045032_20110909_20160831_01_T1/LT05_L1TP_045032_20110909_20160831_01_T1_B7.TIF")
|
||||
|
||||
#1.13Multiband raster
|
||||
ls52011 <- stack(blue2011,green2011,red2011,nir2011,swira2011,swirb2011)
|
||||
|
||||
#1.14 Plot multiband raster images
|
||||
plot(ls52011)
|
||||
plot(ls52011[[4]]) #only one layer
|
||||
plotRGB(ls52011, 3, 2, 1, stretch="lin") #plot RGB
|
||||
|
||||
#1.15 Raster image information
|
||||
res (ls52011) #Resulution
|
||||
projection (ls52011) #Projection
|
||||
dim (ls52011) #Dimention (rows & columns)
|
||||
nlayers (ls52011) #Number of layers
|
||||
extent (ls52011)
|
||||
ncell (ls52011)
|
||||
|
||||
#1.16 Display new extent (crop) with lines on a plot
|
||||
plot(nir2011)
|
||||
abline(v=510000)
|
||||
abline(v=580000)
|
||||
abline(h=4490000)
|
||||
abline(h=4543000)
|
||||
|
||||
#1.17 Define new extent (crop) with a box on a plot
|
||||
plot(nir2011)
|
||||
e <- extent(510000, 580000, 4490000, 4543000)
|
||||
plot(e, add=TRUE, col = "red")
|
||||
|
||||
#1.18 Crop the image
|
||||
ls52011.subs <- crop(ls52011, e)
|
||||
##plot
|
||||
plotRGB (ls52011.subs, 3, 2, 1, stretch="lin")
|
||||
|
||||
#1.19 Homework
|
||||
dim(ls52011.subs)
|
||||
ncell(ls52011.subs)
|
||||
extent(ls52011)
|
||||
636315-395685
|
||||
4571415 - 4355985
|
||||
215.430 * 240.630
|
||||
|
||||
####### 02 Uebung #######
|
||||
## For Landsat 5
|
||||
#1.01
|
||||
#1.02
|
||||
#1.03
|
||||
#1.12
|
||||
#1.13
|
||||
|
||||
#2.01 Export layerstack
|
||||
writeRaster(l5_2011, "L5_2011_entire.tif", Format="GTiff", overwrite = TRUE)
|
||||
|
||||
#1.17
|
||||
#2.01
|
||||
#1.13
|
||||
|
||||
## For Landsat 8
|
||||
|
||||
blue2014 <- raster ("/Users/huaqo/Nextcloud/Regionale Themen/02 uebung/LC08_L1TP_045032_20140901_20170303_01_T1/LC08_L1TP_045032_20140901_20170303_01_T1_B2.TIF")
|
||||
green2014 <- raster ("/Users/huaqo/Nextcloud/Regionale Themen/02 uebung/LC08_L1TP_045032_20140901_20170303_01_T1/LC08_L1TP_045032_20140901_20170303_01_T1_B3.TIF")
|
||||
red2014 <- raster ("/Users/huaqo/Nextcloud/Regionale Themen/02 uebung/LC08_L1TP_045032_20140901_20170303_01_T1/LC08_L1TP_045032_20140901_20170303_01_T1_B4.TIF")
|
||||
nir2014 <- raster ("/Users/huaqo/Nextcloud/Regionale Themen/02 uebung/LC08_L1TP_045032_20140901_20170303_01_T1/LC08_L1TP_045032_20140901_20170303_01_T1_B5.TIF")
|
||||
swira2014 <- raster ("/Users/huaqo/Nextcloud/Regionale Themen/02 uebung/LC08_L1TP_045032_20140901_20170303_01_T1/LC08_L1TP_045032_20140901_20170303_01_T1_B6.TIF")
|
||||
swirb2014 <- raster ("/Users/huaqo/Nextcloud/Regionale Themen/02 uebung/LC08_L1TP_045032_20140901_20170303_01_T1/LC08_L1TP_045032_20140901_20170303_01_T1_B7.TIF")
|
||||
ls82014 <- stack(blue2014, green2014, red2014, nir2014, swira2014, swirb2014)
|
||||
ls82014.crop <- crop(ls82014, e)
|
||||
writeRaster(ls82014, "ls82014_entire.tif", Format="GTiff", overwrite = TRUE)
|
||||
writeRaster(ls82014.crop, "ls82014.tif", Format="GTiff", overwrite = TRUE)
|
||||
ls52011.crop <- stack("ls52011.tif")
|
||||
ls82014.crop <- stack("ls82014.tif")
|
||||
|
||||
#Metadata
|
||||
# REFLECTANCE_MULT_BAND_4 = 2.0000E-05
|
||||
# REFLECTANCE_ADD_BAND_4 = -0.100000
|
||||
# SUN_ELEVATION = 53.22163770
|
||||
# EARTH_SUN_DISTANCE = 1.0091290
|
||||
|
||||
#Calculation of the TOA reflectance for one band
|
||||
ls82014_NIR_TOA_simple <- (ls82014.crop[[4]]*0.00002) - 0.1
|
||||
plot(ls82014_NIR_TOA_simple, col = grey.colors(255), zlim= c(0,1))
|
||||
|
||||
#Correct for the sun zenith angle and the sun-earth-distance for one band
|
||||
sun_elev <- 53.22163770
|
||||
sun_earth_distance <- 1.0091290
|
||||
ls82014_NIR_TOA <- ls82014_NIR_TOA_simple * sun_earth_distance^2 / sin(sun_elev*pi/180)
|
||||
plot(NIR_TOA, col = grey.colors(255), zlim= c(0,0.6))
|
||||
|
||||
#Correct all for all bands
|
||||
ls82014_TOA_corrected <- (((ls82014.crop*0.00002) - 0.1) * sun_earth_distance^2) / sin(sun_elev*pi/180)
|
||||
writeRaster(ls82014_TOA_corrected, "ls82014_TOA_corrected.tif", format = "GTiff", overwrite = TRUE)
|
||||
|
||||
#Correct for dark pixels
|
||||
min2014 <- minValue(ls82014_TOA_corrected)
|
||||
ls82014_darkpixel_corrected <- ls82014_TOA_corrected - min2014
|
||||
writeRaster(ls82014_darkpixel_corrected, format = "GTiff")
|
||||
plotRGB(ls82014_darkpixel_corrected,4,3,2, stretch="lin")
|
||||
|
||||
#Q1: No Comparison
|
||||
#Q2:
|
||||
##DM: Quantized and calibrated scaled Digital Numbers (DN) representing the multispectral image acquired by OLI and TIRS.
|
||||
##TOA: They can be converted to Top Of Atmosphere (TOA) reflectance and radiance values by using radiometric rescaling coefficients as described in this USGS guide.
|
||||
##Surface Reflectance products provide an estimate of the surface spectral reflectance as it would be measured at ground level in the absence of atmospheric scattering or absorption.
|
||||
#Q3: Level1: DM oder TOA Level2: SR
|
||||
#Q4: Yes it is a physical Value but without the correct for the sunzenith ang and Earth distance
|
||||
@@ -0,0 +1,109 @@
|
||||
#Preprocessed data import
|
||||
l5_2011_rawdn <- stack('L5_2011.tif')
|
||||
l5_2011_toa <- stack('L5_2011_TOA.tif')
|
||||
l5_2011_surfref <- stack('L5_2011_sr.tif')
|
||||
|
||||
#Rescale data according to metadata
|
||||
l5_2011_surfref <- -0.2 + l5_2011_surfref*2.75e-05
|
||||
|
||||
#Export raster
|
||||
writeRaster(l5_2011_surfref, 'L5_2011_sr_rescaled.tif', Format='GTiff', overwrite= TRUE)
|
||||
|
||||
#Remove negative values, set negative to 0, above 1 values to 1
|
||||
l5_2011_surfref <- reclassify(l5_2011_surfref, c(-Inf,0,0,1,Inf,1))
|
||||
|
||||
#Plot
|
||||
plotRGB(l5_2011_rawdn, 3,2,1, stretch='lin')
|
||||
plotRGB(l5_2011_toa, 3,2,1, stretch='lin')
|
||||
plotRGB(l5_2011_surfref, 3,2,1, stretch='lin')
|
||||
|
||||
#
|
||||
lambda <- c(480, 560, 655, 865, 1610, 2150)
|
||||
|
||||
#Pick a spot with vegetation and show the spectra
|
||||
plotRGB(l5_2011_surfref, r=4, g=3, b=2, stretch="lin")
|
||||
pxy<-locator(1) # This function requires an input! -> Click once in the image on a vegetated area --> then wait!
|
||||
|
||||
spectrum_rawdn<-extract(l5_2011_rawdn, cbind(pxy$x[1], pxy$y[1]))
|
||||
spectrum_toa<-extract(l5_2011_toa, cbind(pxy$x[1], pxy$y[1]))
|
||||
spectrum_surfref<-extract(l5_2011_surfref, cbind(pxy$x[1], pxy$y[1]))
|
||||
dev.off()
|
||||
|
||||
par(mfrow=c(1,3))
|
||||
plot(lambda, spectrum_rawdn,
|
||||
ylab="raw DN",
|
||||
xlab="wavelength (nm)", type='b')
|
||||
plot(lambda, spectrum_toa,
|
||||
ylab="ToA reflectance",
|
||||
xlab="wavelength (nm)", type='b')
|
||||
plot(lambda, spectrum_surfref,
|
||||
ylab="Surface reflectance",
|
||||
xlab="wavelength (nm)", type='b')
|
||||
|
||||
#Load terrain correction file
|
||||
dem <- stack('/Users/huaqo/Downloads/SRTM_ffB01_p045r032.tif')
|
||||
|
||||
#Match to images
|
||||
dem <- resample(dem, l5_2011_surfref)
|
||||
|
||||
#Calculate slope and aspect
|
||||
slp <- terrain (dem, opt='slope')
|
||||
asp <- terrain (dem, opt='aspect')
|
||||
|
||||
#Input sun position
|
||||
theta_e <- 49.6590900
|
||||
theta_a <- 144.56665673
|
||||
|
||||
#Calculate the hillshade
|
||||
hs2011 <- hillShade(slp,asp, angle = theta_e, direction = theta_a)
|
||||
|
||||
#Plot hillshade
|
||||
plot(hs2011, col=grey.colors(255), zlim=c(0,1))
|
||||
summary(hs2011)
|
||||
|
||||
#Reclassify data
|
||||
hs2011 <- reclassify(hs2011, matrix(c(-Inf, 0, 0.0), 1, 3))
|
||||
|
||||
#Topographic normalization with hillshade
|
||||
l5_2011_topo <- l5_2011_surfref*cos((90-theta_e)/180*pi) / hs2011
|
||||
|
||||
#Export
|
||||
writeRaster(l5_2011_topo, 'l5_2011_topo.tif', format='GTiff', overwrite=TRUE)
|
||||
|
||||
#Plot
|
||||
par(mfrow=c(1,2))
|
||||
plotRGB(l5_2011_surfref, r=4, g=3, b=2, stretch="lin")
|
||||
plotRGB(l5_2011_topo, r=4, g=3, b=2, stretch="lin")
|
||||
|
||||
#Export Plot
|
||||
savePlot('topographic correction', type='jpeg')
|
||||
|
||||
#Read shapefile with two example points
|
||||
points <- readOGR('/Users/huaqo/Downloads/shape/points.shp')
|
||||
|
||||
#Plot points
|
||||
plotRGB(l5_2011_surfref,4,3,2, stretch='lin')
|
||||
plot(points, col=c('green', 'orange'), pch=19, add=TRUE)
|
||||
|
||||
#Extract pixel values below points
|
||||
spectrum_surfref <- extract(l5_2011_surfref, points)
|
||||
spectrum_topo <- extract(l5_2011_topo, points)
|
||||
|
||||
spectrum_surfref
|
||||
spectrum_topo
|
||||
|
||||
#Plot spectra
|
||||
x11()
|
||||
par(mfrow=c(2,2))
|
||||
plot(lambda, spectrum_surfref[2,],
|
||||
ylab="Surface reflectance",
|
||||
xlab="wavelength (nm)", type='b', ylim=c(0,0.4), main="no topo - illuminated")
|
||||
plot(lambda, spectrum_surfref[1,],
|
||||
ylab="Surface reflectance",
|
||||
xlab="wavelength (nm)", type='b', ylim=c(0,0.4), main="no topo - shaded")
|
||||
plot(lambda,spectrum_topo[2,],
|
||||
ylab="Surface reflectance",
|
||||
xlab="wavelength (nm)", type='b', ylim=c(0,0.4), main="topo - illuminated")
|
||||
plot(lambda,spectrum_topo[1,],
|
||||
ylab="Surface reflectance",
|
||||
xlab="wavelength (nm)", type='b', ylim=c(0,0.4), main="topo - shaded")
|
||||
@@ -0,0 +1,106 @@
|
||||
#Preparation
|
||||
library(rgdal)
|
||||
library(raster)
|
||||
setwd('~/Nextcloud/Fernerkundung/Regionale Themen/04')
|
||||
l5_2011 <- stack("l5_2011_topo.tif")
|
||||
l8_2014 <- stack("L8_2014_topo.tif")
|
||||
|
||||
#NDWI Change analysis
|
||||
|
||||
##NDWI and change image (NDWI=Green-SWIR/Green+SWIR)
|
||||
ndwi2014 <- (l8_2014[[2]] - l8_2014[[5]]) / (l8_2014[[2]] + l8_2014[[5]])
|
||||
ndwi2011 <- (l5_2011[[2]] - l5_2011[[5]]) / (l5_2011[[2]] + l5_2011[[5]])
|
||||
|
||||
###Plot NDWI
|
||||
plot(ndwi2011, zlim=c(-1,1))
|
||||
plot(ndwi2014, zlim=c(-1,1))
|
||||
|
||||
###Calculate change image
|
||||
change <- ndwi2011-ndwi2014
|
||||
|
||||
###Plot
|
||||
plot(change)
|
||||
|
||||
##Change threshold
|
||||
plot(density(change))
|
||||
abline(v = 0.3,
|
||||
col = 'red')
|
||||
loss <- change > 0.3
|
||||
plot(loss)
|
||||
|
||||
##Derive change area
|
||||
lossval <- getValues(loss) #convert the values of the raster to a matrix or vector
|
||||
table(lossval)
|
||||
|
||||
###Area in km/m
|
||||
area <- table (lossval)[2] * 30 * 30 / 10000
|
||||
area2 <- table (lossval)[2] * res(change) * res(change) / 10000
|
||||
print(paste("The results of both variants should be equal: ", area, " = ", area2))
|
||||
|
||||
#Vector data
|
||||
|
||||
##Download administrative data
|
||||
adm <- getData ("GADM", country="USA", level=2)
|
||||
#plot(adm)
|
||||
|
||||
##Select specific polygons
|
||||
adm[adm$NAME_2=='Trinity',]
|
||||
shasta.county <- adm[adm$NAME_2=='Shasta',]
|
||||
shasta.county
|
||||
trinity.county <- adm[adm$NAME_2=='Trinity' & adm$NAME_1=='California',]
|
||||
trinity.county
|
||||
|
||||
###Plot
|
||||
plot(shasta.county)
|
||||
plot(trinity.county)
|
||||
|
||||
###Combined plot option
|
||||
counties <- bind(shasta.county, trinity.county)
|
||||
plot(counties)
|
||||
|
||||
##Change projection of geodata in R
|
||||
crs(shasta.county) #show projection
|
||||
crs(loss)
|
||||
|
||||
shasta.county.utm <- spTransform (shasta.county, crs(loss)) #change projection
|
||||
trinity.county.utm <- spTransform(trinity.county, crs(loss))
|
||||
|
||||
crs (shasta.county.utm)
|
||||
|
||||
###Plot
|
||||
plot(loss)
|
||||
plot(shasta.county.utm, add=TRUE)
|
||||
plot(trinity.county.utm, add=TRUE)
|
||||
|
||||
##Clip the raster data based on specific polygons
|
||||
shasta.loss <- mask(loss, shasta.county.utm)
|
||||
plot(shasta.loss)
|
||||
trinity.loss <- mask(loss, trinity.county.utm)
|
||||
plot(trinity.loss)
|
||||
|
||||
###Loss area
|
||||
shasta.lossval <- getValues (shasta.loss)
|
||||
shasta.area <- table(shasta.lossval)[2] * res(shasta.loss)[1] * res(shasta.loss)[2] / 10000
|
||||
|
||||
trinity.lossval <- getValues (trinity.loss)
|
||||
trinity.area <- table(trinity.lossval)[2] * res(trinity.loss)[1] * res(trinity.loss)[2] / 10000
|
||||
|
||||
print(paste("The loss area of Shasta county equals ", shasta.area, " ha."))
|
||||
print(paste("The loss area of Trinity county equals ", trinity.area, " ha." ))
|
||||
|
||||
#Tasselled Cap Wetness
|
||||
|
||||
##Calculate TCW
|
||||
TCW.ls8 <- c(0.1511, 0.1973, 0.3283, 0.3407, -0.7117, -0.4559)
|
||||
wetness.ls8 <- l8_2014*TCW.ls8
|
||||
wetness.ls8 <- stackApply(wetness.ls8,rep(1,6),sum)
|
||||
wetness.ls8 <- stackApply(wetness.ls8,1,sum)
|
||||
|
||||
wetcol <- colorRampPalette (c("tan3", "beige","navy"))
|
||||
plot(wetness.ls8, col=wetcol(255), zlim=c(-0.4,0.1))
|
||||
|
||||
#Homework
|
||||
|
||||
|
||||
|
||||
|
||||
@@ -0,0 +1,140 @@
|
||||
###Preparation
|
||||
#Package aktivieren
|
||||
library(raster)
|
||||
|
||||
#Arbeitsordner auf Festplatte festlegen
|
||||
setwd("~/Nextcloud/Fernerkundung/Regionale Themen/05")
|
||||
|
||||
###Donwload and open Bioclim data
|
||||
#Lade Datei aus Internet
|
||||
bioclim1 <- getData ('worldclim', var='bio', res=0.5, lon= -122, lat=34)
|
||||
|
||||
#Stellt die Datei dar
|
||||
plot(bioclim1[[1]])
|
||||
|
||||
#Speichert die Datei im Arbeitsordner
|
||||
writeRaster(bioclim1, 'bioclim_1.tif', format='GTiff', overwrite=TRUE)
|
||||
|
||||
#Zeigt die Ausmaße der Datei
|
||||
extent(bioclim1)
|
||||
|
||||
#Lade eine zweite Datei
|
||||
bioclim2 <- getData('worldclim', var='bio', res=0.5, lon=-117, lat=34)
|
||||
|
||||
#Nochmal Plotten
|
||||
plot(bioclim2[[1]])
|
||||
|
||||
#Speichert die Datei
|
||||
writeRaster(bioclim2, 'bioclim_2.tif', format='GTiff', overwrite=TRUE)
|
||||
|
||||
#Karten zuasmmenschneiden
|
||||
bioclim <- merge(bioclim1, bioclim2)
|
||||
|
||||
#Daten Speichern
|
||||
writeRaster(bioclim, 'bioclim.tif', format='GTiff', overwrite=TRUE)
|
||||
|
||||
###Clip data to California
|
||||
#Grenzen von Kalifornien laden
|
||||
CA <- getData('GADM', country='USA', level=1)
|
||||
|
||||
#Bestimmte Grenzen auswählen
|
||||
CA <- CA[CA@data$NAME_1=='California',]
|
||||
|
||||
#Zwei karten übereinander plotten
|
||||
plot(bioclim[[1]])
|
||||
plot(CA, add=T)
|
||||
|
||||
#Grenzdaten und Daten zusammenschneiden
|
||||
bioclim <- crop(bioclim, CA)
|
||||
bioclim <- mask(bioclim, CA)
|
||||
|
||||
#Speichern
|
||||
writeRaster(bioclim, 'bioclim_california.tif', format='GTiff', overwrite=TRUE)
|
||||
|
||||
#Laden
|
||||
bioclim <- stack('bioclim_california.tif')
|
||||
|
||||
#plotten
|
||||
plot(bioclim)
|
||||
|
||||
#Bennenung der Karten
|
||||
names (bioclim) <- c ('Annual Mean Temp', 'Mean Diurnal Range', 'Isothermality',
|
||||
'Temp Seasonality', 'Max Temp Warmest Month',
|
||||
'Min Temp Coldest Month', 'Temp Annual Range',
|
||||
'Mean Temp Wettest Quarter', 'Mean Temp Driest Quarter',
|
||||
'Mean Temp Warmest Quarter', ' Mean Temp Coldest Quarter',
|
||||
'Annual Prec', 'Prec Wettest Month', 'Prec Driest Month',
|
||||
'Prec Seasonality', 'Prec Wettest Quarter',
|
||||
'Prec Driest Quarter', 'Prec Warmest Quarter',
|
||||
'Prec Coldest Quarter')
|
||||
|
||||
#File size reduction undo
|
||||
scaling.factor <- c (10, 10, 1, 1000, 10, 10, 10, 10, 10, 10, 10, 1, 1, 1, 1, 1,
|
||||
1, 1, 1)
|
||||
bioclim <- bioclim / scaling.factor
|
||||
|
||||
#Plot
|
||||
plot(bioclim)
|
||||
|
||||
###Correlation analysis of the Bioclim data
|
||||
|
||||
#Extrahieren von Pixel Werten aus der Raster Datei
|
||||
bc.values <- getValues(bioclim)
|
||||
|
||||
#NA Werte entfernen
|
||||
bc.val <- na.omit(bc.values)
|
||||
|
||||
#Korrelation bestimmen
|
||||
correl <- cor(bc.val)
|
||||
|
||||
#Package für Visualisierung
|
||||
install.packages('corrplot')
|
||||
library(corrplot)
|
||||
|
||||
#Plot correlation
|
||||
plot <- corrplot(correl, order = 'original', addrect = 2)
|
||||
plot <- corrplot(correl, order = 'hclust', addrect = 4)
|
||||
|
||||
|
||||
|
||||
###Principal component analysis of bioclim data
|
||||
install.packages('RStoolbox')
|
||||
library(RStoolbox)
|
||||
|
||||
#Calculate PCA
|
||||
PCA <- rasterPCA(bioclim, spca=TRUE)
|
||||
|
||||
#Plot PCA
|
||||
plot(PCA$model$sdev)
|
||||
|
||||
#Plot PCA Space (Climate Zones)
|
||||
plotRGB(PCA$map,1,2,3, stretch='lin')
|
||||
|
||||
###Additional: Detailed analysis: interpreting the principal components
|
||||
pcascores <- na.omit(getValues(PCA$map))
|
||||
|
||||
rescale <- function (x) (x - min (x)) / (max (x) - min (x)) * 255
|
||||
pcargb <- apply (pcascores[,1:3], 2, rescale)
|
||||
pca.rgb <- rgb(pcargb, maxColorValue=255)
|
||||
|
||||
install.packages('vegan')
|
||||
library(vegan)
|
||||
|
||||
sel <- sample(1:nrow (pcascores))[1:5000]
|
||||
|
||||
par (bg="black", col="white")
|
||||
plot (pcascores[sel,1:2], cex=0.5, pch=19, col=pca.rgb[sel], col.lab="white",
|
||||
main=colnames(bc.val)[1], col.main="white")
|
||||
axis (1, col="white", col.axis="white")
|
||||
axis (2, col="white", col.axis="white")
|
||||
ordisurf (pcascores[sel, 1:2]~bc.val[sel, 1], add=T, labcex=1, lwd.cl=2,
|
||||
col="white")
|
||||
for (i in 2:19){
|
||||
plot (pcascores[sel,], cex=0.5, pch=19, col=pca.rgb[sel], col.lab="white",
|
||||
main=colnames (bc.val)[i], col.main="white")
|
||||
axis (1, col="white", col.axis="white")
|
||||
axis (2, col="white", col.axis="white")
|
||||
ordisurf (pcascores[sel, 1:2]~bc.val[sel, i], add=T, labcex=1, lwd.cl=2,
|
||||
col="white")
|
||||
readline ("Press <ENTER> for next plot")
|
||||
}
|
||||
@@ -0,0 +1,94 @@
|
||||
setwd("~/OneDrive/Dokumente/Fernerkundung/Regio/07_Klimawandel")
|
||||
|
||||
library (raster)
|
||||
|
||||
bioclim <- stack('/Users/huaqo/OneDrive/Dokumente/Fernerkundung/Regio/07_Klimawandel/bioclim_california.tif')
|
||||
|
||||
names (bioclim) <- c ('Annual Mean Temp', 'Mean Diurnal Range', 'Isothermality',
|
||||
'Temp Seasonality', 'Max Temp Warmest Month',
|
||||
'Min Temp Coldest Month', 'Temp Annual Range',
|
||||
'Mean Temp Wettest Quarter', 'Mean Temp Driest Quarter',
|
||||
'Mean Temp Warmest Quarter', ' Mean Temp Coldest Quarter',
|
||||
'Annual Prec', 'Prec Wettest Month', 'Prec Driest Month',
|
||||
'Prec Seasonality', 'Prec Wettest Quarter',
|
||||
'Prec Driest Quarter', 'Prec Warmest Quarter',
|
||||
'Prec Coldest Quarter')
|
||||
|
||||
scaling.factor <- c (10, 10, 1, 1000, 10, 10, 10, 10, 10, 10, 10, 1, 1, 1, 1, 1,
|
||||
1, 1, 1)
|
||||
|
||||
bioclim <- bioclim/scaling.factor
|
||||
|
||||
bc.values <- getValues(bioclim)
|
||||
|
||||
bc.val <- na.omit(bc.values)
|
||||
|
||||
clim.kmeans <- kmeans(scale(bc.val), centers=8)
|
||||
|
||||
climclust <- clim.kmeans$cluster
|
||||
|
||||
clust.pix <- bc.values[,1]
|
||||
|
||||
clust.pix[is.na(clust.pix)==F] <- climclust
|
||||
|
||||
clust.map <- setValues(bioclim[[1]], clust.pix)
|
||||
|
||||
#jpeg('cluster_climate.png', quality=100)
|
||||
|
||||
cl <- colorRampPalette (c("yellow", "wheat", "goldenrod", "light green", "forest green", "blue", "firebrick", "black") )
|
||||
|
||||
#plot(clust.map, col=cl(8))
|
||||
|
||||
#dev.off()
|
||||
|
||||
#x11()
|
||||
|
||||
#for (i in 1: 19) {
|
||||
# boxplot (bc.val[,i]~climclust, col=cl(8) , main=colnames(bc.val)[i])
|
||||
# readline("Press <ENTER> for next plot")
|
||||
#}
|
||||
|
||||
#for (i in 1: 19) {
|
||||
# png(filename = paste(i, "_", colnames(bc.val)[i], ".png", sep = ""))
|
||||
# boxplot (bc.val[,i]~climclust, col=cl(8) , main=colnames(bc.val)[i])
|
||||
# dev.off()
|
||||
#}
|
||||
|
||||
setwd('/Users/huaqo/OneDrive/Dokumente/Fernerkundung/Regio/07_Klimawandel/gs26bi50')
|
||||
|
||||
files <- Sys.glob("*tif")
|
||||
|
||||
files
|
||||
|
||||
bc.future <- stack(files)
|
||||
|
||||
CA <- getData('GADM', country='USA', level=1)
|
||||
|
||||
CA <- CA[CA$NAME_1=='California',]
|
||||
|
||||
bc.fut <- crop(bc.future, CA)
|
||||
|
||||
bc.fut <- mask(bc.fut, CA)
|
||||
|
||||
names(bc.fut) <- c('Annual Mean Temp', 'Mean Diurnal Range', 'Isothermality',
|
||||
'Temp Seasonality', 'Max Temp Warmest Month', 'Min Temp Coldest Month', 'Temp Annual Range', 'Mean Temp Wettest Quarter', 'Mean Temp Driest Quarter', 'Mean Temp Warmest Quarter', 'Mean Temp Coldest Quarter', 'Annual Prec', 'Prec Wettest Month', 'Prec Driest Month', 'Prec Seasonality' , 'Prec Wettest Quarter', 'Prec Driest Quarter' , 'Prec Warmest Quarter', 'Prec Coldest Quarter')
|
||||
|
||||
scaling.factor <- c(10, 10, 1, 1000, 10, 10, 10, 10, 10, 10, 10, 1, 1, 1, 1, 1,
|
||||
1, 1, 1)
|
||||
|
||||
bc.fut <- bc.fut/scaling.factor
|
||||
|
||||
bc.diff <- bc.fut - bioclim
|
||||
|
||||
#plot(bc.diff[[1]] , col=gray.colors(255,0,1,1))
|
||||
|
||||
library(rgdal)
|
||||
library(rgeos)
|
||||
library(raster)
|
||||
clust.poly <- readOGR('/Users/huaqo/OneDrive/Dokumente/Fernerkundung/Regio/07_Klimawandel/cluster_poly.shp')
|
||||
|
||||
plot(bc.diff[[2]] , col=gray.colors (255, 0, 1, 1))
|
||||
plot(clust.poly, add=T, col=cl(8), density=20, angle=45)
|
||||
legend("topright", legend=1:8 , col=cl(8) , lty=1, lwd=2)
|
||||
|
||||
|
||||
@@ -0,0 +1,134 @@
|
||||
#Minimum Noise Fractioning and narrow band vegetation indices
|
||||
#### 1. Preparation ####
|
||||
##### 1.1 Packages, working directory and reading the data #####
|
||||
install.packages('raster')
|
||||
install.packages('rgdal')
|
||||
install.packages('RStoolbox')
|
||||
|
||||
library(raster)
|
||||
library(rgdal)
|
||||
library(RStoolbox)
|
||||
|
||||
setwd('/Users/huaqo/OneDrive/Dokumente/Fernerkundung/Regio/10_Dürreperioden')
|
||||
|
||||
unzip("EO1H0440342014184110KC_1T.ZIP")
|
||||
|
||||
files <- dir(pattern='TIF')
|
||||
|
||||
##### 1.2 Set scaling factors and cropping extent #####
|
||||
scaling.factor <- c(rep(40,70), rep(80,172))
|
||||
|
||||
ex <- extent(566600, 572900, 4139900, 4149300)
|
||||
|
||||
##### 1.3 Cropping and scaling the data #####
|
||||
hyp_bands <- stack(files)
|
||||
|
||||
hyp <- crop(hyp_bands,ex)*scaling.factor
|
||||
!!!
|
||||
|
||||
#### 2. Checking the data quality ####
|
||||
##### 2.1 Visual inspection of the data quality #####
|
||||
plotRGB (hyp, 50, 20, 10, stretch="lin")
|
||||
|
||||
wl <- as.vector(t(read.table("hyperion.txt")))
|
||||
|
||||
x11()
|
||||
for (i in 1:242){
|
||||
plot (hyp[[i]],
|
||||
col=gray.colors (255, 0, 1, 1),
|
||||
zlim=c(minValue(hyp)[i],
|
||||
maxValue(hyp)[i]),
|
||||
main=paste (wl[i],
|
||||
"nm"))
|
||||
Sys.sleep (0.5)}
|
||||
|
||||
##### 2.2 Remove bad bands #####
|
||||
badbands <- c (1:7,58:78,121:127, 167:178, 224:242)
|
||||
|
||||
wl <- wl[-badbands]
|
||||
|
||||
hyp <- dropLayer(hyp,badbands)
|
||||
|
||||
#### 3. Principal component analysis (PCA) ####
|
||||
##### 3.1 PCA #####
|
||||
pca <- rasterPCA(hyp, spca=T, nSamples=10000)
|
||||
|
||||
##### 3.2 Inspection of the PCA results #####
|
||||
plot(pca$model$sdev)
|
||||
|
||||
plot(cumsum((pca$model$sdev)^2/sum((pca$model$sdev)^2)),ylab="accumulated explained variance",xlab="PC")
|
||||
|
||||
cumsum((pca$model$sdev)^2/sum((pca$model$sdev)^2))[1:10]
|
||||
|
||||
pcax <- pca$map
|
||||
pcaim <- setValues(hyp,pcax)
|
||||
plotRGB (pca$map, 1, 2, 3, stretch="lin")
|
||||
plotRGB (pca$map, 3, 4, 5, stretch="lin")
|
||||
|
||||
x11()
|
||||
for (i in 1: 10) {
|
||||
plot(pca$map[[i]],
|
||||
col=gray.colors (255, 0, 1, 1) ,
|
||||
main=paste("PC", i))
|
||||
Sys.sleep (1)
|
||||
}
|
||||
|
||||
#### 4. Minimum Noise Fractioning ####
|
||||
##### 4.1 Backward rotation #####
|
||||
##### 4.2 Implementation #####
|
||||
backrot <- function (sc, i) {
|
||||
floor(apply(t(pca$model$loadings[,1:i]) * sc, 2, sum) * pca$model$scale + pca$model$center)
|
||||
}
|
||||
|
||||
pca_val <- getValues(pca$map)
|
||||
|
||||
mnfval <- apply(pca_val[,1:4], 1, backrot, i=4)
|
||||
|
||||
mnfhyp <- setValues(hyp,t(mnfval))
|
||||
|
||||
par(mfrow=c(1,2))
|
||||
plotRGB(hyp, 40,20,10, stretch="lin")
|
||||
plotRGB(mnfhyp, 40,20,10, stretch="lin")
|
||||
|
||||
#### 5. Evalutation of the MNF-result ####
|
||||
##### 5.1 Calculating the pseudo-reflectance #####
|
||||
|
||||
hyp_scaled <- (hyp - minValue(hyp))/maxValue(hyp)
|
||||
|
||||
mnfhyp_scaled <- (mnfhyp-minValue(mnfhyp))/maxValue(mnfhyp)
|
||||
|
||||
##### 5.2 Comparison #####
|
||||
|
||||
par(mfrow=c(1,2))
|
||||
plot(hyp_scaled[[10]], zlim=c(0,1))
|
||||
plot(mnfhyp_scaled[[10]], zlim=c(0,1))
|
||||
|
||||
## before=original image, after=mnf,
|
||||
## wl=band wavelengths
|
||||
testspec <- function(before, after, wl){
|
||||
x1 <- click (before, n=1, type="p", xy=T, show=F) ## extract original spectrum
|
||||
## and pixel coordinates
|
||||
x2 <- extract(after, x1[1:2]) ## extract MNF-transformed spectrum
|
||||
x1 <- x1[-c(1:2)] ## remove coordinates
|
||||
x11() ## open new graphic window, comment if you do not want to do so
|
||||
plot (wl, x1*100, type="l", ylim=c(0, 100) , ylab="pseudo-reflectance/%",
|
||||
xlab="wavelength/nm") ## plot original spectrum
|
||||
lines (wl, x2*100, col=2) ## add MNF-spectrum
|
||||
legend ("topright", c("before", "after"), lwd=1, col=c(1,2)) ## add legend
|
||||
}
|
||||
|
||||
x11()
|
||||
plotRGB (mnfhyp_scaled, 35, 20, 1, stretch="lin")
|
||||
|
||||
testspec(hyp_scaled, mnfhyp_scaled, wl)
|
||||
|
||||
#### 6. Detecting water stress ####
|
||||
|
||||
nm819 <- (mnfhyp_scaled[[39]] + mnfhyp_scaled[[40]])/2
|
||||
nm1599 <- mnfhyp_scaled[[110]]
|
||||
|
||||
msi <- nm1599 / nm819
|
||||
|
||||
msi <- reclassify (msi, matrix (c(-Inf, 0, 0, 2, Inf, 2),2,3, byrow=T))
|
||||
|
||||
plot (msi, col=bpy.colors (100))
|
||||
@@ -0,0 +1,191 @@
|
||||
library(raster)
|
||||
library(rgdal)
|
||||
setwd("~/OneDrive/Dokumente/Fernerkundung/Regio/11_Landwirtschaft")
|
||||
|
||||
#### Build NDVI stack ####
|
||||
|
||||
# read all files from the directory starting with "CU_LC08.001_SRB4" (OLI - red band)
|
||||
landsatred <- list.files(pattern="CU_LC08.001_SRB4", path="/Users/huaqo/OneDrive/Dokumente/Fernerkundung/Regio/11_Landwirtschaft/data", full.names=TRUE)
|
||||
|
||||
# read all files from the directory starting with "CU_LC08.001_SRB5" (OLI - NIR band)
|
||||
landsatNIR <- list.files(pattern="CU_LC08.001_SRB5", path="/Users/huaqo/OneDrive/Dokumente/Fernerkundung/Regio/11_Landwirtschaft/data", full.names=TRUE)
|
||||
|
||||
# Build stacks for red and NIR bands
|
||||
landsatred_stack <- stack(landsatred)
|
||||
landsatNIR_stack <- stack(landsatNIR)
|
||||
|
||||
# calculate the NDVI
|
||||
NDVI_stack <- (landsatNIR_stack-landsatred_stack)/(landsatNIR_stack+landsatred_stack)
|
||||
|
||||
#### Crop the dataset to the study area
|
||||
|
||||
# read the shapefle
|
||||
myshp <- readOGR("study_area_sem10.shp")
|
||||
|
||||
# Check crs of datasets
|
||||
crs(NDVI_stack)
|
||||
crs(myshp)
|
||||
|
||||
# Reporject the shapefile
|
||||
myshp_proj <- spTransform(myshp, crs(NDVI_stack))
|
||||
|
||||
# Subset the image data and save it
|
||||
NDVI_stack_subset <- crop(NDVI_stack, extent(myshp_proj), snap="out", filename="NDVI_timeseries_2019.tif", overwrite=TRUE)
|
||||
|
||||
# split the file name with the delimiter "_", read the date and format the dates
|
||||
name_split <- sapply(landsatred, function(i) unlist(strsplit(i,"_")))
|
||||
|
||||
# identify number of substring containing the date (in my case 6)
|
||||
View(name_split)
|
||||
dates <- name_split [6,]
|
||||
dates <-substring(dates,4,10)
|
||||
dates <- as.Date(dates, "%Y%j")
|
||||
|
||||
# rename the bands according to their date
|
||||
names(NDVI_stack_subset) <- dates
|
||||
|
||||
ndvistack <- stack ("NDVI_timeseries_2019.tif")
|
||||
#or
|
||||
#ndvistack <- NDVI_stack_subset
|
||||
|
||||
#### Create date vector (needed if NDVI time series is not created above) ####
|
||||
|
||||
# read all files from the directory starting with "CU_LC08.001_SRB4" (OLI - red band)
|
||||
landsatred <- list.files(pattern="CU_LC08.001_SRB4", path="C:\\Users\\marion\\Documents\\2020_maerz\\RegionaleThemen_CA\\seminar10\\data", full.names=TRUE)
|
||||
|
||||
# split the file name with the delimiter "_", read the date and format the dates
|
||||
name_split <- sapply(landsatred, function(i) unlist(strsplit(i,"_")))
|
||||
|
||||
# identify number of substring containing the date (in my case 6)
|
||||
View(name_split)
|
||||
dates <- name_split [6,]
|
||||
dates <-substring(dates,4,10)
|
||||
dates <- as.Date(dates, "%Y%j")
|
||||
|
||||
# rename the bands according to their date
|
||||
names(ndvistack) <- dates
|
||||
|
||||
plotRGB(ndvistack, 1,4,7, stretch="lin")
|
||||
|
||||
|
||||
cal_proj <- shapefile("training_pol_col.shp")
|
||||
|
||||
View(cal_proj@data) ## attribute table
|
||||
|
||||
crs(cal_proj)
|
||||
crs(ndvistack)
|
||||
|
||||
|
||||
cal <- spTransform(cal_proj, crs(ndvistack))
|
||||
|
||||
|
||||
cropcol <- rgb(cal$FIRST_RED, cal$FIRST_GREE, cal$FIRST_BLUE)
|
||||
|
||||
plotRGB (ndvistack, 1, 3, 5, stretch="lin")
|
||||
plot (cal, add=T, col=cropcol, border ="black", lwd=3)
|
||||
|
||||
calpix <- extract (ndvistack, cal, df=FALSE)
|
||||
|
||||
names (calpix) <- cal@data[,1]
|
||||
|
||||
calpix2 <- extract (ndvistack, cal, df=TRUE)
|
||||
|
||||
View(calpix)
|
||||
View(calpix2)
|
||||
|
||||
cl <- rep(cropcol, sapply(calpix, nrow))
|
||||
|
||||
classcentroids <- t(sapply (calpix, colMeans))
|
||||
|
||||
# plot empty plot of a defined size
|
||||
plot(0,
|
||||
ylim = c(min(classcentroids), max(classcentroids)),
|
||||
xlim = c(min(dates), max(dates)),
|
||||
type = 'n',
|
||||
xlab = "time",
|
||||
ylab = "NDVI",
|
||||
xaxt='n'
|
||||
)
|
||||
|
||||
# label the x axis
|
||||
axis(1, dates, format(dates, "%b %d"), cex.axis = .7)
|
||||
|
||||
|
||||
# draw one line for each class
|
||||
for (i in 1:nrow(classcentroids)){
|
||||
lines(dates, as.numeric(classcentroids[i,]),
|
||||
lwd = 4,
|
||||
col = cropcol[i]
|
||||
)
|
||||
}
|
||||
|
||||
# add a grid
|
||||
grid()
|
||||
|
||||
# add a legend
|
||||
legend(as.character(cal@data[,1]),
|
||||
x = "topleft",
|
||||
col = cropcol,
|
||||
lwd = 5,
|
||||
bty = "n"
|
||||
)
|
||||
|
||||
d <- c(1,3,5,7)
|
||||
dates4 <- dates[d]
|
||||
|
||||
classcentroids_4bands <- aggregate(calpix2[, c(2,4,6,8)], list(calpix2$ID), mean)
|
||||
|
||||
for (i in 1:4){
|
||||
for (j in 1:4){
|
||||
plot (calpix2[,i+1], calpix2[,j+1], col=cl, pch=19, cex=0.1,
|
||||
xlab=paste ("NDVI ",dates4[i]), ylab=paste ("NDVI ",dates4[j]), xlim= c(-0.3,1),
|
||||
ylim= c(-0.3,1)) ## the '+1' is necessary to
|
||||
## skip the first column with the class codes
|
||||
points (classcentroids[,i], classcentroids[,j], bg=cropcol, pch=21)
|
||||
|
||||
legend("topleft",
|
||||
legend = cal@data[,1],
|
||||
fill = cropcol,
|
||||
border = FALSE,
|
||||
box.col="grey",
|
||||
cex = 0.7) # t
|
||||
readline ("Press ENTER for next plot")
|
||||
}}
|
||||
|
||||
source ("mindistclassifier.r")
|
||||
|
||||
map <- mindistclassifier(class.codes=1:10, cal.ref=classcentroids,
|
||||
image.stack=ndvistack)
|
||||
|
||||
plot(map)
|
||||
|
||||
plot(map, col = cropcol, legend =FALSE
|
||||
)
|
||||
|
||||
legend("topright",
|
||||
legend = cal@data[,1],
|
||||
fill = cropcol,
|
||||
border = FALSE,
|
||||
box.col="grey") # turn off legend border)
|
||||
|
||||
map@legend@colortable <- c ("#000000", cropcol, rep ("#000000", 254))
|
||||
writeRaster (map, "mindist_map.tif", format="GTiff", overwrite=TRUE)
|
||||
|
||||
val <- shapefile ("validation_points_v2.shp")
|
||||
val_proj <- spTransform(val, crs(map))
|
||||
|
||||
head(val_proj)
|
||||
|
||||
croptypes <- cal@data[,1]
|
||||
|
||||
prediction <- extract (map, val_proj)
|
||||
prediction <- croptypes[prediction]
|
||||
|
||||
cfm <- table (prediction, val@data[,2])
|
||||
cfm
|
||||
oac <- sum (diag (cfm)) / sum (cfm)
|
||||
print(paste("OAC: ", oac))
|
||||
users <- diag (cfm) / apply (cfm, 1, sum)
|
||||
users
|
||||
producers <- diag (cfm) / apply (cfm, 2, sum)
|
||||
producers
|
||||
Reference in New Issue
Block a user