BAK-Kulturgueter/Heatmaps.R

#rm(list=ls())
#######get required libraries#######
library(ggplot2)
library(dplyr)
library(tidyverse)
library(RSwissMaps)
library(viridis)

#######set working direction and get the data
setwd("~/BAK_Projekt")

#get datasets
df_bak <- read.csv("~/BAK_Projekt/Liste_BAK4.csv", sep = ";")
df_bin <- read.csv("~/BAK_Projekt/df_Akteure_binwide.csv", sep = ";") 

#base map
mapCH <- RSwissMaps::mapCH2016 %>% dplyr::rename("bfs_nr"="can")

#create dataset on canton level
df_bak_red <- df_bak %>% 
  dplyr::group_by(Kanton) %>% 
  dplyr::summarise(count=n())
df_bak_red <- df_bak_red[!(df_bak_red$Kanton ==""),]
df_bak_red$Kt <- c("AG", "AI", "AR", "BL", "BS", "BE", "FR", "GE", "GL", "GR", "JU", "LU", "NE", 
                     "NW", "OW", "SH", "SZ", "SO", "SG", "TI", "TG", "UR", "VD", "VS", "ZG", "ZH")
df_bak_red$bfs_nr <- as.integer(c("19", "16", "15", "13", "12", "2", "10", "25", "8", "18", "26", "3", "24", 
                                 "7", "6", "14", "5", "11", "17", "21", "20", "4", "22", "23", "9", "1"))
df_binKanton <- full_join(df_bak_red, df_bin, by="Kanton")

#get coordinates (required reference system CH1903/LV03)
mapCH.short <- mapCH[!duplicated(mapCH$bfs_nr),]
df.map <- full_join(df_bak_red, mapCH.short, by="bfs_nr") %>% 
  select("bfs_nr", "Kt", "name", "count", "bfs_nr", "long", "lat")



# Plotting sample data
RSwissMaps::can.plot(df.map$bfs_nr, df.map$count, 2016, 
         boundaries = "c", boundaries_size = 0.2, boundaries_color = "white",
         title = "Verteilung der Institutionen auf Kantonsebene")
  #geom_text(aes(x=df.map$long, y=df.map$lat ,label = df.map$Kt))



##Figure 1
df_mm1 <- dplyr::filter(df_binKanton, !(materielles...mobiles.Kulturerbe %in% "")) %>% 
  group_by(Handlungsfelder, rechtliche.Institutionalisierung.des.Auftrags, bfs_nr, Kanton) %>% dplyr::summarise(materielles_mobiles_Kulturerbe=n()) %>% 
  filter(Handlungsfelder == "Zug<EFBFBD>nglichmachen") %>% group_by(bfs_nr) %>% mutate(percent = prop.table(materielles_mobiles_Kulturerbe)) %>% 
  filter(rechtliche.Institutionalisierung.des.Auftrags != "mit eigenem (privatem) Auftrag")
f1_mm <- RSwissMaps::can.plot(df_mm1$bfs_nr, df_mm1$percent, 2016, 
                     boundaries = "c", boundaries_size = 0.2, boundaries_color = "white",
                     title = "Anzahl Akteure (nach Institutionalisierung Auftrag) im Handlungsfeld \n'Zug<75>nglichmachen' bez<65>glich materiellem und mobilen Kulturerbe")

df_mi1 <- dplyr::filter(df_binKanton, !(materielles...immobiles.Kulturerbe %in% "")) %>% 
  group_by(Handlungsfelder, rechtliche.Institutionalisierung.des.Auftrags, bfs_nr, Kanton) %>% dplyr::summarise(materielles_immobiles_Kulturerbe=n()) %>% 
  filter(Handlungsfelder == "Zug<EFBFBD>nglichmachen") %>% group_by(bfs_nr) %>% mutate(percent = prop.table(materielles_immobiles_Kulturerbe)) %>% 
  filter(rechtliche.Institutionalisierung.des.Auftrags != "mit eigenem (privatem) Auftrag")
f1_mi <- RSwissMaps::can.plot(df_mi1$bfs_nr, df_mi1$percent, 2016, 
                              boundaries = "c", boundaries_size = 0.2, boundaries_color = "white",
                              title = "Anzahl Akteure (nach Institutionalisierung Auftrag) im Handlungsfeld \n'Zug<75>nglichmachen' bez<65>glich materiellem und immobilen Kulturerbe")

df_i1 <- dplyr::filter(df_binKanton, !(immaterielles.Kulturerbe %in% "")) %>% 
  group_by(Handlungsfelder, rechtliche.Institutionalisierung.des.Auftrags, bfs_nr, Kanton) %>% dplyr::summarise(immaterielles.Kulturerbe=n()) %>% 
  filter(Handlungsfelder == "Zug<EFBFBD>nglichmachen") %>% group_by(bfs_nr) %>% mutate(percent = prop.table(immaterielles.Kulturerbe)) %>% 
  filter(rechtliche.Institutionalisierung.des.Auftrags != "mit eigenem (privatem) Auftrag")
f1_i <- RSwissMaps::can.plot(df_i1$bfs_nr, df_i1$percent, 2016, 
                              boundaries = "c", boundaries_size = 0.2, boundaries_color = "white",
                              title = "Anzahl Akteure (nach Institutionalisierung Auftrag) im Handlungsfeld \n'Zug<75>nglichmachen' bez<65>glich immateriellem Kulturerbe")



ggsave(plot=f1_mm, filename = "Figure1_mm.jpg", device="jpg", width = 15, height = 10,
       path = "~/BAK_Projekt/Figures")
ggsave(plot=f1_mi, filename = "Figure1_im.jpg", device="jpg", width = 15, height = 10,
       path = "~/BAK_Projekt/Figures")
ggsave(plot=f1_i, filename = "Figure1_i.jpg", device="jpg", width = 15, height = 10,
       path = "~/BAK_Projekt/Figures")



##FIGURE 2
##Materielles mobiles Kulturerbe
df_mm2 <- dplyr::filter(df_binKanton, !(materielles...mobiles.Kulturerbe %in% "")) %>% 
  group_by(Handlungsfelder, Hauptfinanzierungstr<EFBFBD>ger, bfs_nr, Kanton) %>% dplyr::summarise(materielles_mobiles_Kulturerbe=n()) %>% 
  filter(Handlungsfelder == "Reaktualisieren") %>% group_by(bfs_nr) %>% mutate(percent = prop.table(materielles_mobiles_Kulturerbe)) %>% 
  filter(Hauptfinanzierungstr<EFBFBD>ger != "privat")
    #add additional row as Uri appears to have no data instead of 0 percentage
      new.r_mm <- data.frame("Reaktualisieren", "staatlich/<2F>ffentlich", 4, "Uri", 0, 0)
      names(new.r_mm)<- colnames(df_mm2)
      df_mm2.1 <- rbind(df_mm2, new.r_mm)

f2_mm <- RSwissMaps::can.plot(df_mm2.1$bfs_nr, df_mm2.1$percent, 2016, 
                              boundaries = "c", boundaries_size = 0.2, boundaries_color = "white",
                              title = "Anzahl Akteure (nach Hauptfinanzierungstr<74>ger) im Handlungsfeld\n'Reaktualisieren/Valorisieren' bez<65>glich materiellem und mobilem Kulturerbe")+
  scale_fill_continuous(low = "#FEE5D9", high = "#A50F15",space = "Lab", na.value = "grey90", guide = "colourbar",
                        breaks = c(1, 0.8, 0.6, 0.4, 0.2, 0), 
                        labels = c("100 %","80 %", "60 %", "40 %", "20 %", "0 %"))+
  theme(legend.position = "right",
        legend.key.size = unit(0.8, "cm")) +
  guides(fill=guide_colourbar(title = "Prozentualer Anteil von\nAkteuren mit einem\nstaatlichen / <20>ffentlichen\nHauptfinanzierungstr<74>ger"))

##Materielles immobiles Kutlurerbe
df_mi2 <- dplyr::filter(df_binKanton, !(materielles...immobiles.Kulturerbe %in% "")) %>% 
  group_by(Handlungsfelder, Hauptfinanzierungstr<EFBFBD>ger, bfs_nr, Kanton) %>% dplyr::summarise(materielles_immobiles_Kulturerbe=n()) %>% 
  filter(Handlungsfelder == "Reaktualisieren") %>% group_by(bfs_nr) %>% mutate(percent = prop.table(materielles_immobiles_Kulturerbe)) %>% 
  filter(Hauptfinanzierungstr<EFBFBD>ger != "privat")

    #add additional row as AG, GL, GR and ZH appears to have no data instead of 0 percentage
   new.r_mi <- data.frame(Handlungsfelder = c("Reaktualisieren"),
                     Hauptfinanzierungstr<EFBFBD>ger = "staatlich/<2F>ffentlich",
                     bfs_nr = c(19, 8, 18, 1),
                     Kanton = c("Aargau", "Glarus", "Graub<EFBFBD>nden", "Z<EFBFBD>rich"),
                     materielles_immobiles_Kulturerbe = 0,
                     percent = 0)
    df_mi2.1 <- rbind(df_mi2, new.r_mi)

f2_mi <- RSwissMaps::can.plot(df_mi2.1$bfs_nr, df_mi2.1$percent, 2016, 
                              boundaries = "c", boundaries_size = 0.2, boundaries_color = "white",
                              title = "Anzahl Akteure (nach Hauptfinanzierungstr<74>ger) im Handlungsfeld\n'Reaktualisieren/Valorisieren' bez<65>glich materiellem und immobilem Kulturerbe")+
  scale_fill_continuous(low = "#FEE5D9", high = "#A50F15",space = "Lab", na.value = "grey90", guide = "colourbar",
                        breaks = c(1, 0.8, 0.6, 0.4, 0.2, 0), 
                        labels = c("100 %", "80 %", "60 %", "40 %", "20 %", "0 %"))+
  theme(legend.position = "right",
        legend.key.size = unit(0.8, "cm")) +
  guides(fill=guide_colourbar(title = "Prozentualer Anteil von\nAkteuren mit einem\nstaatlichen / <20>ffentlichen\nHauptfinanzierungstr<74>ger"))

##Immaterielles Kulturerbe
df_i2 <- dplyr::filter(df_binKanton, !(immaterielles.Kulturerbe %in% "")) %>% 
  group_by(Handlungsfelder, Hauptfinanzierungstr<EFBFBD>ger, bfs_nr, Kanton) %>% dplyr::summarise(immaterielles.Kulturerbe=n()) %>% 
  filter(Handlungsfelder == "Reaktualisieren") %>% group_by(bfs_nr) %>% mutate(percent = prop.table(immaterielles.Kulturerbe)) %>% 
  filter(Hauptfinanzierungstr<EFBFBD>ger != "privat")
   
   #add additional row as AI, BE, SG and VS appears to have no data instead of 0 percentage
    new.r_i <- data.frame(Handlungsfelder = c("Reaktualisieren"),
                           Hauptfinanzierungstr<EFBFBD>ger = "staatlich/<2F>ffentlich",
                           bfs_nr = c(16, 2, 17, 23),
                           Kanton = c("Appenzell Ausserrhoden", "Bern", "St. Gallen", "Wallis"),
                           materielles_immobiles_Kulturerbe = 0,
                           percent = 0)
    df_i2.1 <- rbind(df_i2, new.r_i)

f2_i <- RSwissMaps::can.plot(df_i2.1$bfs_nr, df_i2.1$percent, 2016, 
                         boundaries = "c", boundaries_size = 0.5, boundaries_color = "white",
                         title = "Anzahl Akteure (nach Hauptfinanzierungstr<74>ger) im Handlungsfeld 'Reaktualisieren/Valorisieren'\nbez<65>glich immateriellem Kulturerbe") +
      scale_fill_continuous(low = "#FEE5D9", high = "#A50F15",space = "Lab", na.value = "grey90", guide = "colourbar",
                            breaks = c(1, 0.8, 0.6, 0.4, 0.2, 0), 
                            labels = c("100 %","80 %", "60 %", "40 %", "20 %", "0 %"),
                            limits = c(0,1))+
      theme(legend.position = "right",
            legend.key.size = unit(0.8, "cm")) +
      guides(fill=guide_colourbar(title = "Prozentualer Anteil von\nAkteuren mit einem\nstaatlichen / <20>ffentlichen\nHauptfinanzierungstr<74>ger"))
    
    
  



ggsave(plot=f2_mm, filename = "Figure2_mm.jpg", device="jpg", width = 8, height = 5,
       path = "~/BAK_Projekt/Figures")
ggsave(plot=f2_mi, filename = "Figure2_mi.jpg", device="jpg", width = 8, height = 5,
       path = "~/BAK_Projekt/Figures")
ggsave(plot=f2_i, filename = "Figure2_i.jpg", device="jpg", width = 8, height = 5,
       path = "~/BAK_Projekt/Figures")


write.table(df_mm2, sep= ";", row.names = F, 
            file = "~/BAK_Projekt/Tabellen/df_mm.csv")
write.table(df_mi2, sep= ";", row.names = F, 
            file = "~/BAK_Projekt/Tabellen/df_mi.csv")
write.table(df_i2, sep= ";", row.names = F, 
            file = "~/BAK_Projekt/Tabellen/df_i.csv")



####Example for district map####
# Generating sample data:
#dt.dis <- dis.template(2016)
#for(i in 1:nrow(dt.dis)){dt.dis$values[i] <- sample(c(300:700), 1)/1000}
## Plotting sample data:
#dis.plot(dt.dis$bfs_nr, dt.dis$values, 2016,
#         boundaries = "c",
#         title = "Beispiel auf Bezirksebene (random data)")
# Plotting sample data for the canton of Aargau:
#dis.plot(dt.dis$bfs_nr, dt.dis$values, 2016, cantons = c("GR"),
#         lakes = c("none"),
#         title = "Beispiel Kanton Graub<75>nden (Bezirksebene)")