eRko použité jako GIS

2 Načtení dat, práce s projekcí

Kódy ESPG potřebné pro nastavení projekcí jsou dostupné zde.

Použité projekce:

  • S-JTSK / Krovak = epsg:5513
  • WGS 84 = epsg:4326
  • ETRS89 / ETRS-LAEA = epsg:3035
# install.packages(c('data.table','raster','rgeos','rgdal','maptools','ggplot2','gtools','gridExtra'))

setwd('~/ownCloud/Active Docs/vyuka/gis_r')

library(data.table) # jednodussi operace s daty 
library(raster) # prace s rastry
library(rgdal) # prace s prostorovymi daty
library(rgeos) # prace s projekcemi
library(ggplot2)  # efektivni nastroj pro tvorbu grafu
library(RColorBrewer) # barvicky... :)
library(gtools) # uzitecne predprogramovane fce
library(gridExtra) # moznost layoutu pro ggplot

krovak <- '+init=epsg:5513'
wgs84 <- '+init=epsg:4326'
etrs <- '+init=epsg:3035'

povodi <- readOGR('dib_A11_Povodi_vodomer_stanic/A11_Povodi_vodomer_stanic.shp', 'A11_Povodi_vodomer_stanic', verbose = F) # načtení prostorovych dat
povodi@proj4string # zobrazení projekce SHPfilu - pripadne NA je nutno nastavit na správnou projekci
CRS arguments:
 +proj=krovak +lat_0=49.5 +lon_0=24.83333333333333 +k=0.9999 +x_0=0
+y_0=0 +ellps=bessel +units=m +no_defs 
# povodi@proj4string <- CRS(krovak) # nastavení projekce SHPfilu

toky  <- readOGR('dib_A03_Vodni_tok_HU/A03_Vodni_tok_HU.shp', 'A03_Vodni_tok_HU', verbose = F)

stanice <- readOGR('dib_E04_Vodomerne_stanice/E04_Vodomerne_stanice.shp', 'E04_Vodomerne_stanice', verbose = F)

pe_etrs <- spTransform(povodi, CRS(etrs)) # příprava polygonů pro tvorbu processing extent - změna projekce SHPfilu
pe_etrs <- extent(pe_etrs) # processing extent - min, max souradnice
pe_etrs <- 1.15*pe_etrs # zvětšení processing extentu

corine <- raster('g250_06/g250_06.tif') # načtení rastru
projection(corine) # zobrazení projekce rastru, rastry se většinou načitají s projekcí pokud ne ->
[1] "+proj=laea +lat_0=52 +lon_0=10 +x_0=4321000 +y_0=3210000 +ellps=GRS80 +towgs84=0,0,0,0,0,0,0 +units=m +no_defs"
# crs(corine) <- etrs # nastavení projekce rastru
corine_s <- crop(corine,pe_etrs) # oriznuti rastru na velikost 'okna'
system.time({ # čas výpočtu
  corine_k <- projectRaster(corine_s, crs = krovak, method = 'ngb') # změna projekce rastru - venujte pozornost pouzite metode
})
   user  system elapsed 
 30.216   0.336  30.554 
pe_wgs <- spTransform(povodi, CRS(wgs84))
pe_wgs <- extent(pe_wgs)
pe_wgs <- 1.15*pe_wgs

dem <- raster(paste(getwd(), '/DMR3_wgs84_cr/DMR3_wgs84_cr.tif', sep = '')) 
projection(dem) 
[1] "+proj=longlat +datum=WGS84 +no_defs +ellps=WGS84 +towgs84=0,0,0"
dem_s <- crop(dem,pe_wgs)
system.time({
  dem_k <- projectRaster(dem_s, crs = krovak)
})
   user  system elapsed 
126.004   0.828 126.900 
prec <- mixedsort(list.files(paste(getwd(), '/prec_16_tif/', sep = ''), full.names = T, pattern = '.tif')) # načtení a seřazení všech souborů z adresáře s koncovkou *.tif
prec <- stack(prec) # uloženi načtených souborů do proměnné 'tprec'
srazky <- sum(prec) # výpočet ročního úhrnu
projection(srazky)
[1] "+proj=longlat +datum=WGS84 +no_defs +ellps=WGS84 +towgs84=0,0,0"
srazky_s <- crop(srazky,pe_wgs)
system.time({
  srazky_k <- projectRaster(srazky_s, crs = krovak)
})
   user  system elapsed 
  1.804   0.000   1.807 

3 Rastry, SHPfily, a obrázky

att <- stanice@data # načtení atributové tabulky do proměnné 'att'
head(att)
  OBJECTID  DBC HYDROID JUNCTIONID   DBCN X_COORD Y_COORD
1       95 0920 7000095    1110720 092000 3512207 5604547
2       96 0929 7000096    1110721 092900 3503128 5602052
3       97 0931 7000097    1110722 093100 3499270 5603580
4       98 0940 7000098    1110723 094000 3497530 5604951
5       99 0950 7000099    1110724 095000 3497275 5604647
6      100 0960 7000100    1110725 096000 3495745 5600566
vyber <- c('016000') # výběr uzávěrového profilu

stanice_s <- stanice[stanice$DBCN %in% vyber,] # select uzávěrového profilu
stanice_b <- gBuffer(stanice_s, width = 10000, quadsegs = 20) # příklad tvorby bufferu 10km

povodi_s <- gIntersects(povodi, stanice_b, byid=TRUE)[1,] # oříznutí toků podle polygonu selektovaného povod - výsledek jsou hodnoty TRUE/FALSE
povodi_s <- povodi[povodi_s,] # 'export' hodnot TRUE/FALSE do polygonů

toky_s <- toky[povodi_s, ] # elegantnejsi verze intersectu (pouhy subset matice dat)

ggplot() +
  geom_polygon(data = povodi_s, aes(x = long , y = lat, group = id), fill = NA, color = 'black', alpha = .75) +
  geom_path(data = toky_s, aes(x = long, y = lat, group = id), color = 'steelblue4') +
  geom_polygon(data = stanice_b, aes(x = long, y = lat, group = id), color = 'red4', alpha = .25) +
  geom_point(aes(x = coordinates(stanice_s)[1] ,y = coordinates(stanice_s)[2]), color = 'red4') +
  coord_fixed() +
  theme_classic()

centroid <- as.data.frame(coordinates(povodi_s)) # těžiště jednotlivych polygonů
names(centroid) <- c('long','lat')

centroid <- as.data.frame(gCentroid(povodi_s)@coords) # celkove těžiště polygonu
names(centroid) <- c('long','lat')

pe_pov <- extent(povodi_s)
pe_pov <- 1.15*pe_pov

dem_s <- crop(dem_k,pe_pov)
dem_s <- mask(dem_s,povodi_s) # oriznuti rastru podle polygonu

dem_s_p <- data.frame(rasterToPoints(dem_s)) # potřeba převést raster na body pro plot v gg
colnames(dem_s_p) <- c('X','Y','Z')

cols <- terrain.colors(100, alpha=0.1)

ggplot(dem_s_p) + 
  geom_raster(aes(x = X, y = Y, fill = Z)) +
  scale_fill_gradientn(name = 'dem', colours = cols) +
  geom_contour(aes(x = X, y = Y, z = Z), color = 'grey13', lwd = .1) +
  geom_polygon(data = povodi_s, aes(x = long , y = lat, group = id), fill = NA, color = 'black', alpha = .75) +
  geom_path(data = toky_s, aes(x = long, y = lat, group = id), color = 'darkblue') +
  coord_fixed() +
  theme_classic() +
  ylab(NULL) +
  xlab(NULL)  +
  ggtitle('')

teren_sl <- terrain(dem_s, opt = 'slope', unit = 'degrees') # sklonitost, osvit atd. terénu - ??terrain   
# teren_as <- terrain(dem_s, opt = 'aspect', unit = 'degrees') 

teren_sl_p <- data.frame(rasterToPoints(teren_sl))
colnames(teren_sl_p) <- c('X','Y','Z')

brk_sl <- seq(min(teren_sl_p$Z), max(teren_sl_p$Z), .5) 

ggplot(teren_sl_p) + 
  geom_raster(aes(x = X, y = Y, fill = Z)) +
  scale_fill_gradientn(name = 'Slope [°]',
                       colours = cols,
                       breaks = brk_sl,
                       guide = guide_legend(title.position = 'top',
                                            label.position = 'bottom',
                                            label.hjust = .5,
                                            label.vjust = .5,
                                            label.theme = element_text(angle = 45, size = 7.5),
                                            nrow = 1,
                                            keywidth = .75,
                                            keyheight = .5,
                                            byrow = TRUE)) +
  geom_polygon(data = povodi_s, aes(x = long , y = lat, group = id), fill = NA, color = 'black', alpha = .75) +
  geom_path(data = toky_s, aes(x = long, y = lat, group = id), color = 'darkblue') +
  coord_fixed() +
  theme_classic() +
  ylab(NULL) +
  xlab(NULL) +
  ylim(extent(teren_sl)@ymin*1.0025, extent(teren_sl)@ymax) +
  theme(legend.direction = 'horizontal',
        legend.box = 'horizontal',
        legend.position = c(0, 0),
        legend.justification = c(0, 0),
        legend.background = element_rect(fill = 'transparent'),
        plot.title = element_text(hjust = 0.5)) +
  ggtitle('Slope')

srazky_s <- crop(srazky_k,pe_pov)
srazky_s <- mask(srazky_s,povodi_s)

srazky_s_p <- data.frame(rasterToPoints(srazky_s))
colnames(srazky_s_p) <- c('X','Y','Z')

cols <-  colorRampPalette(brewer.pal(9, 'Blues'))(round(max(srazky_s_p$Z) - min(srazky_s_p$Z)))

ggplot(srazky_s_p) + 
  geom_raster(aes(x = X, y = Y, fill = Z)) +
  scale_fill_gradientn(name = '[mm]', colours = cols) +
  geom_contour(aes(x = X, y = Y, z = Z), color = 'grey13', lwd = .1) +
  geom_polygon(data = povodi_s, aes(x = long , y = lat, group = id), fill = NA, color = 'black', alpha = .75) +
  coord_fixed() +
  theme_classic() +
  ylab(NULL) +
  xlab(NULL)  +
  ggtitle('Precipitation')

denst <- data.frame(values(srazky_s)[!is.na(values(srazky_s))])
names(denst) <- 'value'

ggplot() +
  geom_density(data = denst, aes(x = value), fill = cols[median(seq_along(cols))]) +
  theme_classic()

4 Corine land cover

legenda_corine <- fread('g250_06/clc_legend.csv')

corine_s <- crop(corine_k,povodi_s)
corine_s <- mask(corine_s,povodi_s)

clc <- unlist(extract(corine_s, povodi_s))
clc <- table(clc)
clc <- data.frame(clc/sum(clc)*100)
names(clc) = c('GRID_CODE','%')
clc <- merge(clc, legenda_corine[,c(1,5)], by = 'GRID_CODE')

head(clc)
  GRID_CODE           %                            LABEL3
1        10  0.09790371                 Green urban areas
2        11  0.27067496      Sport and leisure facilities
3        12 56.65169316         Non-irrigated arable land
4        16  0.62773554 Fruit trees and berry plantations
5        18  5.21769178                          Pastures
6         2  6.88205483        Discontinuous urban fabric
barvicka <- strsplit(as.character(legenda_corine$RGB),'-') # určení barev pro corine podle RGB v legendě
barva_clc <- c()
for (i in 1:length(barvicka)) {
  if(is.finite(as.numeric(barvicka[[i]][1]))) {
    barva_clc[[i]] = rgb(as.numeric(barvicka[[i]][1])/255,as.numeric(barvicka[[i]][2])/255,as.numeric(barvicka[[i]][3])/255)
  }
  else {
    barva_clc[[i]] = rgb(1,1,1)
  }
}

corine_p <- data.frame(rasterToPoints(corine_s))
colnames(corine_p) = c('x','y','value')

legenda_corine$LABEL3 <- sub(', ', '\n', legenda_corine$LABEL3)  

cor_hist <- ggplot(clc) + 
  geom_bar(aes(x = GRID_CODE, y = `%`, fill = GRID_CODE), stat = 'identity') +
  geom_bar(aes(x = GRID_CODE, y = `%`, fill = GRID_CODE), stat = 'identity', colour = 'black', show.legend = FALSE, lwd = .25) +
  scale_fill_manual(name = '',
                    values = barva_clc[as.numeric(legenda_corine$GRID_CODE) %in% clc$GRID_CODE],
                    labels = legenda_corine[as.numeric(legenda_corine$GRID_CODE) %in% clc$GRID_CODE, LABEL3]) +
  coord_fixed(4/length(clc$GRID_CODE)) +
  theme_classic() +
  ylab('%') +
  xlab('Clc code') +
  ggtitle('Corine bar plot')

cor_map <- ggplot() +
  geom_raster(data = corine_p, aes(x, y, fill = factor(value))) +
  geom_polygon(data = povodi_s, aes(x = long , y = lat, group = id), fill = NA, color = 'black', alpha = .75) +
  scale_fill_manual(name = 'Land Cover',
                    values = barva_clc[as.numeric(legenda_corine$GRID_CODE) %in% unique(corine_p$value)],
                    labels = paste0(legenda_corine[as.numeric(legenda_corine$GRID_CODE) %in% unique(corine_p$value), LABEL3],
                                    ' (', legenda_corine[as.numeric(legenda_corine$GRID_CODE) %in% unique(corine_p$value), GRID_CODE], ')')) +
  coord_fixed() +
  theme_classic() +
  ylab(NULL) +
  xlab(NULL) +
  ggtitle('Corine map')

get_legend <- function(myggplot) {
  
  tmp <- ggplot_gtable(ggplot_build(myggplot))
  leg <- which(sapply(tmp$grobs, function(x) x$name) == 'guide-box')
  legend <- tmp$grobs[[leg]]
  
  return(legend)
}

cor_leg <- get_legend(cor_map)

grid.arrange(cor_map + theme(legend.position = 'none'), 
             cor_leg,
             cor_hist + theme(legend.position = 'none'), 
             layout_matrix = matrix(c(1,2,3,2), nrow = 2, byrow = T))