R scripts to process the scenarios

standardize columns. add country level aggregations. add relative impacts

aggregateShocks.R

+#
+# aggregate the flood2010 and earthquake scenarios to country level
+# 
+
+source('funAggregateNuts2CNT.R')
+codes <- read.csv("helperData/nuts3fid4Codes.csv")
+codes <- codes[,c('fid4','CNTR_CODE','CNTR_NAME','CNTR_CODE_iso2','CNTR_CODE_iso3','CNTR_CODE_Eurostat')]
+codes <- codes[!duplicated(codes),]
+
+# files to aggregate
+
+files <- list.files('scenarios',pattern = 'csv',recursive = T)
+files <- paste0('scenarios/',files[grep('.csv$(?<!aggCNT.csv)',files,perl=T)])
+files <- files[grep('.csv$(?<!rel.csv)',files,perl=T)]
+cat('Aggregating NUTS3 to CNT for...\n')
+for(f.i in 1:length(files)){
+	file <- files[f.i]
+	cat(sprintf('%i of %i %s\n',f.i, length(files),file))
+	data <- read.csv(file,row.names=NULL)
+	if(!('fid4'%in%names(data))){
+		cat('    fid4 col missing probably already country level data\n')
+	} else {
+		data.CNT <- aggregateNUTS3ToCountry(data,codes)
+		write.csv(data.CNT,gsub('.csv','-aggCNT.csv',file),row.names = F)
+	}
+}

funAggregateNuts2CNT.R

+aggregateNUTS3ToCountry <- function(data,codes){
+	sectorCols <- grep('ALL|TOTAL|^[A-Z]$',names(data),perl = T)
+	for(s in sectorCols){
+		suppressWarnings(data[[s]] <- as.numeric(data[[s]]))
+	}
+	data[is.na(data)] <- 0
+	if(!('CNTR_CODE'%in%names(data))){
+		data <- merge(codes,data,by = 'fid4')
+	}
+	sectorCols <- grep('ALL|TOTAL|^[A-Z]$',names(data),perl = T)
+	data <- aggregate(data[,c(sectorCols)],
+											 by = list(Category=data$CNTR_CODE),FUN=sum)
+	names(data)[1] <- 'CNTR_CODE'
+	codesCNT <- codes[,-1]
+	codesCNT <- codesCNT[!duplicated(codesCNT),]
+	data <- merge(codesCNT,data)
+	return(data)
+}

funRelData.R

+relData <- function(data,stocksNUTS3=NULL,stocksCNT=NULL){
+	names(data)[names(data)=='ALL'] <- 'TOTAL'
+	names(stocksNUTS3)[names(stocksNUTS3)=='ALL'] <- 'TOTAL'
+	names(stocksCNT)[names(stocksCNT)=='ALL'] <- 'TOTAL'
+	sectorCols <- grep('ALL|TOTAL|^[A-Z]$',names(data),perl = T)
+	data.rel <- data
+	data.rel[,sectorCols] <- NA
+	for(i in 1:nrow(data)){
+		if('fid4' %in% names(data)){
+			stocks <- stocksNUTS3
+			rowInStocks <- which(stocks$fid4 == data$fid4[i])
+		} else if (nchar(data$CNTR_CODE[i])==2){
+			stocks <- stocksCNT
+			rowInStocks <- which(stocks$CNTR_CODE_Eurostat == data$CNTR_CODE[i])
+			if(length(rowInStocks)==0){
+				rowInStocks <- which(stocks$CNTR_CODE_iso2== data$CNTR_CODE[i])
+			} 
+		} else if (nchar(data$CNTR_CODE[i])==3){
+			stocks <- stocksCNT
+			rowInStocks <- which(stocks$CNTR_CODE_iso3 == data$CNTR_CODE[i])
+		}
+		if(length(rowInStocks)==0){
+			warning(paste('no region match for data row',i))
+		}
+		for(s in names(data)[sectorCols]){
+			suppressWarnings(data.rel[i,s] <- as.numeric(data[i,s]) / as.numeric(stocks[rowInStocks,s]))
+			if (is.nan(data.rel[i,s])|is.na(data.rel[i,s])){
+				data.rel[i,s] <- 0
+			}
+		}
+	}
+	return(data.rel)
+}

relativizeShocks.R

+#
+# Uses the stocks in the flood scenario 2 and in the country level aggregate stocks derived
+# from it to relativize the shocks in the earthquake and flood1 scenarios.
+# 
+
+source('funRelData.R')
+
+nuts3LevelStocks <- read.csv("helperData/nuts3LevelStocks.csv", row.names=NULL)
+countryLevelStocks <- read.csv("helperData/countryLevelStocks.csv", row.names=NULL)
+
+
+files <- list.files('scenarios',pattern = 'csv',recursive = T)
+files <- paste0('scenarios/',files[grep('.csv$(?<!rel.csv)',files,perl=T)])
+cat('Calculating relative impacts for...\n')
+for(f.i in 1:length(files)){
+	file <- files[f.i]
+	cat(sprintf('%i of %i %s\n',f.i, length(files),file))
+	data <- read.csv(file,row.names=NULL)
+	data.CNT <- relData(data,nuts3LevelStocks,countryLevelStocks)
+	write.csv(data.CNT,gsub('.csv','-rel.csv',file),row.names = F)
+}
+
+

stockAggregation.R

+# 
+# Aggregate NUTS3 scenario data to country level
+# 
+# library(sf)
+# worldAdmin1 <- read_sf('scenarios/ne_10m_admin_1_states_provinces/ne_10m_admin_1_states_provinces.shp')
+
+# read scenario file with NUTS3 data ####
+library(readxl)
+library(countrycode)
+# skip two rows so headings are the NACE letters
+stocksNUTS3 <- read_excel("scenarios/flood Scenario 2.0/Flood_Scenario_2010.xlsx", 
+										 sheet = "stocks")
+stockCols <- grep('STOCK',names(stocksNUTS3))
+for( n in grep('STOCK',names(stocksNUTS3))){
+	colnames(stocksNUTS3)[n] <- stocksNUTS3[[n]][2]
+}
+stockUnit <- 'mEUR'
+stockTypes <- stocksNUTS3[3,stockCols]
+stockLabels <- stocksNUTS3[1,stockCols]
+stocksNUTS3 <- stocksNUTS3[-(1:5),]
+for( n in colnames(stocksNUTS3)[stockCols]){
+	stocksNUTS3[[n]] <- as.numeric(stocksNUTS3[[n]])
+}
+stocksNUTS3$CNTR_CODE[stocksNUTS3$CNTR_CODE=='SRB_1'] <- 'SRB'
+stocksNUTS3$CNTR_CODE[stocksNUTS3$CNTR_CODE=='RS'] <- 'SRB'
+stocksNUTS3 <- stocksNUTS3[order(stocksNUTS3$CNTR_CODE),]
+suppressWarnings(stocksNUTS3$CNTR_CODE_iso3 <- countrycode(stocksNUTS3$CNTR_CODE,'eurostat','iso3c'))
+stocksNUTS3$CNTR_CODE_iso3[is.na(stocksNUTS3$CNTR_CODE_iso3)] <- countrycode(stocksNUTS3$CNTR_CODE[is.na(stocksNUTS3$CNTR_CODE_iso3)],'iso3c','iso3c')
+stocksNUTS3$CNTR_NAME <- countrycode(stocksNUTS3$CNTR_CODE_iso3,'iso3c','iso.name.en')
+stocksNUTS3$CNTR_CODE_Eurostat <- countrycode(stocksNUTS3$CNTR_CODE_iso3,'iso3c','eurostat')
+stocksNUTS3$CNTR_CODE_iso2 <- countrycode(stocksNUTS3$CNTR_CODE_iso3,'iso3c','iso2c')
+stocksNUTS3 <- stocksNUTS3[,c(1:5,29,30,31,28,6:27)]
+write.csv(stocksNUTS3,file = 'helperData/nuts3LevelStocks.csv',row.names=F)
+codes <- stocksNUTS3[,1:9]
+write.csv(codes,file = 'helperData/nuts3fid4Codes.csv',row.names=F)
+sink('helperData/nuts3LevelStocksMetadata.csv')
+cat(sprintf('Unit %s,,\n',stockUnit))
+cat(sprintf('Labels,, \n'))
+cat(sprintf('Sector,Label,Type\n'))
+sectorCols <- grep('ALL|TOTAL|^[A-Z]$',names(stocksNUTS3),perl = T)
+for(n in colnames(stocksNUTS3)[sectorCols]){	
+	cat(sprintf('"%s", "%s", "%s"\n',n,stockLabels[n],stockTypes[n]))
+}
+sink()
+
+
+# aggregate to country level
+sectorCols <- grep('ALL|TOTAL|^[A-Z]$',names(stocksNUTS3),perl = T)
+stocksCNT <- aggregate(stocksNUTS3[,sectorCols],
+											 by = list(Category=stocksNUTS3$CNTR_CODE),FUN=sum)
+colnames(stocksCNT)[1] <- 'CNTR_CODE'
+# add country codes and country names back to data
+# two and three letter country codes as seperate columns
+library(countrycode)
+stocksCNT$CNTR_CODE[stocksCNT$CNTR_CODE=='SRB_1'] <- 'SRB'
+stocksCNT$CNTR_CODE[stocksCNT$CNTR_CODE=='RS'] <- 'SRB'
+suppressWarnings(stocksCNT$CNTR_CODE_iso3 <- countrycode(stocksCNT$CNTR_CODE,'eurostat','iso3c'))
+stocksCNT$CNTR_CODE_iso3[is.na(stocksCNT$CNTR_CODE_iso3)] <- countrycode(stocksCNT$CNTR_CODE[is.na(stocksCNT$CNTR_CODE_iso3)],'iso3c','iso3c')
+stocksCNT$CNTR_NAME <- countrycode(stocksCNT$CNTR_CODE_iso3,'iso3c','iso.name.en')
+stocksCNT$CNTR_CODE_Eurostat <- countrycode(stocksCNT$CNTR_CODE_iso3,'iso3c','eurostat')
+stocksCNT$CNTR_CODE_iso2 <- countrycode(stocksCNT$CNTR_CODE_iso3,'iso3c','iso2c')
+stocksCNT <- stocksCNT[,c(25,26,27,24,2:23)]
+write.csv(stocksCNT,file = 'helperData/countryLevelStocks.csv',row.names = F)
+sink('helperData/countryLevelStocksMetadata.csv')
+cat(sprintf('Unit %s,,\n',stockUnit))
+cat(sprintf('Labels,, \n'))
+cat(sprintf('Sector,Label,Type\n'))
+sectorCols <- grep('ALL|TOTAL|^[A-Z]$',names(stocksNUTS3),perl = T)
+for(n in colnames(stocksNUTS3)[sectorCols]){	
+	cat(sprintf('"%s", "%s", "%s"\n',n,stockLabels[n],stockTypes[n]))
+}
+sink()