diff --git a/github_calculation/01_collect_river_data.R b/github_calculation/01_collect_river_data.R
new file mode 100644
index 0000000..2b85c6f
--- /dev/null
+++ b/github_calculation/01_collect_river_data.R
@@ -0,0 +1,431 @@
+######################
+# collect data of river and lake contamination, prepare data for simulation
+# main goal: find the connection of the river segments. which is the following river segment downstream? This informatin will stored as "flow_to" and corresponds to the "id_all" which is equal to the row number. This script is not needed if you have a frame with all data connected..
+
+# author: david mennekes, PhD Student at Empa ST. Galen / ETH Zürich, Switzerland, david.mennekes@empa.ch
+# november 2020, last edit: march 2021
+######################
+
+# IMPORTANT # IMPORTANT #
+# this script uses a package from github. likely this package will change in future or will be available on CRAN. look for further information on github!
+# for installation:
+# remotes::install_github("paleolimbot/qgisprocess")
+# works with QGIS 3.16. and newer, however QGIS needs to be installed as well
+# packages: View(qgis_algorithms())
+# help: qgis_show_help("native:FUNKTION_YOU_NEED_HELP")
+
+
+
+	###############################
+	#packages and path
+	###############################
+	
+	#path to sub-folders
+	#add your own path
+	setwd("~/")
+	main.path <- "PhD/mennekes/"
+	
+	
+	#polymers
+	polymers <- c("LDPE", "HDPE", "PP", "PS", "EPS", "PVC", "PET")
+	
+	
+	library(tidyverse)
+	library(sf)
+	library(qgisprocess)
+	library(tmap)
+	library(raster)
+
+	###############################
+	# functions
+	###############################
+	
+	# change output from qgis to simple features
+
+	qgis_to_sf <- function(input){
+		return(sf::st_as_sf(sf::read_sf(qgis_output(input, "OUTPUT"))))
+	}
+	
+	
+	# rename geometry column. as standard use "geometry"
+	rename_geometry <- function(g, name = "geometry"){
+		current = attr(g, "sf_column")
+		names(g)[names(g)==current] = name
+		st_geometry(g)=name
+		g
+	}
+	
+
+	###############################
+	# load data
+	###############################
+
+	# load river and lake data produced by Kawecki
+	#unit: for rivers: emission kg / km river length
+	#			 for lakes: emission kg / ha lake
+
+	load(paste0(main.path, "data_input_kawecki/Data_Summed/Water_summed_dm.Rdata"))
+	# emission for rivers in kg / km
+	# emission for lakes in kg / ha
+	
+
+	
+	#load river	polylines (data by toposwiss)
+	load(paste0(main.path, "data_raw/maps/rivers/rivers_updated.Rdata")) # CRS: CH1903+ /LV95
+
+	#load lakes (generated from tlm_fliesgewaesser.shp)
+	load(paste0(main.path, "data_raw/maps/lakes/lakes_poly.Rdata"))
+	
+	#check for CRS
+	if(length(unique(c(st_crs(tlm.river), st_crs(lakes_emi),  st_crs(lakes_poly), st_crs(rivers_emi)))[[1]]) != 1){warning("CRS are different! Please change!")}else{"all CRS are equal."} #CRS need to be the same!
+	
+	# the dataset for switzerland contains different river types stored in OBJEKTART. not all of them were used.
+	# s Bisse Suone (0), pressure tubes of powerstations (1, 2 & 3), temporal rivers (7), rivers (4)
+	# lake connections (6) are important for further calculations!
+	# use only rivers enbeded in to the river systems (enabled == 1)
+	
+	tlm.river <- tlm.river %>% filter(OBJEKTART %in% c(4,6), ENABLED == 1) 
+	
+	
+	# analyse river and lake specific columns for later selection
+	
+	cr <- names(rivers_emi) #all col names river
+	cl <- names(lakes_emi) # all col. names lakes
+	col.lakes <- cl[!(cl %in% cr)] #unique col names lakes
+	col.river <- cr[!(cr %in% cl)] # unique col names rivers
+	
+	
+	j <- NULL #collect positions in cl
+	for (i in polymers) {
+		k <- which(grepl(i, cl))
+		j <- c(j, k)
+	}
+	col.emi.lakes <- cl[unique(j)] #col names with emission for lakes
+	
+	j <- NULL #collect positions in cr
+	for (i in polymers) {
+		k <- which(grepl(i, cr))
+		j <- c(j, k)
+	}
+	col.emi.rivers <- cr[unique(j)] #col names with emission for rivers
+	rm(j)
+	
+	
+	#########################
+	#  calculation
+	#########################
+	
+	rivers.in.lakes <- rivers46_cast[rivers46_cast$OBJEKTART == 6, ] #lakes are where objektar == 6
+	rivers.in.lakes$Lake_id <- 1:nrow(rivers.in.lakes)
+	underground.rivers <- rivers46_cast[rivers46_cast$OBJEKTART == 4 & rivers46_cast$VERLAUF %in% c(200, 300), ] #rivers which are missing in the rivers_emi because they are underground
+	
+	
+	###########################	
+	# 1.) get emission information from lake polygon via join
+	###########################
+	# the output emissions by Kawecki are given in polygons for the lakes. therefore emission informations from lake polygons are transferred to the polylines. 
+	
+	#join by FID_poly_s
+	lakes_con <- as.data.frame(st_drop_geometry(lakes_emi[c(col.emi.lakes, "FID_poly_s")])) #write relevant data in dataframe, especially contamination
+	rivers6 <- merge(rivers.in.lakes, lakes_con, by = "FID_poly_s") #merge contamination data with rivers.in.lakes by FID_poly_s an ID given by the polygones in the first time.
+
+	
+	
+	
+	
+	
+	
+	##################
+	# 2.) bring joined rivers and rivers emi together
+	##########################
+	
+	
+	# b) make dataframe for all
+	###### 
+
+	names.all <- unique(c(names(rivers_emi), names(rivers6), names(underground.rivers))) #all names existing
+	length(names.all)
+
+	setdiff(names.all, names(rivers_emi))
+
+	
+	# find columns that are missing in other df and fill these columns with NA
+	##########
+	rivers_emi[, setdiff(names.all, names(rivers_emi))] <- NA #make rows with NA when missing compared to other sf
+	rivers6[ ,setdiff(names.all, names(rivers6))] <- NA
+	underground.rivers[ , setdiff(names.all, names(underground.rivers))] <- NA
+	
+	
+	
+	# bind all data together
+	rivers6 <- st_transform(rivers6, st_crs(rivers_emi))
+	underground.rivers <- st_transform(underground.rivers, st_crs(rivers_emi))
+	
+	rivers.all <- rbind(rivers_emi, rivers6[ , names(rivers_emi)],underground.rivers[ , names(rivers_emi)]) # rbind, while using order of rivers_emi
+	
+	
+	save(rivers.all, file = paste0(main.path, "temp_data/rivers_all00.Rdata"))
+	
+	# st_write(rivers.all, paste0(main.path, "temp_data/rivers_all.gpkg"), append = F)
+	
+	
+	
+	
+	###########
+	# 4.) make river connections
+	###########
+	# connection are the most important. to see where the river flows to
+	# the principle is, that each last vertex of a linefeature is associated with the closest first vertex of another linefeature. 
+	
+	load(paste0(main.path, "temp_data/rivers_all00.Rdata"))
+	
+	
+	# drop multilinestring to linestring for further process
+	rivers.all <- st_cast(rivers.all, "LINESTRING") #only non important rivers section contain actually "mulilinestrings" which cause an error
+	
+	nuller <- which(as.numeric(st_length(rivers.all)) < 0.1) #in meter, many section have length = 0
+	rivers.all <- rivers.all[-nuller, ]
+	
+	#### get the ID of the river section which follows downstream.. first make ID
+	# make new cols: 1) id_all; 2) flow_to: in which id_all flows id_all n-1 
+	rivers.all$id_all <- 1:nrow(rivers.all) #important: id_all = row number
+	
+	
+	# find first and last point of river linestring. Water flows from first to last point (s. data description)
+	first <- data.frame(f = st_line_sample(rivers.all, sample = 0), #sample = 0 for first point
+											n = rivers.all$id_all)# first
+	first <- st_as_sf(first)
+	
+	last <- data.frame(l = st_line_sample(rivers.all, sample = 1),
+										 n = rivers.all$id_all)#last
+	last <- st_as_sf(last)
+	
+	#should be same length. for each element one number
+	if(nrow(first) != nrow(last) | nrow(first) != nrow(rivers.all)){
+		warning("something went wrong!")
+		break
+	}
+	
+	#######
+	#a ) find nearest first to last. Do this muliple times in case more than one option would be possible
+	
+	
+	
+	######
+	#find nearest feature
+	nrst_a <- st_nearest_feature(last, first) #find nearest point from last to a first point which is a river or lake
+	dist_a <- as.numeric(st_distance(first[nrst_a, ], last, by_element = T)) #distances between both points
+	first_s_a <- first[nrst_a, ]
+	f_a <- first_s_a$n[which(dist_a < 0.1)]# get all id of features that were closer than 0.1cm
+	l_a <- last$n[which(dist_a < 0.1)]
+	# test <- st_distance(first[f_a, ], last[l_a, ], by_element = T)
+	
+	
+	#do it again... to find a second possible option
+	first_b <- first[-unique(f_a), ]
+	nrst_b <- st_nearest_feature(last, first_b) #find nearest point when nrst01_a is not allowed
+	dist_b <- as.numeric(st_distance(first_b[nrst_b, ], last, by_element = T))
+	first_s_b <- first_b[nrst_b, ]
+	f_b <- first_s_b$n[which(dist_b < 0.1)]
+	l_b <- last$n[which(dist_b < 0.1)]
+	
+	
+	#do it again... to find a second possible option
+	first_c <- first[-unique(c(f_b, f_a)), ]
+	nrst_c <- st_nearest_feature(last, first_c) #find nearest point when nrst01_a is not allowed
+	dist_c <- as.numeric(st_distance(first_c[nrst_c, ], last, by_element = T))
+	first_s_c <- first_c[nrst_c, ]
+	f_c <- first_s_c$n[which(dist_c < 0.1)]
+	l_c <- last$n[which(dist_c < 0.1)]
+	
+	#do it again... to find a second possible option
+	first_d <- first[-unique(c(f_b, f_a, f_c)), ]
+	nrst_d <- st_nearest_feature(last, first_d) #find nearest point when nrst01_a is not allowed
+	dist_d <- as.numeric(st_distance(first_d[nrst_d, ], last, by_element = T))
+	first_s_d <- first_c[nrst_d, ]
+	f_d <- first_s_d$n[which(dist_d < 0.1)]
+	l_d <- last$n[which(dist_d < 0.1)]
+	
+	
+	df_flow_to <- data.frame(id = last$n,
+													 option_a = NA,
+													 option_b = NA,
+													 option_c = NA,
+													 option2_a = NA,
+													 option2_b = NA,
+													 option2_c = NA)
+	
+	#check for same GEWISS_NR as first creteria
+	gew_eq1_a <- which(rivers.all$GEWISS_NR[f_a] == rivers.all$GEWISS_NR[l_a] & rivers.all$LAUF_NR[f_a] %in% c(0, 999))
+	gew_eq2_a <- which(rivers.all$GEWISS_NR[l_a] == rivers.all$GEWISS_NR[f_a] & rivers.all$LAUF_NR[f_a] %in% c(0, 999))
+	df_flow_to$option_a[l_a[gew_eq2_a]] <- rivers.all$id_all[f_a[gew_eq1_a]] #write flow to ID when GEWissnr is equal
+	
+	# for b
+	gew_eq1_b <- which(rivers.all$GEWISS_NR[f_b] == rivers.all$GEWISS_NR[l_b] & rivers.all$LAUF_NR[f_b] %in% c(0, 999))
+	gew_eq2_b <- which(rivers.all$GEWISS_NR[l_b] == rivers.all$GEWISS_NR[f_b] & rivers.all$LAUF_NR[f_b] %in% c(0, 999))
+	df_flow_to$option_b[l_b[gew_eq2_b]] <- rivers.all$id_all[f_b[gew_eq1_b]] #write flow to ID when GEWissnr is equal
+	
+	# for c
+	gew_eq1_c <- which(rivers.all$GEWISS_NR[f_c] == rivers.all$GEWISS_NR[l_c] & rivers.all$LAUF_NR[f_c] %in% c(0, 999))
+	gew_eq2_c <- which(rivers.all$GEWISS_NR[l_c] == rivers.all$GEWISS_NR[f_c] & rivers.all$LAUF_NR[f_c] %in% c(0, 999))
+	df_flow_to$option_c[l_c[gew_eq2_c]] <- rivers.all$id_all[f_c[gew_eq1_c]] 
+	
+	#testing:
+	df_flow_to[which(!(rowSums(df_flow_to[, 2:4], na.rm = T) == rowMeans(df_flow_to[, 2:4], na.rm = T))), ] #shoud be empty
+	#found two conflicts.. use first option here
+	# View(df_flow_to)
+	
+	#make final solution
+	df_flow_to$final <- NA
+	df_flow_to$final[which((rowSums(df_flow_to[, 2:4], na.rm = T) == rowMeans(df_flow_to[, 2:4], na.rm = T)))] <- rowSums(df_flow_to[which((rowSums(df_flow_to[, 2:4], na.rm = T) == rowMeans(df_flow_to[, 2:4], na.rm = T))), 2:4], na.rm = T) #when no conflict, use the only number
+	
+	#in conflict use first row
+	df_flow_to$final[which(!(rowSums(df_flow_to[, 2:4], na.rm = T) == rowMeans(df_flow_to[, 2:4], na.rm = T)))] <- df_flow_to$option_a[which(!(rowSums(df_flow_to[, 2:4], na.rm = T) == rowMeans(df_flow_to[, 2:4], na.rm = T)))]
+	
+	
+	
+	
+	### use other connections with distance 0
+	missing_a <- which(l_a %in% df_flow_to$id[is.na(df_flow_to$final)])
+	g_a <- rivers.all$LAUF_NR[f_a[missing_a]] %in% c(0, 999)
+	df_flow_to$option2_a[l_a[missing_a[g_a]]] <- f_a[missing_a[g_a]]
+	
+	#for b
+	missing_b <- which(l_b %in% df_flow_to$id[is.na(df_flow_to$final)])
+	g_b <- rivers.all$LAUF_NR[f_b[missing_b]] %in% c(0, 999)
+	df_flow_to$option2_b[l_b[missing_b[g_b]]] <- f_b[missing_b[g_b]]
+	
+	#for c
+	missing_c <- which(l_c %in% df_flow_to$id[is.na(df_flow_to$final)])
+	g_c <- rivers.all$LAUF_NR[f_c[missing_c]] %in% c(0, 999)
+	df_flow_to$option2_c[l_c[missing_c[g_c]]] <- f_c[missing_c[g_c]]
+	
+	#testing
+	df_flow_to[which(!(rowSums(df_flow_to[, 5:7], na.rm = T) == rowMeans(df_flow_to[, 5:7], na.rm = T))), ]
+	rivers.all$OBJEKTART[which(!(rowSums(df_flow_to[, 5:7], na.rm = T) == rowMeans(df_flow_to[, 5:7], na.rm = T)))]
+	# many sections are lakes. -> doesn´t matter
+	# other sections are rural rivers. just choose first option
+	
+	
+	# final 
+	na_rows <- which(is.na(df_flow_to$final))
+	df_flow_to$final[na_rows] <- rowMeans(df_flow_to[na_rows, 5:7], na.rm = T)
+	
+	#conflict handling
+	df_flow_to$final[which(!(rowSums(df_flow_to[, 5:7], na.rm = T) == rowMeans(df_flow_to[, 5:7], na.rm = T)))] <- df_flow_to$option2_a[which(!(rowSums(df_flow_to[, 5:7], na.rm = T) == rowMeans(df_flow_to[, 5:7], na.rm = T)))] #use option 2a in case of conflict
+	
+	
+	
+	####next: for all still empty spots use the element with distance 0
+	# shows all options nrst_a
+	dist_0m <- which(as.numeric(st_distance(last, first[nrst_a, ], by_element = T)) < 0.1) #find all with distance 0
+	dist_0m_NA <- dist_0m[dist_0m %in% which(is.na(df_flow_to$final))] #find all with distance 0 which are still missing in df_flow_to$final
+	
+	df_flow_to$final[dist_0m_NA] <- nrst_a[dist_0m_NA]
+	
+	
+	df_flow_to$final[is.na(df_flow_to$final)] <- NA
+	
+	#done: rest reminds NA
+	
+	
+	
+	
+	
+	
+	
+	#add flow to for rivers to river network
+	rivers.all$flow_to <- df_flow_to$final
+	save(rivers.all, file = paste0(main.path, "temp_data/forPlot.Rdata")) #with all connection also through lakes
+	
+
+	# b) find outflow for lakes
+	###############
+	# outflow for lakes are the first linefeature which is not a lake any more. all linefeatures in the lake are directed to "outflow" linefeature regardless their location.
+	
+	#id of lakes
+	id_lakes <- unique(rivers.all$FID_poly_s)[-is.na(unique(rivers.all$FID_poly_s))] # numbers without "river" in lake are missing, without NA
+	possible_options <- NULL
+	
+	rivers_conflict <- NULL
+	
+	for (i in 1 : length(id_lakes)){
+		rivers.i <- which(rivers.all$FID_poly_s == id_lakes[i]) # which rivers have lake id = i
+		rivers.i.flow_to <- unique(rivers.all$flow_to[rivers.i])
+		if(length(rivers.i.flow_to) > 1){
+			rivers.i.flow_to <- rivers.i.flow_to[!(is.na(rivers.i.flow_to))] # if more than one outflow option omit na option
+			if(length(rivers.i.flow_to) < 1){ #if all options were NA, new length would be < 1. thus fill rivers.i.flow_to with NA
+				rivers.i.flow_to <- NA
+				next
+			}
+		}
+		# if lake section has only one outflow is available choose this one. in case of more lake section or more than one option select river (objektar = 4) connected to lake if possible or other options..
+		if(length(rivers.i.flow_to) == 1){ # if length == 1
+			rivers.all$flow_to[rivers.i] <- rivers.i.flow_to # if outflow is NA, put rivers.i.flow_to for all river sections within lake rivers.i.flow_to (will be NA), otherwise it will be the only option possible (case one outflow)
+		}else{
+			#more than one option
+			outflow.river4 <- which(rivers.all$OBJEKTART[rivers.i.flow_to] == 4) #check which is outflow with objektart = 4
+			outflow.all <- which(rivers.all$FID_poly_s[rivers.i.flow_to] != id_lakes[i]) # check for flows to other section but not the same lake (id_lakes[i])
+			
+			if(length(outflow.river4) == 1){ # ideal case. only one outflow to one river. prefer river before pressure tubes etc.
+				rivers.all$flow_to[rivers.i] <- rivers.i.flow_to[outflow.river4] # select all flow_to of river. fill with outflow.river4 river section
+				next #go to next lake id
+			}
+			
+			# same case as above. only one option possible
+			if(length(outflow.all) == 1 & length(outflow.river4) < 1){ 
+				rivers.all$flow_to[rivers.i] <- rivers.i.flow_to[outflow.all]
+				next
+			}
+			
+			# more than one option was found
+			if(length(outflow.all) > 1 | length(outflow.river4) > 1){
+				if(length(outflow.river4) > 1){ #if more than one river possibility
+					id_possible <- rivers.i.flow_to[outflow.river4]
+				}else{
+					id_possible <- rivers.i.flow_to[outflow.all]
+				}
+				a <- which(rivers.all$LAUF_NR[id_possible] == 0)# take outflows which are main river
+				if(length(a) == 1){
+					rivers.all$flow_to[rivers.i] <- id_possible[a]
+				}	else{
+					low_gewissNR <- which(rivers.all$GEWISS_NR[id_possible] == min(rivers.all$GEWISS_NR[id_possible])) #get river with lowest GEWISS_NR because this is the biggest river
+					rivers.all$flow_to[rivers.i] <- id_possible[low_gewissNR[1]] # position 1 in case of multiple possibilities
+				}
+				next
+			}
+			
+			
+			if(length(outflow.river4)<1 & length(outflow.all)<1){ #worst case. for both option no result. means no outflow of lake.
+				rivers.all$flow_to[rivers.i] <- NA
+				}
+			}
+		}
+	
+	
+	
+	# warnings()
+	print(sort(rivers_conflict))
+	# st_write(rivers.all[rivers_conflict, ], "PhD/spielereien/conflicts.gpkg", append = F)
+	
+	### all data that flow to each self. make NA
+	rivers.all$flow_to[which(rivers.all$id_all == rivers.all$flow_to)] <- NA
+	
+	
+	########
+	# save data
+	########
+	
+	# write first and last point to file 
+	st_write(first, paste0(main.path, "temp_data/first_points.shp"), append = F) #writing first points for control
+	
+	st_write(last, paste0(main.path, "temp_data/last_points.shp"), append = F)
+	
+	#save data without connections
+	st_write(rivers.all[is.na(rivers.all$flow_to), ], paste0(main.path, "temp_data/not_connected.gpkg"), append = F)
+	
+	save(rivers.all, last, first, file = paste0(main.path, "data_modified/river_network/rivers_all01.Rdata"))
+	st_write(rivers.all, paste0(main.path, "data_modified/river_network/rivers_all01_gis.gpkg"), append = F)
+	
+	rm(list = ls())
+	
\ No newline at end of file
diff --git a/github_calculation/02.1_outflows_country.R b/github_calculation/02.1_outflows_country.R
new file mode 100644
index 0000000..a0cf486
--- /dev/null
+++ b/github_calculation/02.1_outflows_country.R
@@ -0,0 +1,139 @@
+	###############
+	# only to make file with endpoints of river sections which contain a name.
+	# this specific points need to be reviewed in a GIS software and manuelly selected
+	# output containers are linefeatures drown in a GIS software which are next to the outflowing river. we did this only for the bigger outflowing countries. Additionally, added two outflow container after each other. the first outflow container/linefeature passes the contamination on without any interaction while the second one is a final container. inflow always flows to the same container again....
+	# we marked the outflow container with the attribute outflow == 1 for rivers and the first type of outflow and outflow == 2 for the final upsumming container.
+	# outflow == 3 and outflow == 4 correspond to the first and second outflow type which recieve all pollution of dead ends or small border crossing rivers
+	# author: david mennekes, PhD Student at Empa ST. Galen / ETH Zürich, Switzerland, david.mennekes@empa.ch
+	# march 2021
+	######################
+	setwd("~/")
+	
+	# packages
+	library(sf)
+	library(dplyr)
+	library(tidyverse)
+	library(sp)
+	library(raster)
+	
+	main.path <- "Phd/mennekes/"
+	
+	
+	#load data
+	load(paste0(main.path, "data_modified/river_network/rivers_all01.Rdata")) #dataset with river segments connected according to the direction of flow.
+	
+	#use rivers.all2 for modification in this script
+	
+	rivers.all2 <- rivers.all
+	rm(rivers.all)
+	
+	
+	outflows_container <- st_read(paste0(main.path, "data_modified/river_network/outflow_lines.shp")) #this data was obtained manually in a GIS Software, country = "none" is container for NAs -> for data collection of outflowing rivers / cross boundary rivers. Or rivers that are dead ends.
+
+	#check for names. column Id is not needed
+	outflows_container <- outflows_container[ , -1]
+	
+	
+	#bring dataframe together with rivers.all2
+	#make empty rows again
+	names.all <- c(names(outflows_container), names(rivers.all2))
+	
+	outflows_container[ , setdiff(names.all, names(outflows_container))] <- NA #make NAs
+	rivers.all2[ , setdiff(names.all, names(rivers.all2))] <- NA
+	
+	#bring togehter
+	rivers.all2a <- rbind(rivers.all2, outflows_container[ , names(rivers.all2)])
+	tail(rivers.all2a)
+	
+	rm(rivers.all2)
+	
+	#####
+	#get id_all for outflows. Id_all equals to rownumber
+	rivers.all2a$id_all[which(!(is.na(rivers.all2a$outflow)))] <- which(!(is.na(rivers.all2a$outflow)))
+	#check for duplicated
+	sum(duplicated(rivers.all2a$id_all))#no duplicated! perfecto
+	
+	
+	#find first and last points again for flow to connections. distances should be 0
+	#find outflows to the "container" points
+	#outflow =1 for first section after outflow, =2 for second section, follows outflow = 1, =3 for outflow unknown, =4 follows =3
+	
+	#find first point for outflow of =1
+	outflows_container_first <- st_line_sample(rivers.all2a[which(rivers.all2a$outflow == 1), ], sample = 0)
+	id_first1 <- 	which(rivers.all2a$outflow == 1)
+	
+	#find last points
+	outflows_container_last <- st_line_sample(rivers.all2a[which(rivers.all2a$outflow == 1), ], sample = 1)
+	
+	#find first points for outflow =2
+	outflows_container_first2 <- st_line_sample(rivers.all2a[which(rivers.all2a$outflow == 2), ], sample = 0)
+	id_first2 <- 	which(rivers.all2a$outflow == 2)
+	
+	#find last points for rivers.all2
+	last_rivers <- st_line_sample(rivers.all2a, sample = 1)
+	
+	
+
+	
+	### find nearest feature between last points rivers.all2a und first piont outflows=1
+	
+	nrst.last <- st_nearest_feature(outflows_container_first, last_rivers)
+	
+	#check distances: 
+	dist.d <- st_distance(outflows_container_first, rivers.all2a[nrst.last, ], by_element = T) #passt
+	
+	if(sum(as.numeric(dist.d)) != 0){warning("some endpoints are not connected to rivernetwork!")}
+	
+	#write flow to into rivers.all
+	rivers.all2a$flow_to[nrst.last] <- id_first1
+	
+	#find nearst. feature for outflow =1 to outflow =2
+	
+	nrst.outflow <- st_nearest_feature(outflows_container_last, outflows_container_first2) #caution. the row numbers are only in relation to outflows_countainer_last
+	
+	#write to rivers.all
+	rivers.all2a$flow_to[id_first1] <- id_first2[nrst.outflow]
+	
+	
+	########## correct some rivers which are not really connected but have contamination in flow
+	#correct lago maggiore, da läuft etwas falsch und die Flüsse laufen nicht raus. deshalb händische zuordnung zum richtigen ausfluss
+	w <- rivers.all2a$id_all[grepl("Maggiore", rivers.all2a$name_2) & !(is.na(rivers.all2a$type_lake))]
+	rivers.all2a$flow_to[w] <- 441452
+	#exception: tresa (outflow lugano lake) flows to lago maggior (thats a fact)
+	rivers.all2a$flow_to[245951] <- 322929
+	rivers.all2a[245951, ] #check name
+	
+	# more corrections, specific to certain rows / river segments. only in our model because of the data we used.
+	rivers.all2a$flow_to[145582] <- 65252
+	rivers.all2a$flow_to[161662] <- 151698
+	rivers.all2a$flow_to[137386] <- 161435
+	rivers.all2a$flow_to[119416] <- 64103
+	rivers.all2a$flow_to[330682] <- 107754
+	rivers.all2a$flow_to[330731] <- 82724
+	rivers.all2a$flow_to[229408] <- 2262
+	rivers.all2a$flow_to[56105] <- 297158
+	rivers.all2a$flow_to[169845] <- 118141
+	rivers.all2a$flow_to[158965] <- 258322
+	
+	
+	##########
+	# handle all rivers that flow to NA
+	
+	rivers.all2a$flow_to[is.na(rivers.all2a$flow_to)] <- rivers.all2a$id_all[which(rivers.all2a$outflow == 3)] #all flow to with NA flowing to the container of NAs which is the outflow =3
+	
+	#outflow=3 flows to outflow=4
+	rivers.all2a$flow_to[which(rivers.all2a$outflow == 3)] <- rivers.all2a$id_all[which(rivers.all2a$outflow == 4)]
+	
+	
+	
+	#####
+	#outflows =2 and outflow=4 flow to each self.. for control
+	rivers.all2a$flow_to[which(rivers.all2a$outflow %in% c(2,4))] <- rivers.all2a$id_all[which(rivers.all2a$outflow %in% c(2,4))]
+	
+	
+	rivers.all2 <- rivers.all2a
+	rm(rivers.all2a)
+	save(rivers.all2, file = paste0(main.path, "data_modified/river_network/rivers_all3.Rdata")) #save in temp_data folder. should be created..
+	
+	rm(list = ls())
+	
\ No newline at end of file
diff --git a/github_calculation/02.3_get_flow_velocities.R b/github_calculation/02.3_get_flow_velocities.R
new file mode 100644
index 0000000..5ba7d80
--- /dev/null
+++ b/github_calculation/02.3_get_flow_velocities.R
@@ -0,0 +1,242 @@
+	######################
+	# connect discharge data from old maps (old crs) with data used here
+	# author: david mennekes; david.mennekes@empa.ch
+	
+	#packages
+	library("sf")
+	library("dplyr")
+	
+	#load data
+	
+	# wd
+	setwd("~/")
+	
+	#main path
+	main.path <- "PhD/mennekes/"
+	
+	#new data
+	load(paste0(main.path, "temp_data/rivers_all3.Rdata"))
+	rivers_LV05 <- st_transform(rivers.all3, 21781) #transform to old CRS for connecting with simulated data by swisstopo
+	
+	st_crs(rivers_LV05)
+	
+	#old data with discharge information
+	# for Switzerland discharge data is available but only for older maps. 
+	MQ_GWN_CH <- read.csv("~/PhD/data/karten/mittlerer Q/MQ-GWN-CH/Datensatz/MQ_GWN_CH.txt", header=T)
+
+	#load old gwn25 (CRS95)
+	gwn25 <- st_read("PhD/data/karten/swisstopo/200901_mennekes/200901_mennekes/Vec25_LV03_2008/gwn_25_l.shp") #available upon request
+	st_crs(gwn25) = 21781 #assign crs CH1903 to CH1903
+	
+
+	#test: showing the same seciton?
+	plot(st_geometry(gwn25[gwn25$GWLNR == "CH0006420000", ]))
+	plot(st_geometry(rivers_LV05[rivers_LV05$GWL_NR == "CH0006420000", ]), col = "red", add = T)
+	
+	gwn_Q <- merge(gwn25, MQ_GWN_CH, by.y = "OBJECTID_GWN25", all.x = T, by.x = "OBJECTID")
+	gwn_Q <- gwn_Q[ , c("MQN_JAHR", "GEWISSNR", "geometry")] #select only needed data
+	
+	
+	#######
+	# 1.) get Data from discharge stations in Switzerland
+	# read data from stations
+	f_long <- list.files("PhD/data/karten/mittleren Abflüsse für Stationen/Q/",full.names = T) # available upon request
+	
+	Q_station <- data.frame(Station_NR = rep(NA, length(f_long)),
+													river = NA,
+													discharge = NA,
+													Parameter = NA,
+													Parametereinheit = NA)
+	
+	#read all values from all files
+	for (i in 1:length(f_long)) {
+		t <- read.csv(f_long[i], sep=";", skip = 8)
+		Q_station[i, "Station_NR"] <- t$Stationsnummer
+		Q_station[i, "river"] <- t$Gewässer
+		Q_station[i, "discharge"] <- t$Wert
+		Q_station[i, "Parameter"] <- t$Parameter
+		Q_station[i, "Parametereinheit"] <- t$Parametereinheit
+	}
+	rm(t)
+	
+
+	unique(Q_station$Parametereinheit) # change l/s to m3/s -> *0.001
+	unique(Q_station$Parameter) #nur Abfluss: keine Seewasserstände
+	
+	#change all discharge to same unit (m3/s)
+	Q_station$discharge[Q_station$Parametereinheit == "l/s"] <- Q_station$discharge[Q_station$Parametereinheit == "l/s"]*0.001
+	Q_station$Parametereinheit <- "m3/s"
+
+	
+	# change discharge to flow velocity based on paper with IOWA, USA, Dataset
+	Q_station$flow_velocity <- 0.3*Q_station$discharge^0.228
+
+	plot(Q_station$flow_velocity, Q_station$discharge)
+	
+	
+	##### connect discharge with station location. station location than will be connected to river location
+	#read locations of station according to shapefile
+	location_station <- st_read("PhD/data/karten/mittleren Abflüsse für Stationen/hydrometrische_Stationen_2019/lhg_UBST.shp")
+	st_crs(location_station) <- 21781 #assign coordinate system to shapefile
+	unique(location_station$lhg_code)
+	location_station <- location_station[location_station$lhg_code == "lhg_fluss", ]#filter only river discharge
+	location_station
+	
+	
+	sum(duplicated(gwn25$OBJECTID)) #test for duplicates
+	
+	rivers_LV05_2 <- rivers_LV05[as.numeric(st_length(rivers_LV05))>0, ] #use only existing rivers
+	
+	#assign discharge of station to river section based on 
+	close_river <- st_nearest_feature(location_station, rivers_LV05_2) #row from close river
+	dis_close <- st_distance(location_station, rivers_LV05_2[close_river, ], by_element = T)
+	hist(dis_close)
+	location_station$loc_ID <- 1:nrow(location_station)
+	location_station[which(as.numeric(dis_close) >100), c("lhg_name", "loc_ID")]
+	rivers_LV05_2[close_river[which(as.numeric(dis_close) >100)], "NAME"] #we deleted the following lines:  189 & 216, 217
+	duplicated(close_river)
+	unique(close_river) #delete data which was wrongly associated
+	
+
+	location_station$river_idall <- rivers_LV05$id_all[close_river] #  GWSNR is an ID for each river given by the data. 
+	location_station <- location_station[-c(189,216, 217), ] #delete
+	location_station <- location_station[!(location_station$river_idall %in% close_river[duplicated(close_river)]), ] #duplicated -> delete
+		
+	Q_station_compl <- merge(location_station, Q_station, by.y = "Station_NR", all.x = T, by.x = "EDV_NR4")
+	is.na(Q_station_compl$discharge)
+	Q_station_compl <- Q_station_compl[!(is.na(Q_station_compl$discharge)), ] #delete all rows with no discharge
+	
+	
+	
+	
+	##### 
+	# 2.) use data from discharge modelling by swisstopo
+	# assign data to the new data set
+	gwn_Q_woNA <- na.omit(gwn_Q) #entries with NA value in gwn_Q
+	gwn_Q_woNA$flow_velocity <- 0.3*gwn_Q_woNA$MQN_JAHR^0.228 #calculate flow velocity based on paper
+	
+	rivers_LV05$discharge <- NA
+	rivers_LV05$flow_velocity <- NA
+	rivers_LV05$flow_velocity_type <- NA
+	
+	#Search for same GewissNR (ID by the data set) and a distance less than 10m
+	for (i in 1:nrow(gwn_Q_woNA)) {
+		z <- which(gwn_Q_woNA$GEWISSNR[i] == rivers_LV05$GEWISS_NR) #find all sections with same GWN_NR
+		if(length(z) < 1){
+			next #if not found, skip
+		}
+		z2 <- which(as.numeric(st_distance(gwn_Q_woNA[i, ], rivers_LV05[z, ], by_element = T)) < 10) #one segment in the old data set gwn_Q_woNA might be represented by muliple segments in the newer data set rivers_LV05
+		rivers_LV05$flow_velocity[z[z2]] <- gwn_Q_woNA$flow_velocity[i] #use the flow velocity
+		rivers_LV05$discharge[z[z2]] <- gwn_Q_woNA$MQN_JAHR[i]
+		rivers_LV05$flow_velocity_type[z[z2]] <- "model BAFU" #set type to model bafu
+		print(i)
+	}
+	
+	rivers_LV05[which(rivers_LV05$OBJEKTART == 6), c("flow_velocity", "flow_velocity_type", "discharge")] <- NA #overwrite values for lakes with NA in case something did go wrong
+	save(rivers_LV05,
+			 file = paste0(main.path, "temp_data/get_flow_v_rivers_LV05.Rdata")) #save
+	
+	########## load data
+	load(paste0(main.path, "temp_data/get_flow_v_rivers_LV05.Rdata"))
+	
+	
+	
+	
+	
+	#### connect flow velocity with rivers.all3
+	rivers.all4 <- rivers.all3 #create new data frame
+	rivers.all4$isLake <- F
+	rivers.all4$isLake[!(is.na(rivers.all4$volume))] <- T #make T / F for lake
+	rivers.all4$flow_velocity <- rivers_LV05$flow_velocity
+	rivers.all4$flow_velocity_type <-rivers_LV05$flow_velocity_type
+	rivers.all4$discharge <- rivers_LV05$discharge
+	# rm(rivers.all3)
+	# rm(rivers_LV05)
+	
+	####
+	#add information from station measurements Q_stations_comp
+	# use mean values between measured and modelled
+	rivers.all4$flow_velocity[Q_station_compl$river_idall] <- rowMeans(
+		data.frame(a = rivers.all4$flow_velocity[Q_station_compl$river_idall], 
+							 b = Q_station_compl$flow_velocity), na.rm = T)
+	
+	rivers.all4$flow_velocity_type[Q_station_compl$river_idall] <- "measurement"
+	rivers.all4$discharge[Q_station_compl$river_idall] <- Q_station_compl$discharge
+	save(rivers.all4, file = paste0(main.path, "temp_data/rivers_all4.Rdata"))
+	
+	
+	
+	### pass on known velocities
+	# if velocity is known in a section i but unknown in the section downstream of i (i+1) then section i+1 get velocity from section i. If two velocities could be passed on the higher one will be used. Assuming this would be the main river
+	
+	# set marker for rivers that have unknown flow velocity. These data can´t be overwritten
+	rivers.all4$is_known_v <- F
+	rivers.all4$is_known_v[!(is.na(rivers.all4$flow_velocity))] <- T
+	known_v_id <- which(rivers.all4$is_known_v == T) #here flow velocity is known
+	
+	
+	u <- 0
+	v <- 0
+	for (i in 1:500) { #set high number to also take over higher flow velocities in larger rivers
+		print(paste(u-sum(is.na(rivers.all4$flow_velocity), na.rm = T), "more explained"))
+		print(paste0("change sum velocity", v -sum(rivers.all4$flow_velocity, na.rm = T)))
+		v <- sum(rivers.all4$flow_velocity, na.rm = T)
+		u <- sum(is.na(rivers.all4$flow_velocity), na.rm = T)
+		
+		
+		
+		df <- data.frame(id = rivers.all4$flow_to, #get ids wo es hinfließt
+										 fv = rivers.all4$flow_velocity) #get flow velocity von vorherigen Flusssection
+		df2 <- df %>% filter(!(is.na(fv))) %>% group_by(id) %>% summarise(max_v = max(fv, na.rm = T)) # group by ID to determine maximum value when multiple rivers flow into one single river. Use the maximum flow velocity based on the assumption that velocity becomes rather higher than lower in average
+		
+		df2 <- df2[!(df2$id %in% known_v_id), ] #filter all ids which are known by measurement or models
+		# write the found velocity inrivers.all 4
+		rivers.all4$flow_velocity[df2$id] <- df2$max_v
+		rivers.all4$flow_velocity_type[df2$id] <- "uebernommen"
+		print(paste("round:",i))
+		
+	}
+	
+	summary(rivers.all4$flow_velocity)
+	rivers.all4$flow_velocity
+	
+	
+	##### find solutions for all river sections that do not have a flow velocity yet
+	# a) river sections above 1800m are mountaineous rivers -> flow velocity == 0.5
+	
+	#select all rivers where velocity is NA and height of last river part ist above 1800m and not lake
+	i1 <- rivers.all4$id_all[is.na(rivers.all4$flow_velocity) & rivers.all4$height_last>1800 & !(rivers.all4$isLake)] 
+	rivers.all4$flow_velocity[i1] <- 0.5
+	rivers.all4$flow_velocity_type[i1] <- "above1800"
+	
+	#below 1800m 
+	i2 <- rivers.all4$id_all[is.na(rivers.all4$flow_velocity) & rivers.all4$height_last<1800 & !(rivers.all4$isLake)] 
+	rivers.all4$flow_velocity[i2] <- 0.25
+	rivers.all4$flow_velocity_type[i2] <- "below1800"
+	
+	# rest
+	i3 <- rivers.all4$id_all[is.na(rivers.all4$flow_velocity) & !(rivers.all4$isLake)]
+	rivers.all4$flow_velocity[i3] <- 0.25
+	rivers.all4$flow_velocity_type[i3] <- "rest"
+	
+	rivers.all4$discharge[is.na(rivers.all4$discharge)] <- 0.05
+	
+	#collect total inflow into one lake
+	
+	
+	#inflow to lakes to determine residence times for lakes. This is used for rough estimation of amount of plastics in the lake
+	lake_id <- as.numeric(na.omit(unique(rivers.all4$FID_poly_s)))
+	rivers.all4$inflow_discharge <- NA
+	for (i in lake_id) {
+		x <- which(rivers.all4$FID_poly_s == i)
+		ids.x <- unique(which(rivers.all4$flow_to %in% x))
+		rivers.all4$inflow_discharge[x] <- sum(rivers.all4$discharge[ids.x], na.rm = T)
+		}
+	rivers.all4$verweilzeiten <- rivers.all4$volume/rivers.all4$inflow_discharge #in seconds
+	
+	rivers.all4$verweilzeiten[which(is.infinite(rivers.all4$verweilzeiten))] <- 100 #lakes without inflow. but also have not input of plastics...
+	
+	summary(rivers.all4$verweilzeiten)
+	save(rivers.all4, file = paste0(main.path, "temp_data/rivers_all4.Rdata"))
+	rm(list = ls())
+	
\ No newline at end of file
diff --git a/github_calculation/02.4_get_max_flow_length.R b/github_calculation/02.4_get_max_flow_length.R
new file mode 100644
index 0000000..c481c10
--- /dev/null
+++ b/github_calculation/02.4_get_max_flow_length.R
@@ -0,0 +1,135 @@
+######################
+# check how long the longest flow distance is to figure out how many time steps are needed.
+# author: david mennekes, PhD Student at Empa St. Gallen / ETH Zürich, Switzerland, david.mennekes@empa.ch, 
+# march 2021, last edit: 
+######################
+
+
+###############################
+#packages and path
+###############################
+
+library(tidyverse)
+library(sf)
+
+#path to sub-folders
+setwd("~/")
+main.path <- "PhD/mennekes/"
+# 
+
+
+###############################
+# load data
+###############################
+
+# # load river data
+load(paste0(main.path, "temp_data/rivers_all5.Rdata"))
+
+t <- st_drop_geometry(rivers.all5)
+test <- data.frame(flow_to = t$flow_to,
+									 len = 1,
+									 len_acc = 0,
+									 outflow = t$outflow,
+									 outflow_name = t$name_river,
+									 id_al = t$id_all)
+
+
+#
+ntest <- nrow(test)
+test <- rbind(test, c(ntest+1, 1,0,0, NA, ntest+1))
+tail(test)
+
+#alle outflows fließen in letzte Zeile
+test$flow_to[which(test$outflow==1)] <- ntest+1
+
+
+
+#run model once
+
+#find duplicated numbers
+dup <- unique(test$flow_to[duplicated(test$flow_to)])
+multi_flow_to <- test$flow_to %in% dup
+dup_id <- test$id_al[multi_flow_to]
+single_flow_to <- !(multi_flow_to)
+
+df_outflow <- data.frame(name = test$outflow_name[which(test$outflow == 1)],
+												 ids = test$id_al[which(test$outflow == T)],
+												 len0 = 0)
+
+rm(rivers.all5)
+rm(t)
+
+rr <- sample(1:ntest, size = 500)
+N = 2500
+rr_df <- as.data.frame(matrix(NA, nrow = N, ncol = length(rr)))
+rr_df <- cbind(1:N, rr_df)
+names(rr_df) <- c("ts", as.character(rr))
+P = c(1, seq(0,N, by=100), N)
+	for (i in 1:N) {
+		# create empty container for data
+		temp <- rep(0, nrow(test))
+		
+		
+		
+		
+		
+		########## for loop ################
+		#if one river flows into the next one
+		temp[test$flow_to[single_flow_to]] <- rowSums(test[single_flow_to, c("len", "len_acc")], na.rm = T) 
+		
+		# if two rivers flow into one
+		# check for the longest river -> the highest number are given by the ongest river
+		temp_dup <- test[dup_id, ] %>% group_by(flow_to) %>% summarise(l_len_acc = max(len_acc))
+		
+		
+		temp[temp_dup$flow_to] <- temp_dup$l_len_acc+1 #use the longer river as input data (= the higher number)
+		
+		
+		# write temp data to new
+		test$len_acc <- temp
+		
+		#write data df_outflow 
+		
+		df_outflow <- cbind(df_outflow, temp[df_outflow$ids])
+		names(df_outflow)[i+3] <- paste0("len", i)
+		
+		#random sections:
+		rr_df[i, 2:I(length(rr)+1)] <- temp[rr]
+		
+		if(sum(df_outflow[ ,"len0"] == df_outflow[ , paste0("len", i)]) == nrow(df_outflow)){ #break bedingungen
+			print("fertig")
+			break
+		}
+		if(i %in% P){
+			print(paste0(Sys.time(), "; round: ", i))
+		}
+		
+	}
+
+
+results <- data.frame(ts = 1:N,
+											Inn = as.numeric(df_outflow[6, 4:I(N+3)]),
+											Rhone = as.numeric(df_outflow[10, 4:I(N+3)]),
+											"Le Doubs" = as.numeric(df_outflow[9, 4:I(N+3)]),
+											Rhein = as.numeric(df_outflow[7, 4:I(N+3)]),
+											unknown = as.numeric(df_outflow[11, 4:I(N+3)]))
+summary(results)
+library(reshape2)
+library(ggplot2)
+results2 <- melt(results, id.vars = "ts")
+head(results2)
+
+p1 <- ggplot(results2, aes(x = ts, y = value, color = variable))+
+	geom_line()+
+	theme_bw()
+
+p1
+
+
+#add random numbers
+rr_df2 <- melt(rr_df, id.vars = "ts")
+
+p1 + geom_line(data = rr_df2, aes(ts, value, color = variable), color = "grey50", alpha = 0.5)
+
+ rm(list = ls())	
+
diff --git a/github_calculation/02.5_contamination_ms.R b/github_calculation/02.5_contamination_ms.R
new file mode 100644
index 0000000..cd837bf
--- /dev/null
+++ b/github_calculation/02.5_contamination_ms.R
@@ -0,0 +1,107 @@
+############
+# add flow velocity and change concentration to m/s
+# author: david mennekes, david.mennekes@empa.ch; 
+# Januar 2022
+############
+
+
+
+# library
+library(sf)
+
+#path to sub-folders
+setwd("~/")
+main.path <- "PhD/mennekes/"
+load(paste0(main.path, "temp_data/rivers_all4.Rdata"))
+polymers <- c("LDPE", "HDPE", "PP", "PS", "EPS", "PVC", "PET")
+
+
+# 
+rivers.all5 <- rivers.all4
+
+rm(rivers.all4)
+
+rivers.all5$outflow[is.na(rivers.all5$outflow)] <- 0
+
+# length
+rivers.all5$length_m	<- as.numeric(st_length(rivers.all5))
+
+# set everything == 1 for lakes and outflows
+rivers.all5$length_m[rivers.all5$isLake == T] <- 1
+rivers.all5$length_m[rivers.all5$outflow != 0] <- 1
+
+rivers.all5$flow_velocity[rivers.all5$isLake == T] <- 1
+rivers.all5$flow_velocity[rivers.all5$outflow != 0] <- 1
+
+rivers.all5$flow_velocity_type[rivers.all5$isLake == T] <- "other"
+rivers.all5$flow_velocity_type[rivers.all5$outflow != 0] <- "other"
+
+
+# transform data
+cols <- which(grepl("sum_", names(rivers.all5))) #find important columns for transformation
+rows <- which(rivers.all5$isLake == F & rivers.all5$outflow == 0)
+
+rivers.all5$length_seconds <- rivers.all5$length_m/rivers.all5$flow_velocity # this factor can be used for multiply the concMSV (see below) and get masses per section
+
+# contamination is in kg/km per year for rivers using Shape_length
+# contamination is in kg/ha per year for lakes using Shape_area
+
+
+#for rivers. change to contamination in g/m per second and multiplied with the velocity. Means it shows how much plastics will be passed on per second
+for (i in 1:length(cols)) {
+	a <- st_drop_geometry(rivers.all5[ , cols[i]])
+	n <- paste0(names(rivers.all5)[cols[i]], "_concMSV") #is per velocity
+	rivers.all5[ , n] <-  a # make new column
+	rivers.all5[rows, n] <- a[ rows, 1]/(365*24*60*60)*rivers.all5$length_m[rows] #change from year to seconds /(365*24*60*60). The input is per km. here we assume that the all input will enter the segment just at the most upstream point at of the segment (a simplification). Thus, the input is multiplied by the river lengths. one should use the river lengths in km! because the input is per km. However, from per km to per m  = (/1000) but change from kg to g (*1000) -> no change; ange to total load per second assuming that the input and output per second is an equilibrium for each segment
+	print(i)
+}
+
+
+#####
+#for lakes, caution! here no flow velocity change!!!!
+
+#rows with lakes
+rows_lake <- which(rivers.all5$isLake == T)
+
+for (i in 1:length(cols)) {
+	a <- st_drop_geometry(rivers.all5[ , cols[i]])
+	n <- paste0(names(rivers.all5)[cols[i]], "_concMSV")
+	area_ha <- rivers.all5$area[rows_lake] / 10000 #change area of lakes in ha (contamination is in kg/ha)
+	c_total <- a[ rows_lake, 1]* area_ha * 1000 # from kg / ha to g...  *1000, *area in ha... gives total contamination
+	rivers.all5[rows_lake, n] <- (c_total / (365*24*60*60)) #change to input per second
+	print(i)
+}
+
+#fill NAs with 0 concentration, all rivers that are underground...
+for (i in 1:length(cols)) {
+	na <- which(is.na(rivers.all5[ , cols[i]]))
+	n <- paste0(names(rivers.all5)[cols[i]], "_concMSV")
+	rivers.all5[na, n] <- 0
+}
+
+
+# for lakes change concentration to 0 only not for the first element per lake. otherwise lake concentration will overestimated when considering each section.
+
+id_lakes <- unique(rivers.all5$FID_poly_s)[-is.na(unique(rivers.all5$FID_poly_s))] # numbers without "river" in lake are missing, without NA
+
+cols_msv <- grep("_concMSV", names(rivers.all5))# find all columns with MSV contamination. For lakes this is total load in g per s
+
+for (i in 1 : length(id_lakes)){
+	rivers.i <- which(rivers.all5$FID_poly_s == id_lakes[i]) #per lake ID. which "river" section.
+	if(length(rivers.i) == 1){ #if only one "river" section exists, go to next lake ID
+		next
+	}	
+	rivers.all5[rivers.i[2:length(rivers.i)], cols_msv] <- 0 #if more than one section exists that make all
+}
+
+
+#mark the 15 biggest lakes
+rivers.all5$lake15 <- F
+lakes_areas <- sort(unique(rivers.all5$area), decreasing = T)
+rivers.all5$lake15[which(rivers.all5$area>lakes_areas[16])] <- T
+
+#create concentrations
+
+save(rivers.all5, file = paste0(main.path, "temp_data/rivers_all5.Rdata"))
+# st_write(rivers.all5, paste0(main.path, "temp_data/rivers_all5.gpkg"), append = F)
+rm(list = ls())	
diff --git a/github_calculation/02.5b_extra_data_for_factors.R b/github_calculation/02.5b_extra_data_for_factors.R
new file mode 100644
index 0000000..9db7e51
--- /dev/null
+++ b/github_calculation/02.5b_extra_data_for_factors.R
@@ -0,0 +1,227 @@
+#########################
+# Information
+#
+#This script is used to gether further information for the macroplastic modelling. This includes:
+# dam possition on rivers
+# calculating the sinocity (be calculating distances of two points and the lengths of the river segments)
+# landuse (using data by swisstopo)
+# discharge was added beforehand. but will be needed for calculation too
+# August 2023, david mennekes
+#########
+
+#packages
+	library(sf)
+	library(dplyr)
+	library(readr)
+	library(tidyverse)
+
+
+	#path
+	main.path <- "PhD/mennekes2.0/"
+	
+	
+	
+	#load the data with all the input emission (check modelling of Microplastics )
+	load(paste0(main.path, "temp_data/rivers_all5.Rdata"))#data with rivers
+
+	#load data with further information about weirs/dams
+	dam_position <- st_read("PhD/data/karten/stauanlagen-bundesaufsicht/Dam.shp") #not freely available, data of dams by swisstopo
+	dam_type <- st_drop_geometry(st_read("PhD/data/karten/stauanlagen-bundesaufsicht/DamTypeCatalogue.shp")) #contains information about dam type
+	
+	dam_facility <- st_drop_geometry(st_read("PhD/data/karten/stauanlagen-bundesaufsicht/Facility.shp")) #futher information of aim of the dam
+	dam_facility_type <- st_drop_geometry(st_read("PhD/data/karten/stauanlagen-bundesaufsicht/FacilityAimCatalogue.shp")) #catalogue data for dam facilities
+
+	
+	
+	
+	
+	
+	#step 01 -> join information of dams
+	dam2 <- merge(dam_position, dam_type, by.x = "DamType", by.y = "ID", all.x = T) #get dam type information
+	fac2 <- merge(dam_facility, dam_facility_type, by.x = "Aim", by.y = "ID", all.x = T) %>% select("xtf_id", "DE", "EN") #merge information of usage
+	dam3 <- merge(dam2, fac2, by.x = "facilityR2", by.y = "xtf_id", all.x = T) %>% select("ConstYear", "DamName", "DamHeight", "DE.x", "EN.x", "DE.y", "EN.y")
+
+	rm(fac2, dam2, dam_facility, dam_facility_type, dam_position, dam_type)
+	
+	#step 02 -> join information of dams to river network
+	rivers.nrst <- rivers.all5[rivers.all5$isLake==F, ]
+	nf <- st_nearest_feature(dam3, rivers.nrst) #find nearst river segment
+	nrst <- rivers.nrst$id_all[nf] #get id all of this segment
+	rm(nf, rivers.nrst)
+	
+	dst <- as.numeric(st_distance(dam3, rivers.all5[nrst, ], by_element = T)) #measure distance between segment and dam
+	dst
+	nrst_100m <- nrst[dst<100] #select only dams that are in 100m distance to a river segment. other dams might not be related to a river segment
+	dam4 <- dam3[dst<100, ]
+	
+	# create new rows for rivers.all5
+	
+	rivers.all5$isDam <- F
+	rivers.all5$isDam[nrst_100m] <- T
+
+	rivers.all5$DamType <- NA	
+	rivers.all5$DamType[nrst_100m] <- dam4$EN.y
+	
+	
+	
+	#step 02 -> meandering factor (direct length between first and last point divided by segment length)
+	mf <- rivers.all5 %>% select(id_all, geometry)
+	mf$length <- as.numeric(st_length(rivers.all5))
+	mf$first <- st_line_sample(rivers.all5, sample = 0) #get first point of each line feature
+	mf$last <- st_line_sample(rivers.all5, sample = 1)	#get last point of each line feature
+	mf$dist_firstlast <- as.numeric(st_distance(mf$first, mf$last, by_element = T)) #distance between first and last point
+	mf$meander_factor <- mf$length/mf$dist_firstlast #the meandering factor is represented by (real length of river segment) / (theoretical shortest possible lengths)
+
+	hist(mf$meander_factor)	
+	sum(mf$meander_factor>1.5)
+	mf$meander_factor[rivers.all5$isLake] <- NA #no meandering factors for lakes
+	mf$meander_factor[rivers.all5$outflow != 0] <- NA #no meandering factor for outflow containers
+	
+	# plot(1:nrow(mf), log10(sort(mf$meander_factor)))
+	# plot(mf$length, mf$meander_factor, xlim = c(0,10000))
+	
+	rivers.all5$meandering_factor <- mf$meander_factor
+
+	rm(mf)	
+	rm(nrst, nrst_100m, dst, dam3, dam4)
+	
+	
+	
+	#step 03 -> land use / cover next to the rivers
+	#load data
+
+	landuse_buffer_10m <- read_delim(paste0(main.path,"data_raw/land use/landuse_buffer_10m.txt"), 
+			delim = ";", escape_double = FALSE, trim_ws = TRUE, locale = locale(decimal_mark = ",", grouping_mark = "."))
+	
+	landuse_buffer_100m <- read_delim(paste0(main.path,"data_raw/land use/landuse_buffer_100m.txt"), 
+																		delim = ";", escape_double = FALSE, trim_ws = TRUE, locale = locale(decimal_mark = ",", grouping_mark = "."))
+	
+	landuse_buffer_200m <- read_delim(paste0(main.path,"data_raw/land use/landuse_buffer_200m.txt"), 
+																	 delim = ";", escape_double = FALSE, trim_ws = TRUE, locale = locale(decimal_mark = ",", grouping_mark = "."))
+		
+	#change format to wide format
+	landuse10 <- spread(landuse_buffer_10m[ , c("id_all_geo", "land_cover", "geom_Area")], land_cover, geom_Area) %>% select(-"<NA>")
+	landuse10$agriculture[is.na(landuse10$agriculture)] <- 0 #fill NA with 0
+	landuse10$forest[is.na(landuse10$forest)] <- 0
+	landuse10$glacier[is.na(landuse10$glacier)] <- 0
+	landuse10$rocks[is.na(landuse10$rocks)] <- 0
+	landuse10$unknown[is.na(landuse10$unknown)] <- 0
+	landuse10$urban[is.na(landuse10$urban)] <- 0
+	landuse10$water[is.na(landuse10$water)] <- 0
+	
+	sum(duplicated(landuse10$id_all_geo)) #control -> should be 0
+	
+	landuse100 <- spread(landuse_buffer_100m[ , c("id_all_geo", "land_cover", "geom_Area")], land_cover, geom_Area) %>% select(-"<NA>")
+	
+	landuse100$agriculture[is.na(landuse100$agriculture)] <- 0 #fill NA with 0
+	landuse100$forest[is.na(landuse100$forest)] <- 0
+	landuse100$glacier[is.na(landuse100$glacier)] <- 0
+	landuse100$rocks[is.na(landuse100$rocks)] <- 0
+	landuse100$unknown[is.na(landuse100$unknown)] <- 0
+	landuse100$urban[is.na(landuse100$urban)] <- 0
+	landuse100$water[is.na(landuse100$water)] <- 0
+
+	landuse200 <- spread(landuse_buffer_200m[ , c("id_all_geo", "land_cover", "geom_Area")], land_cover, geom_Area) %>% select(-"<NA>")	
+	
+	landuse200$agriculture[is.na(landuse200$agriculture)] <- 0 #fill NA with 0
+	landuse200$forest[is.na(landuse200$forest)] <- 0
+	landuse200$glacier[is.na(landuse200$glacier)] <- 0
+	landuse200$rocks[is.na(landuse200$rocks)] <- 0
+	landuse200$unknown[is.na(landuse200$unknown)] <- 0
+	landuse200$urban[is.na(landuse200$urban)] <- 0
+	landuse200$water[is.na(landuse200$water)] <- 0
+
+	rm(landuse_buffer_10m, landuse_buffer_100m, landuse_buffer_200m)	
+
+	
+	#add column with total area and find distribution among land cover -> 0:1
+	names(landuse10)
+	landuse10$total_area <- rowSums(landuse10[ , 2:8], na.rm = T)
+	landuse10[ ,2:8] <- landuse10[2:8]/landuse10$total_area
+	
+	landuse100$total_area <- rowSums(landuse100[ , 2:8], na.rm = T)
+	landuse100[ ,2:8] <- landuse100[2:8]/landuse100$total_area
+	
+	landuse200$total_area <- rowSums(landuse200[ , 2:8], na.rm = T)
+	landuse200[ ,2:8] <- landuse200[2:8]/landuse200$total_area
+	
+	
+	
+	#if more than 50% of landuse is water change
+	 #final landuse (for rivers) / attention, some rivers are missing information because they are located outside of Switzerland, here "unknown" = 1 was assumed
+	
+	use_10m <- which(landuse10$water <= 0.5) #use only rows where water is less than 50%
+	ids_10 <- landuse10$id_all_geo[use_10m]
+	use_100m <- which(landuse100$water <= 0.5) #which landuse is smaler/ equal 50% water where 10m buffer was more than 50
+	use_100m <- use_100m[!(landuse100$id_all_geo[use_100m] %in% ids_10)] #filter ids that are not in ids_10
+	
+	
+	
+	#make final dataset
+	
+	landuse_final <- landuse10[use_10m, ] #final version first 10m
+	landuse_final <- rbind(landuse_final, landuse100[use_100m, ])
+	w <- which(!(landuse200$id_all_geo %in% landuse_final$id_all_geo)) #which ids from the buffer 200 are not in the final version, yet
+	landuse_final <- rbind(landuse_final, landuse200[w, ])
+	
+	#check for duplicated id
+	sum(duplicated(landuse_final$id_all_geo))
+	
+	
+	
+	
+	#add information to rivers.all5
+	rivers.all5[, names(landuse_final[2:8])] <- 0
+	rivers.all5[landuse_final$id_all_geo, names(landuse_final[2:8])] <- landuse_final[ , names(landuse_final[2:8])]
+
+	
+	####################
+	#step04 -> landuse for lakes	
+	landuse_lake <- read_delim(paste0(main.path, "data_raw/land use/landuse_lakes_100m.txt"), 
+																	 delim = ";", escape_double = FALSE, trim_ws = TRUE, locale = locale(decimal_mark = ",", grouping_mark = "."))
+	
+	landuse_lake <- spread(landuse_lake[ , c("FID_poly_s", "land_cover", "Shape_Area")], land_cover, Shape_Area) %>% select(-water) #take out water because no further information...
+
+	#change NA to 0
+	landuse_lake$agriculture[is.na(landuse_lake$agriculture)]<-0
+	landuse_lake$forest[is.na(landuse_lake$forest)]<-0
+	landuse_lake$glacier[is.na(landuse_lake$glacier)]<-0
+	landuse_lake$rocks[is.na(landuse_lake$rocks)]<-0
+	landuse_lake$unknown[is.na(landuse_lake$unknown)]<-0
+	landuse_lake$urban[is.na(landuse_lake$urban)]<-0
+
+	landuse_lake$total_area <- rowSums(landuse_lake[ , 2:7])	#total area
+	landuse_lake[ , 2:7] <- landuse_lake[ , 2:7] / landuse_lake$total_area
+
+	sum(duplicated(landuse_lake$FID_poly_s)) #check for duplicated ids
+	
+	#join data to rivers.all5
+	m <- merge(rivers.all5[ ,c("id_all", "FID_poly_s")], landuse_lake, by = "FID_poly_s") #merge by FID_poly_s to find id_all
+	
+	rivers.all5[m$id_all, names(landuse_lake[, 2:7])] <- st_drop_geometry(m[ ,names(landuse_lake[, 2:7])])
+	
+	
+	
+	#check for NA in factor data
+	rivers.all5$forest[is.na(rivers.all5$forest)] <- 0
+	rivers.all5$agriculture[is.na(rivers.all5$agriculture)] <- 0
+	rivers.all5$rocks[is.na(rivers.all5$rocks)] <- 0
+	rivers.all5$unknown[is.na(rivers.all5$unknown)] <- 0
+	rivers.all5$urban[is.na(rivers.all5$urban)] <- 0
+	rivers.all5$water[is.na(rivers.all5$water)] <- 0
+	rivers.all5$glacier[is.na(rivers.all5$glacier)] <- 0
+	
+	#find rows which are not summing up to 1
+	rSums <- rowSums(st_drop_geometry(rivers.all5[ , c("forest", "agriculture", "rocks", "unknown", "urban", "water", "glacier")]))
+	falls.rsums <- which(rSums <0.99 | rSums > 1.01) #small tolorance
+	rivers.all5[ falls.rsums,c("forest", "agriculture", "rocks", "unknown", "urban", "water", "glacier")] <- NA
+	
+	rivers.all5$meandering_factor[is.na(rivers.all5$meandering_factor)] <- 0
+	
+	rivers.all5$discharge[is.na(rivers.all5$discharge)] <- 0.00001
+	
+
+	#save final data
+	save(rivers.all5, file = paste0(main.path, "temp_data/rivers_all5_2.Rdata"))
+	rm(list = ls())
+	
\ No newline at end of file
diff --git a/github_calculation/02.6_factors_lakes_MaP.R b/github_calculation/02.6_factors_lakes_MaP.R
new file mode 100644
index 0000000..9096a69
--- /dev/null
+++ b/github_calculation/02.6_factors_lakes_MaP.R
@@ -0,0 +1,41 @@
+###################
+# this script is used to determine sedimentation curves for the lakes. We aimed for a about 80% removal rate for the lake Geneva (500km2) in average based on existing measurements (see paper)
+##sedimentation curve lakes
+#######################
+
+library(ggplot2)
+library(zoo)
+flache <- seq(1,800000000, by = 10000) #Area of lakes
+#area in m2
+
+
+lakeGeneva <- 0.95*(1- exp(1)^(-0.005*flache*0.000001)) #lake Geneva
+y <- 0.95*(1- exp(1)^(-0.004*flache*0.000001))
+y_schwer <- 0.95*(1- exp(1)^(-0.012*flache*0.000001)) #heavier polymers. triple the reduction
+y_sehrleicht <- 0.95*(1- exp(1)^(-0.0025*flache*0.000001)) #very light polymers
+x <- flache * 0.000001					
+total <- (y+y+y+y*0.6+y*0.8+y_schwer+y_schwer)/7
+
+
+ggplot()+
+	theme_bw()+
+	geom_line(data = data.frame(x = x, y = y*100), aes(x,y, color = "LDPE, HDPE, PS"))+
+	geom_line(data = data.frame(x = x, y = lakeGeneva*100), aes(x,y, color = "lakeGeneva"), linetype = "dashed")+
+	geom_line(data = data.frame(x = x, y = 0.5*y*100), aes(x,y, color = "EPS"))+
+	geom_line(data = data.frame(x = x, y = 0.75*y*100), aes(x,y, color = "PP aktuell"))+
+	geom_line(data = data.frame(x = x, y = y_schwer *100), aes(x,y, color = "heavy"))+
+	geom_hline(yintercept = 95, linetype = "dashed")
+	
+	
+#check for the integral
+AUC <- function(x, y){
+	sum(diff(x)*rollmean(y,2))
+}
+
+n <- AUC(flache, y) #normal
+s <- AUC(flache, y_schwer)
+sl <- AUC(flache, y*0.5)
+l <- AUC(flache, y*0.75)
+AUC(flache,y)
+
+mean(c(n,n,n,s,s,sl,l))
diff --git a/github_calculation/02.6_factors_rivers_MaP.R b/github_calculation/02.6_factors_rivers_MaP.R
new file mode 100644
index 0000000..f7fd1eb
--- /dev/null
+++ b/github_calculation/02.6_factors_rivers_MaP.R
@@ -0,0 +1,116 @@
+#derive factors for losses
+
+# take three approaches: low retention, mid retention and high retention
+main.path <- "PhD/mennekes2.0/"
+#
+
+library(ggplot2)
+library(dplyr)
+library(tidyverse)
+library(cowplot)
+library(sf)
+library(reshape2)
+
+
+#make data frame as simple river
+
+d <- data.frame(L_steps = rep(1000, 100), #in m -> each step is 1000m = 1km
+								flow_velocity = 1, #in m/s
+								high = 0,
+								mid = 0,
+								low = 0)
+
+
+
+#Factors for Landuse: use low, middle and high factors which will be attributed to different landuses
+
+#high
+v_high <- 0.00012
+(1- exp(1)^(-v_high*(25000))) #should be after 25000 steps about 5% == 0.95
+fun_high <- function(x){(1- exp(1)^(-v_high*x))}
+fac_high <- fun_high(1)
+
+
+
+#mid
+v_mid <- 0.00006
+(1- exp(1)^(-v_mid*(50000))) #should be after 50000 steps about 5%
+fun_mid <- function(x){(1- exp(1)^(-v_mid*x))}
+fac_mid <- fun_mid(1)
+
+#low
+v_low <- 0.00003
+(1- exp(1)^(-v_low*(100000)))#should be after 100000 steps about 5%
+fun_low <- function(x){(1- exp(1)^(-v_low*x))}
+fac_low <- fun_low(1)
+
+
+#list with all factors
+fac_list <- list(fac_low, fac_mid, fac_high)
+polymers <- c("low", "mid", "high")
+
+
+#demonstrate the values
+#loop per polymer
+for (i in 1:length(polymers)) {
+	polymer <- polymers[i]
+	d[1, polymer] <- 1
+	d[ , paste0(polymer, "_actual_pol")] <- 0
+	d$length_s = (d$L_steps)/d$flow_velocity
+	
+
+	
+	d$factor <- 1*(1-fac_list[[i]])^d$length_s #einbauen in negative Zinsfunktion 1(1-factor(1. Zeitschrit))^lengths in s
+	#for loop as calculation
+	act <- paste0(polymer, "_actual_pol")
+	for (j in 1:nrow(d)) {
+		d[2:nrow(d), act] <- ((d[1:I(nrow(d)-1), act] + d[1:I(nrow(d)-1), polymer]) * d$factor[1:I(nrow(d)-1)])
+	}
+	d[1, act]<-1
+
+}
+
+d
+d_p <- d[ , paste0(polymers, "_actual_pol")]
+names(d_p) <- polymers
+d_p$L <- c(0, cumsum(d$L_steps[1:I(nrow(d)-1)]))
+
+d_p2 <- melt(d_p, id.vars = "L")
+names(d_p2) <- c("L", "category", "value")
+
+nice <- theme_bw()+
+	theme(legend.background = element_rect(fill = "transparent", color = NA),
+				plot.background = element_rect(fill = "transparent",colour = NA),
+				text = element_text(color = "black"),
+				panel.grid = element_blank(),
+				axis.text.x = element_text(color = "black", face = "plain", size = 10),
+				axis.text.y = element_text(color = "black", face = "plain", size = 11),
+				panel.background = element_rect(fill = "transparent")) #trbl
+
+
+p1 <- ggplot(d_p2, aes(x = L/1000, y = value*100, color = category, linetype = category))+
+	nice+
+	labs(x = "river lengths in time steps (v = 1m/s)",
+			y = "MaP in suspension\nin relation to start value [%]")+
+	geom_vline(xintercept = 25)+
+	geom_vline(xintercept = 50)+
+	geom_vline(xintercept = 100)+
+	geom_hline(yintercept = 5, linetype = "dashed")+
+	scale_y_continuous(expand = c(0,0))+
+	scale_x_continuous(expand = c(0,0))+
+	geom_line()
+	
+
+p1
+ggsave(paste0(main.path, "output_files/plots/plot_factor_river_MaP.png"), plot = p1, width = 12, height = 8, units = "cm", bg = "transparent", dpi = 500)
+
+fac_rivers <- c(fac_low, fac_mid, fac_high)
+names(fac_rivers) <- polymers
+save(fac_rivers, file = paste0(main.path, "temp_data/factor_rivers_MaP.Rdata"))
+
+
+
+
+
+
+# rm(list = ls())
diff --git a/github_calculation/02.8_factors_MaP.R b/github_calculation/02.8_factors_MaP.R
new file mode 100644
index 0000000..1c64e4b
--- /dev/null
+++ b/github_calculation/02.8_factors_MaP.R
@@ -0,0 +1,3088 @@
+#######
+# add accumulation and removal factors to the data set. Partly factors are calculated here
+# calculation of scenarios described in the manuscript. the names of the scenario are written as header
+
+# author: david mennekes,  david.mennekes@empa.ch
+# march 2022
+#################
+
+
+
+
+###############################
+
+
+#packages and path
+#packages and path
+###############################
+
+	library(tidyverse)
+	library(sf)
+	
+###################################################################
+	#path to sub-folders
+	setwd("~/")
+	main.path <- "PhD/mennekes2.0/"
+	# 
+	# 
+	#polymers
+	polymers <- c("LDPE", "HDPE", "PP", "PS", "EPS", "PVC", "PET")
+	
+###############################
+	# scenario base ####
+###############################
+
+###############################
+# load data
+###############################
+
+	# # load river data
+	load(paste0(main.path, "temp_data/rivers_all5_2.Rdata"))
+	rivers.all6 <- rivers.all5
+	rm(rivers.all5)
+	
+	#load factors for river
+	load(paste0(main.path, "temp_data/factor_rivers_MaP.Rdata")) #high middle low
+
+	fac_rivers["zero"] <- 0 #add a value for no change
+	
+	
+
+
+#############
+# define factors
+#############
+	
+	
+	# add all data to rivers.calc
+	
+	for (i in polymers) {
+		a <- as.data.frame(matrix(0, nrow = nrow(rivers.all6), ncol = 5))
+		names(a) <- c(paste0("sed.fac_", i, "_MaP"), 
+									paste0("removal.fac_", i, "_MaP"),
+									paste0("acc.fac_", i, "_MaP"),
+									paste0("clean.fac_", i, "_MaP"),
+									paste0("resus.fac_", i, "_MaP"))
+		
+		rivers.all6 <- cbind(rivers.all6, a)
+		rm(a)
+	}
+	
+	c.names <- names(rivers.all6)
+	r.rivers <- which(rivers.all6$isLake==F & rivers.all6$outflow == 0)	
+	
+	##### removal #####
+	c.removal <- grep("removal.fac_", c.names)
+	rivers.all6[rivers.all6$isDam==T, c.removal] <- 0.75000000000000001 #for all dams assume a removal rate of 75% accross all polymers
+	
+	
+	
+	##### sedimentation######
+	#------------------#
+	
+	c.sed <- grep("sed.fac_", c.names) #columns with name sedimentation
+	
+	
+	### rivers ###
+	#create dataframe to calculate factor
+	df01 <- st_drop_geometry(rivers.all6 %>% select(id_all,discharge, isLake, isDam, forest, rocks, unknown, urban, agriculture, glacier, water, meandering_factor))
+	
+	
+	# for rivers ###
+	#create factors for each category for sedimentation: landuse, sinuosity, discharge
+	
+	df01$fac_sed_landuse <- 0
+	df01$fac_sed_sinuosity <- 0
+	df01$fac_sed_discharge <- 0
+	
+	# for landuse:
+	#apply the landuse factors high, middle, low according to the groupping of landuse
+	# forest, agriculture -> high
+	# rocks, unknown (grassland) -> mid
+	# urban -> low
+	# water, glacier -> zero (=0)
+	
+	df01$fac_sed_landuse <- df01$forest*fac_rivers["high"]+df01$agriculture*fac_rivers["high"]+
+		df01$rocks*fac_rivers["mid"]+df01$unknown*fac_rivers["mid"]+
+		df01$urban*fac_rivers["low"]+
+		df01$water*fac_rivers["zero"]+df01$glacier*fac_rivers["zero"]
+	df01$fac_sed_landuse[is.na(df01$fac_sed_landuse)] <- fac_rivers["zero"] #replace NA with zero value
+	
+	# for discharge
+	# 1.) find theoretical max distance dmax
+	# case different equation for discharge below = 0.3 and over 0.3
+	df01$dmax[df01$discharge<= 0.3] <- 3333*df01$discharge[df01$discharge<= 0.3] #for discharge <= 0.3
+	df01$dmax[df01$discharge> 0.3] <- 330*df01$discharge[df01$discharge> 0.3]+901 #for discharge >0.3
+	
+	#2. use dmax to calculate factor x in the for one step (x = log(0.05)/ dmax)
+	df01$x <- -(log(0.05) / df01$dmax)
+	
+	#3.) find fac for 1 time step -> f(x) = 1-exp(1)^(-x * 1)
+	df01$fac_sed_discharge <- 1-exp(1)^(-df01$x*1)
+	
+	
+	# for sinuosity
+	# apply equation based on Newbould 2021
+	df01$fac_sed_sinuosity <- (1-(1/(df01$meandering_factor)^0.3))*0.1
+	
+	
+	
+	#use df01 for rivers in river.all6 data
+	df01$sum <- 1-(1-df01$fac_sed_landuse)*(1-df01$fac_sed_discharge)*(1-df01$fac_sed_sinuosity)
+	# summary(df01)
+	
+	# bring numbers to rivers.all6 and apply neg. compound interest eq.
+	#for rivers only!
+	rivers.all6[r.rivers, c.sed] <- ((1 - df01$sum[r.rivers])^rivers.all6$length_m[r.rivers])
+
+	
+		
+	### lakes ###
+	r.lakes <- which(rivers.all6$isLake == T)
+
+	rivers.all6[r.lakes, c.sed] <- 0.95000000000000001 #lakes = 95%
+	
+	
+	#5% min water contamination (max sed = 0.95000000000000001)
+	for (i in c.sed) {
+		over95 <- which(st_drop_geometry(rivers.all6[ , i]) > 0.95000000000000001)
+		if(length(over95) > 0){
+			rivers.all6[over95, i] <- 0.95000000000000001
+		}
+		
+	}
+	
+	
+	##### cleaning####
+	c.clean <- grep("clean.fac_", c.names)
+	rivers.all6[ , c.clean] <- 0.20000000000000001
+	
+	
+	#### resus ##
+	c.resus <- grep("resus.fac_", c.names)
+	rivers.all6[r.rivers, c.resus] <- 0.20000000000000001 #for all rivers 20%
+	rivers.all6[r.lakes, c.resus] <- 0 #for all lakes 0%; is included in sedimentation
+	
+	
+	
+	#### accumulation ###
+	c.acc <- grep("acc.fac_", c.names)
+	# rivers.all6[rivers.all6$outflow==0,c.acc] <- 1- st_drop_geometry(rivers.all6[rivers.all6$outflow==0,c.clean]) - st_drop_geometry(rivers.all6[rivers.all6$outflow==0,c.resus]) # the rest will be accumulation, causes problems of rounding
+	rivers.all6[rivers.all6$outflow==0,c.acc] <- 1 #can be as high as 1 means that the entire rest will be accumulated.
+	
+	#warning if sed. factors are 1 or higher
+	if(length(which(rivers.all6$sed.fac_PET_MaP >= 1)) >=1){
+		warning("sedimentation factors are 1 or higher!")
+		break
+	}
+	
+	
+	#safe file####
+	extra_name <- "base"
+	c.numeric <- names(select_if(st_drop_geometry(rivers.all6), is.numeric))
+	rivers.all6[ ,c.numeric] <- round(st_drop_geometry(rivers.all6[ , c.numeric]), digits = 10) #round numbers to avoid problems
+	save(rivers.all6,extra_name, file = paste0(main.path, "temp_data/rivers_all6_", extra_name, ".Rdata"))
+			
+			
+
+	rm(list = ls())	
+	
+	
+	#path to sub-folders
+	setwd("~/")
+	main.path <- "PhD/mennekes2.0/"
+	# 
+	# 
+	#polymers
+	polymers <- c("LDPE", "HDPE", "PP", "PS", "EPS", "PVC", "PET")
+	
+	###############################
+	# scenario null		####
+	###############################
+	
+	###############################
+	# load data
+	###############################
+	
+	# # load river data
+	load(paste0(main.path, "temp_data/rivers_all5_2.Rdata"))
+	rivers.all6 <- rivers.all5
+	rm(rivers.all5)
+	
+	#load factors for river
+	load(paste0(main.path, "temp_data/factor_rivers_MaP.Rdata")) #high middle low
+	
+	fac_rivers["zero"] <- 0 #add a value for no change
+	
+	
+	
+	
+	#############
+	# define factors
+	#############
+	
+	
+	# add all data to rivers.calc
+	
+	for (i in polymers) {
+		a <- as.data.frame(matrix(0, nrow = nrow(rivers.all6), ncol = 5))
+		names(a) <- c(paste0("sed.fac_", i, "_MaP"), 
+									paste0("removal.fac_", i, "_MaP"),
+									paste0("acc.fac_", i, "_MaP"),
+									paste0("clean.fac_", i, "_MaP"),
+									paste0("resus.fac_", i, "_MaP"))
+		
+		rivers.all6 <- cbind(rivers.all6, a)
+		rm(a)
+	}
+	
+	#warning if sed. factors are 1 or higher
+	if(length(which(rivers.all6$sed.fac_PET_MaP >= 1)) >=1){
+		warning("sedimentation factors are 1 or higher!")
+		break
+	}
+	
+	#safe file####
+	extra_name <- "null"
+	c.numeric <- names(select_if(st_drop_geometry(rivers.all6), is.numeric))
+	rivers.all6[ ,c.numeric] <- round(st_drop_geometry(rivers.all6[ , c.numeric]), digits = 10) #round numbers to avoid problems
+	save(rivers.all6,extra_name, file = paste0(main.path, "temp_data/rivers_all6_", extra_name, ".Rdata"))
+	
+	
+	
+	rm(list = ls())	
+	
+	
+	
+	#path to sub-folders
+	setwd("~/")
+	main.path <- "PhD/mennekes2.0/"
+	# 
+	# 
+	#polymers
+	polymers <- c("LDPE", "HDPE", "PP", "PS", "EPS", "PVC", "PET")
+	
+	###############################
+	# scenario weir05			####
+	###############################
+	
+	###############################
+	# load data
+	###############################
+	
+	# # load river data
+	load(paste0(main.path, "temp_data/rivers_all5_2.Rdata"))
+	rivers.all6 <- rivers.all5
+	rm(rivers.all5)
+	
+	#load factors for river
+	load(paste0(main.path, "temp_data/factor_rivers_MaP.Rdata")) #high middle low
+	
+	fac_rivers["zero"] <- 0 #add a value for no change
+	
+	
+	
+	
+	#############
+	# define factors
+	#############
+	
+	
+	# add all data to rivers.calc
+	
+	for (i in polymers) {
+		a <- as.data.frame(matrix(0, nrow = nrow(rivers.all6), ncol = 5))
+		names(a) <- c(paste0("sed.fac_", i, "_MaP"), 
+									paste0("removal.fac_", i, "_MaP"),
+									paste0("acc.fac_", i, "_MaP"),
+									paste0("clean.fac_", i, "_MaP"),
+									paste0("resus.fac_", i, "_MaP"))
+		
+		rivers.all6 <- cbind(rivers.all6, a)
+		rm(a)
+	}
+	
+	c.names <- names(rivers.all6)
+	r.rivers <- which(rivers.all6$isLake==F & rivers.all6$outflow == 0)	
+	
+	##### removal #####
+	c.removal <- grep("removal.fac_", c.names)
+	rivers.all6[rivers.all6$isDam==T, c.removal] <- 0.05000000000000001 #for all dams assume a removal rate of 75% accross all polymers
+	
+	#warning if sed. factors are 1 or higher
+	if(length(which(rivers.all6$sed.fac_PET_MaP >= 1)) >=1){
+		warning("sedimentation factors are 1 or higher!")
+		break
+	}
+	
+	
+	
+	#safe file####
+	extra_name <- "weir05"
+	c.numeric <- names(select_if(st_drop_geometry(rivers.all6), is.numeric))
+	rivers.all6[ ,c.numeric] <- round(st_drop_geometry(rivers.all6[ , c.numeric]), digits = 10) #round numbers to avoid problems
+	save(rivers.all6,extra_name, file = paste0(main.path, "temp_data/rivers_all6_", extra_name, ".Rdata"))
+	
+	
+	
+	rm(list = ls())	
+	
+	
+	
+	#path to sub-folders
+	setwd("~/")
+	main.path <- "PhD/mennekes2.0/"
+	# 
+	# 
+	#polymers
+	polymers <- c("LDPE", "HDPE", "PP", "PS", "EPS", "PVC", "PET")
+	
+	###############################
+	# scenario weir 25			####
+	###############################
+	
+	###############################
+	# load data
+	###############################
+	
+	# # load river data
+	load(paste0(main.path, "temp_data/rivers_all5_2.Rdata"))
+	rivers.all6 <- rivers.all5
+	rm(rivers.all5)
+	
+	#load factors for river
+	load(paste0(main.path, "temp_data/factor_rivers_MaP.Rdata")) #high middle low
+	
+	fac_rivers["zero"] <- 0 #add a value for no change
+	
+	
+	
+	
+	#############
+	# define factors
+	#############
+	
+	
+	# add all data to rivers.calc
+	
+	for (i in polymers) {
+		a <- as.data.frame(matrix(0, nrow = nrow(rivers.all6), ncol = 5))
+		names(a) <- c(paste0("sed.fac_", i, "_MaP"), 
+									paste0("removal.fac_", i, "_MaP"),
+									paste0("acc.fac_", i, "_MaP"),
+									paste0("clean.fac_", i, "_MaP"),
+									paste0("resus.fac_", i, "_MaP"))
+		
+		rivers.all6 <- cbind(rivers.all6, a)
+		rm(a)
+	}
+	
+	c.names <- names(rivers.all6)
+	r.rivers <- which(rivers.all6$isLake==F & rivers.all6$outflow == 0)	
+	
+	##### removal #####
+	c.removal <- grep("removal.fac_", c.names)
+	rivers.all6[rivers.all6$isDam==T, c.removal] <- 0.25000000000000001 #for all dams assume a removal rate of 75% accross all polymers
+	
+	#warning if sed. factors are 1 or higher
+	if(length(which(rivers.all6$sed.fac_PET_MaP >= 1)) >=1){
+		warning("sedimentation factors are 1 or higher!")
+		break
+	}
+	
+	
+	
+	#safe file####
+	extra_name <- "weir25"
+	c.numeric <- names(select_if(st_drop_geometry(rivers.all6), is.numeric))
+	rivers.all6[ ,c.numeric] <- round(st_drop_geometry(rivers.all6[ , c.numeric]), digits = 10) #round numbers to avoid problems
+	save(rivers.all6,extra_name, file = paste0(main.path, "temp_data/rivers_all6_", extra_name, ".Rdata"))
+	
+	
+	
+	rm(list = ls())	
+	
+	
+	#path to sub-folders
+	setwd("~/")
+	main.path <- "PhD/mennekes2.0/"
+	# 
+	# 
+	#polymers
+	polymers <- c("LDPE", "HDPE", "PP", "PS", "EPS", "PVC", "PET")
+	
+	###############################
+	# scenario weir 50			####
+	###############################
+	
+	###############################
+	# load data
+	###############################
+	
+	# # load river data
+	load(paste0(main.path, "temp_data/rivers_all5_2.Rdata"))
+	rivers.all6 <- rivers.all5
+	rm(rivers.all5)
+	
+	#load factors for river
+	load(paste0(main.path, "temp_data/factor_rivers_MaP.Rdata")) #high middle low
+	
+	fac_rivers["zero"] <- 0 #add a value for no change
+	
+	
+	
+	
+	#############
+	# define factors
+	#############
+	
+	
+	# add all data to rivers.calc
+	
+	for (i in polymers) {
+		a <- as.data.frame(matrix(0, nrow = nrow(rivers.all6), ncol = 5))
+		names(a) <- c(paste0("sed.fac_", i, "_MaP"), 
+									paste0("removal.fac_", i, "_MaP"),
+									paste0("acc.fac_", i, "_MaP"),
+									paste0("clean.fac_", i, "_MaP"),
+									paste0("resus.fac_", i, "_MaP"))
+		
+		rivers.all6 <- cbind(rivers.all6, a)
+		rm(a)
+	}
+	
+	c.names <- names(rivers.all6)
+	r.rivers <- which(rivers.all6$isLake==F & rivers.all6$outflow == 0)	
+	
+	##### removal #####
+	c.removal <- grep("removal.fac_", c.names)
+	rivers.all6[rivers.all6$isDam==T, c.removal] <- 0.50000000000000001 #for all dams assume a removal rate of 50% accross all polymers
+	
+	#warning if sed. factors are 1 or higher
+	if(length(which(rivers.all6$sed.fac_PET_MaP >= 1)) >=1){
+		warning("sedimentation factors are 1 or higher!")
+		break
+	}
+	
+	#safe file####
+	extra_name <- "weir50"
+	c.numeric <- names(select_if(st_drop_geometry(rivers.all6), is.numeric))
+	rivers.all6[ ,c.numeric] <- round(st_drop_geometry(rivers.all6[ , c.numeric]), digits = 10) #round numbers to avoid problems
+	save(rivers.all6,extra_name, file = paste0(main.path, "temp_data/rivers_all6_", extra_name, ".Rdata"))
+	
+	
+	
+	rm(list = ls())	
+	
+	
+	
+	
+	#path to sub-folders
+	setwd("~/")
+	main.path <- "PhD/mennekes2.0/"
+	# 
+	# 
+	#polymers
+	polymers <- c("LDPE", "HDPE", "PP", "PS", "EPS", "PVC", "PET")
+	
+	###############################
+	# scenario weir 75			####
+	###############################
+	
+	###############################
+	# load data
+	###############################
+	
+	# # load river data
+	load(paste0(main.path, "temp_data/rivers_all5_2.Rdata"))
+	rivers.all6 <- rivers.all5
+	rm(rivers.all5)
+	
+	#load factors for river
+	load(paste0(main.path, "temp_data/factor_rivers_MaP.Rdata")) #high middle low
+	
+	fac_rivers["zero"] <- 0 #add a value for no change
+	
+	
+	
+	
+	#############
+	# define factors
+	#############
+	
+	
+	# add all data to rivers.calc
+	
+	for (i in polymers) {
+		a <- as.data.frame(matrix(0, nrow = nrow(rivers.all6), ncol = 5))
+		names(a) <- c(paste0("sed.fac_", i, "_MaP"), 
+									paste0("removal.fac_", i, "_MaP"),
+									paste0("acc.fac_", i, "_MaP"),
+									paste0("clean.fac_", i, "_MaP"),
+									paste0("resus.fac_", i, "_MaP"))
+		
+		rivers.all6 <- cbind(rivers.all6, a)
+		rm(a)
+	}
+	
+	c.names <- names(rivers.all6)
+	r.rivers <- which(rivers.all6$isLake==F & rivers.all6$outflow == 0)	
+	
+	##### removal #####
+	c.removal <- grep("removal.fac_", c.names)
+	rivers.all6[rivers.all6$isDam==T, c.removal] <- 0.75000000000000001 #for all dams assume a removal rate of 75% accross all polymers
+	
+	#warning if sed. factors are 1 or higher
+	if(length(which(rivers.all6$sed.fac_PET_MaP >= 1)) >=1){
+		warning("sedimentation factors are 1 or higher!")
+		break
+	}
+	
+	#safe file####
+	extra_name <- "weir75"
+	c.numeric <- names(select_if(st_drop_geometry(rivers.all6), is.numeric))
+	rivers.all6[ ,c.numeric] <- round(st_drop_geometry(rivers.all6[ , c.numeric]), digits = 10) #round numbers to avoid problems
+	save(rivers.all6,extra_name, file = paste0(main.path, "temp_data/rivers_all6_", extra_name, ".Rdata"))
+	
+	
+	
+	rm(list = ls())	
+	
+	
+	#path to sub-folders
+	setwd("~/")
+	main.path <- "PhD/mennekes2.0/"
+	# 
+	# 
+	#polymers
+	polymers <- c("LDPE", "HDPE", "PP", "PS", "EPS", "PVC", "PET")
+	
+	###############################
+	# scenario weir 95			####
+	###############################
+	
+	###############################
+	# load data
+	###############################
+	
+	# # load river data
+	load(paste0(main.path, "temp_data/rivers_all5_2.Rdata"))
+	rivers.all6 <- rivers.all5
+	rm(rivers.all5)
+	
+	#load factors for river
+	load(paste0(main.path, "temp_data/factor_rivers_MaP.Rdata")) #high middle low
+	
+	fac_rivers["zero"] <- 0 #add a value for no change
+	
+	
+	
+	
+	#############
+	# define factors
+	#############
+	
+	
+	# add all data to rivers.calc
+	
+	for (i in polymers) {
+		a <- as.data.frame(matrix(0, nrow = nrow(rivers.all6), ncol = 5))
+		names(a) <- c(paste0("sed.fac_", i, "_MaP"), 
+									paste0("removal.fac_", i, "_MaP"),
+									paste0("acc.fac_", i, "_MaP"),
+									paste0("clean.fac_", i, "_MaP"),
+									paste0("resus.fac_", i, "_MaP"))
+		
+		rivers.all6 <- cbind(rivers.all6, a)
+		rm(a)
+	}
+	
+	c.names <- names(rivers.all6)
+	r.rivers <- which(rivers.all6$isLake==F & rivers.all6$outflow == 0)	
+	
+	##### removal #####
+	c.removal <- grep("removal.fac_", c.names)
+	rivers.all6[rivers.all6$isDam==T, c.removal] <- 0.95000000000000001 #for all dams assume a removal rate of 75% accross all polymers
+	
+	#warning if sed. factors are 1 or higher
+	if(length(which(rivers.all6$sed.fac_PET_MaP >= 1)) >=1){
+		warning("sedimentation factors are 1 or higher!")
+		break
+	}
+	
+	#safe file####
+	extra_name <- "weir95"
+	c.numeric <- names(select_if(st_drop_geometry(rivers.all6), is.numeric))
+	rivers.all6[ ,c.numeric] <- round(st_drop_geometry(rivers.all6[ , c.numeric]), digits = 10) #round numbers to avoid problems
+	save(rivers.all6,extra_name, file = paste0(main.path, "temp_data/rivers_all6_", extra_name, ".Rdata"))
+	
+	
+	
+	rm(list = ls())	
+	
+	
+	
+	
+	#path to sub-folders
+	setwd("~/")
+	main.path <- "PhD/mennekes2.0/"
+	# 
+	# 
+	#polymers
+	polymers <- c("LDPE", "HDPE", "PP", "PS", "EPS", "PVC", "PET")
+	
+	###############################
+	# scenario baseLakesLinear		####
+	###############################
+	
+	###############################
+	# load data
+	###############################
+	
+	# # load river data
+	load(paste0(main.path, "temp_data/rivers_all5_2.Rdata"))
+	rivers.all6 <- rivers.all5
+	rm(rivers.all5)
+	
+	#load factors for river
+	load(paste0(main.path, "temp_data/factor_rivers_MaP.Rdata")) #high middle low
+	
+	fac_rivers["zero"] <- 0 #add a value for no change
+	
+	
+	
+	
+	#############
+	# define factors
+	#############
+	
+	
+	# add all data to rivers.calc
+	
+	for (i in polymers) {
+		a <- as.data.frame(matrix(0, nrow = nrow(rivers.all6), ncol = 5))
+		names(a) <- c(paste0("sed.fac_", i, "_MaP"), 
+									paste0("removal.fac_", i, "_MaP"),
+									paste0("acc.fac_", i, "_MaP"),
+									paste0("clean.fac_", i, "_MaP"),
+									paste0("resus.fac_", i, "_MaP"))
+		
+		rivers.all6 <- cbind(rivers.all6, a)
+		rm(a)
+	}
+	
+	c.names <- names(rivers.all6)
+	r.rivers <- which(rivers.all6$isLake==F & rivers.all6$outflow == 0)	
+	
+	
+	
+	##### sedimentation######
+	#------------------#
+	
+	c.sed <- grep("sed.fac_", c.names) #columns with name sedimentation
+	
+	
+	
+	### lakes ###
+	r.lakes <- which(rivers.all6$isLake == T)
+	#linear equations
+	
+	a <- 0.95/600000000 #incline of linear function
+	rivers.all6[r.lakes, c.sed] <- rivers.all6$area[r.lakes]*a
+	
+	#5% min water contamination (max sed = 0.95)
+	for (i in c.sed) {
+		over95 <- which(st_drop_geometry(rivers.all6[ , i]) > 0.95000000000000001)
+		if(length(over95) > 0){
+			rivers.all6[over95, i] <- 0.95000000000000001
+		}
+		
+	}
+	
+
+	#### accumulation ###
+	c.acc <- grep("acc.fac_", c.names)
+	# rivers.all6[rivers.all6$outflow==0,c.acc] <- 1- st_drop_geometry(rivers.all6[rivers.all6$outflow==0,c.clean]) - st_drop_geometry(rivers.all6[rivers.all6$outflow==0,c.resus]) # the rest will be accumulation, causes problems of rounding
+	rivers.all6[rivers.all6$outflow==0,c.acc] <- 1 #can be as high as 1 means that the entire rest will be accumulated.
+	
+	
+	
+	#warning if sed. factors are 1 or higher
+	if(length(which(rivers.all6$sed.fac_PET_MaP >= 1)) >=1){
+		warning("sedimentation factors are 1 or higher!")
+		break
+	}
+	
+	#safe file####
+	extra_name <- "baseLakesLinear"
+	c.numeric <- names(select_if(st_drop_geometry(rivers.all6), is.numeric))
+	rivers.all6[ ,c.numeric] <- round(st_drop_geometry(rivers.all6[ , c.numeric]), digits = 10) #round numbers to avoid problems
+	save(rivers.all6,extra_name, file = paste0(main.path, "temp_data/rivers_all6_", extra_name, ".Rdata"))
+	
+	
+	
+	rm(list = ls())	
+	
+	
+	
+	#path to sub-folders
+	setwd("~/")
+	main.path <- "PhD/mennekes2.0/"
+	# 
+	# 
+	#polymers
+	polymers <- c("LDPE", "HDPE", "PP", "PS", "EPS", "PVC", "PET")
+	
+	###############################
+	# scenario baseLakes05		####
+	###############################
+	
+	###############################
+	# load data
+	###############################
+	
+	# # load river data
+	load(paste0(main.path, "temp_data/rivers_all5_2.Rdata"))
+	rivers.all6 <- rivers.all5
+	rm(rivers.all5)
+	
+	#load factors for river
+	load(paste0(main.path, "temp_data/factor_rivers_MaP.Rdata")) #high middle low
+	
+	fac_rivers["zero"] <- 0 #add a value for no change
+	
+	
+	
+	
+	#############
+	# define factors
+	#############
+	
+	
+	# add all data to rivers.calc
+	
+	for (i in polymers) {
+		a <- as.data.frame(matrix(0, nrow = nrow(rivers.all6), ncol = 5))
+		names(a) <- c(paste0("sed.fac_", i, "_MaP"), 
+									paste0("removal.fac_", i, "_MaP"),
+									paste0("acc.fac_", i, "_MaP"),
+									paste0("clean.fac_", i, "_MaP"),
+									paste0("resus.fac_", i, "_MaP"))
+		
+		rivers.all6 <- cbind(rivers.all6, a)
+		rm(a)
+	}
+	
+	c.names <- names(rivers.all6)
+	r.rivers <- which(rivers.all6$isLake==F & rivers.all6$outflow == 0)	
+	
+	
+	
+	##### sedimentation######
+	#------------------#
+	
+	c.sed <- grep("sed.fac_", c.names) #columns with name sedimentation
+	
+	
+	
+	### lakes ###
+	r.lakes <- which(rivers.all6$isLake == T)
+	#linear equations
+	
+	rivers.all6[r.lakes, c.sed] <- 0.05
+	
+	#5% min water contamination (max sed = 0.95000000000000001)
+	for (i in c.sed) {
+		over95 <- which(st_drop_geometry(rivers.all6[ , i]) > 0.95000000000000001)
+		if(length(over95) > 0){
+			rivers.all6[over95, i] <- 0.95000000000000001
+		}
+		
+	}
+	
+	
+	#### accumulation ###
+	c.acc <- grep("acc.fac_", c.names)
+	# rivers.all6[rivers.all6$outflow==0,c.acc] <- 1- st_drop_geometry(rivers.all6[rivers.all6$outflow==0,c.clean]) - st_drop_geometry(rivers.all6[rivers.all6$outflow==0,c.resus]) # the rest will be accumulation, causes problems of rounding
+	rivers.all6[rivers.all6$outflow==0,c.acc] <- 1 #can be as high as 1 means that the entire rest will be accumulated.
+	
+	
+	
+	#warning if sed. factors are 1 or higher
+	if(length(which(rivers.all6$sed.fac_PET_MaP >= 1)) >=1){
+		warning("sedimentation factors are 1 or higher!")
+		break
+	}
+	
+	#safe file####
+	extra_name <- "baseLakes05"
+	c.numeric <- names(select_if(st_drop_geometry(rivers.all6), is.numeric))
+	rivers.all6[ ,c.numeric] <- round(st_drop_geometry(rivers.all6[ , c.numeric]), digits = 10) #round numbers to avoid problems
+	save(rivers.all6,extra_name, file = paste0(main.path, "temp_data/rivers_all6_", extra_name, ".Rdata"))
+	
+	
+	
+	rm(list = ls())	
+	
+	
+	
+	#path to sub-folders
+	setwd("~/")
+	main.path <- "PhD/mennekes2.0/"
+	# 
+	# 
+	#polymers
+	polymers <- c("LDPE", "HDPE", "PP", "PS", "EPS", "PVC", "PET")
+	
+	###############################
+	# scenario baseLakes50		####
+	###############################
+	
+	###############################
+	# load data
+	###############################
+	
+	# # load river data
+	load(paste0(main.path, "temp_data/rivers_all5_2.Rdata"))
+	rivers.all6 <- rivers.all5
+	rm(rivers.all5)
+	
+	#load factors for river
+	load(paste0(main.path, "temp_data/factor_rivers_MaP.Rdata")) #high middle low
+	
+	fac_rivers["zero"] <- 0 #add a value for no change
+	
+	
+	
+	
+	#############
+	# define factors
+	#############
+	
+	
+	# add all data to rivers.calc
+	
+	for (i in polymers) {
+		a <- as.data.frame(matrix(0, nrow = nrow(rivers.all6), ncol = 5))
+		names(a) <- c(paste0("sed.fac_", i, "_MaP"), 
+									paste0("removal.fac_", i, "_MaP"),
+									paste0("acc.fac_", i, "_MaP"),
+									paste0("clean.fac_", i, "_MaP"),
+									paste0("resus.fac_", i, "_MaP"))
+		
+		rivers.all6 <- cbind(rivers.all6, a)
+		rm(a)
+	}
+	
+	c.names <- names(rivers.all6)
+	r.rivers <- which(rivers.all6$isLake==F & rivers.all6$outflow == 0)	
+	
+	
+	
+	##### sedimentation######
+	#------------------#
+	
+	c.sed <- grep("sed.fac_", c.names) #columns with name sedimentation
+	
+	
+	
+	### lakes ###
+	r.lakes <- which(rivers.all6$isLake == T)
+	#linear equations
+	
+	rivers.all6[r.lakes, c.sed] <- 0.5
+	
+	#5% min water contamination (max sed = 0.95000000000000001)
+	for (i in c.sed) {
+		over95 <- which(st_drop_geometry(rivers.all6[ , i]) > 0.95000000000000001)
+		if(length(over95) > 0){
+			rivers.all6[over95, i] <- 0.95000000000000001
+		}
+		
+	}
+	
+	
+	#### accumulation ###
+	c.acc <- grep("acc.fac_", c.names)
+	# rivers.all6[rivers.all6$outflow==0,c.acc] <- 1- st_drop_geometry(rivers.all6[rivers.all6$outflow==0,c.clean]) - st_drop_geometry(rivers.all6[rivers.all6$outflow==0,c.resus]) # the rest will be accumulation, causes problems of rounding
+	rivers.all6[rivers.all6$outflow==0,c.acc] <- 1 #can be as high as 1 means that the entire rest will be accumulated.
+	
+	
+	
+	#warning if sed. factors are 1 or higher
+	if(length(which(rivers.all6$sed.fac_PET_MaP >= 1)) >=1){
+		warning("sedimentation factors are 1 or higher!")
+		break
+	}
+	
+	#safe file####
+	extra_name <- "baseLakes50"
+	c.numeric <- names(select_if(st_drop_geometry(rivers.all6), is.numeric))
+	rivers.all6[ ,c.numeric] <- round(st_drop_geometry(rivers.all6[ , c.numeric]), digits = 10) #round numbers to avoid problems
+	save(rivers.all6,extra_name, file = paste0(main.path, "temp_data/rivers_all6_", extra_name, ".Rdata"))
+	
+	
+	
+	rm(list = ls())	
+	
+	
+	
+	
+	
+	
+	#path to sub-folders
+	setwd("~/")
+	main.path <- "PhD/mennekes2.0/"
+	# 
+	# 
+	#polymers
+	polymers <- c("LDPE", "HDPE", "PP", "PS", "EPS", "PVC", "PET")
+	
+	###############################
+	# scenario baseLakes95		####
+	###############################
+	
+	###############################
+	# load data
+	###############################
+	
+	# # load river data
+	load(paste0(main.path, "temp_data/rivers_all5_2.Rdata"))
+	rivers.all6 <- rivers.all5
+	rm(rivers.all5)
+	
+	#load factors for river
+	load(paste0(main.path, "temp_data/factor_rivers_MaP.Rdata")) #high middle low
+	
+	fac_rivers["zero"] <- 0 #add a value for no change
+	
+	
+	
+	
+	#############
+	# define factors
+	#############
+	
+	
+	# add all data to rivers.calc
+	
+	for (i in polymers) {
+		a <- as.data.frame(matrix(0, nrow = nrow(rivers.all6), ncol = 5))
+		names(a) <- c(paste0("sed.fac_", i, "_MaP"), 
+									paste0("removal.fac_", i, "_MaP"),
+									paste0("acc.fac_", i, "_MaP"),
+									paste0("clean.fac_", i, "_MaP"),
+									paste0("resus.fac_", i, "_MaP"))
+		
+		rivers.all6 <- cbind(rivers.all6, a)
+		rm(a)
+	}
+	
+	c.names <- names(rivers.all6)
+	r.rivers <- which(rivers.all6$isLake==F & rivers.all6$outflow == 0)	
+	
+	
+	
+	##### sedimentation######
+	#------------------#
+	
+	c.sed <- grep("sed.fac_", c.names) #columns with name sedimentation
+	
+	
+	
+	### lakes ###
+	r.lakes <- which(rivers.all6$isLake == T)
+	#linear equations
+	
+	rivers.all6[r.lakes, c.sed] <- 0.95000000000000001
+	
+	#5% min water contamination (max sed = 0.95000000000000001)
+	for (i in c.sed) {
+		over95 <- which(st_drop_geometry(rivers.all6[ , i]) > 0.95000000000000001)
+		if(length(over95) > 0){
+			rivers.all6[over95, i] <- 0.95000000000000001
+		}
+		
+	}
+	
+	
+	#### accumulation ###
+	c.acc <- grep("acc.fac_", c.names)
+	# rivers.all6[rivers.all6$outflow==0,c.acc] <- 1- st_drop_geometry(rivers.all6[rivers.all6$outflow==0,c.clean]) - st_drop_geometry(rivers.all6[rivers.all6$outflow==0,c.resus]) # the rest will be accumulation, causes problems of rounding
+	rivers.all6[rivers.all6$outflow==0,c.acc] <- 1 #can be as high as 1 means that the entire rest will be accumulated.
+	
+	
+	
+	#warning if sed. factors are 1 or higher
+	if(length(which(rivers.all6$sed.fac_PET_MaP >= 1)) >=1){
+		warning("sedimentation factors are 1 or higher!")
+		break
+	}
+	
+	#safe file####
+	extra_name <- "baseLakes95"
+	c.numeric <- names(select_if(st_drop_geometry(rivers.all6), is.numeric))
+	rivers.all6[ ,c.numeric] <- round(st_drop_geometry(rivers.all6[ , c.numeric]), digits = 10) #round numbers to avoid problems
+	save(rivers.all6,extra_name, file = paste0(main.path, "temp_data/rivers_all6_", extra_name, ".Rdata"))
+	
+	
+	
+	rm(list = ls())	
+	
+	
+	##############################################################
+	
+	#path to sub-folders
+	setwd("~/")
+	main.path <- "PhD/mennekes2.0/"
+	# 
+	# 
+	#polymers
+	polymers <- c("LDPE", "HDPE", "PP", "PS", "EPS", "PVC", "PET")
+	
+	###############################
+	# scenario baseRivers		####
+	###############################
+	
+	###############################
+	# load data
+	###############################
+	
+	# # load river data
+	load(paste0(main.path, "temp_data/rivers_all5_2.Rdata"))
+	rivers.all6 <- rivers.all5
+	rm(rivers.all5)
+	
+	#load factors for river
+	load(paste0(main.path, "temp_data/factor_rivers_MaP.Rdata")) #high middle low
+	
+	fac_rivers["zero"] <- 0 #add a value for no change
+	
+	
+	
+	
+	#############
+	# define factors
+	#############
+	
+	
+	# add all data to rivers.calc
+	
+	for (i in polymers) {
+		a <- as.data.frame(matrix(0, nrow = nrow(rivers.all6), ncol = 5))
+		names(a) <- c(paste0("sed.fac_", i, "_MaP"), 
+									paste0("removal.fac_", i, "_MaP"),
+									paste0("acc.fac_", i, "_MaP"),
+									paste0("clean.fac_", i, "_MaP"),
+									paste0("resus.fac_", i, "_MaP"))
+		
+		rivers.all6 <- cbind(rivers.all6, a)
+		rm(a)
+	}
+	
+	c.names <- names(rivers.all6)
+	r.rivers <- which(rivers.all6$isLake==F & rivers.all6$outflow == 0)	
+	
+	##### removal #####
+	c.removal <- grep("removal.fac_", c.names)
+	rivers.all6[rivers.all6$isDam==T, c.removal] <- 0.75000000000000001 #for all dams assume a removal rate of 75% accross all polymers
+	
+	
+	
+	##### sedimentation######
+	#------------------#
+	
+	c.sed <- grep("sed.fac_", c.names) #columns with name sedimentation
+	
+	
+	### rivers ###
+	#create dataframe to calculate factor
+	df01 <- st_drop_geometry(rivers.all6 %>% select(id_all,discharge, isLake, isDam, forest, rocks, unknown, urban, agriculture, glacier, water, meandering_factor))
+	
+	
+	# for rivers ###
+	#create factors for each category for sedimentation: landuse, sinuosity, discharge
+	
+	df01$fac_sed_landuse <- 0
+	df01$fac_sed_sinuosity <- 0
+	df01$fac_sed_discharge <- 0
+	
+	# for landuse:
+	#apply the landuse factors high, middle, low according to the groupping of landuse
+	# forest, agriculture -> high
+	# rocks, unknown (grassland) -> mid
+	# urban -> low
+	# water, glacier -> zero (=0)
+	
+	df01$fac_sed_landuse <- df01$forest*fac_rivers["high"]+df01$agriculture*fac_rivers["high"]+
+		df01$rocks*fac_rivers["mid"]+df01$unknown*fac_rivers["mid"]+
+		df01$urban*fac_rivers["low"]+
+		df01$water*fac_rivers["zero"]+df01$glacier*fac_rivers["zero"]
+	df01$fac_sed_landuse[is.na(df01$fac_sed_landuse)] <- fac_rivers["zero"] #replace NA with zero value
+	
+	# for discharge
+	# 1.) find theoretical max distance dmax
+	# case different equation for discharge below = 0.3 and over 0.3
+	df01$dmax[df01$discharge<= 0.3] <- 3333*df01$discharge[df01$discharge<= 0.3] #for discharge <= 0.3
+	df01$dmax[df01$discharge> 0.3] <- 330*df01$discharge[df01$discharge> 0.3]+901 #for discharge >0.3
+	
+	#2. use dmax to calculate factor x in the for one step (x = log(0.05)/ dmax)
+	df01$x <- -(log(0.05) / df01$dmax)
+	
+	#3.) find fac for 1 time step -> f(x) = 1-exp(1)^(-x * 1)
+	df01$fac_sed_discharge <- 1-exp(1)^(-df01$x*1)
+	
+	
+	# for sinuosity
+	# apply equation based on Newbould 2021
+	df01$fac_sed_sinuosity <- (1-(1/(df01$meandering_factor)^0.3))*0.1
+	
+	
+	#use df01 for rivers in river.all6 data
+	df01$sum <- 1-(1-df01$fac_sed_landuse)*(1-df01$fac_sed_discharge)*(1-df01$fac_sed_sinuosity)
+	# summary(df01)
+	
+	# bring numbers to rivers.all6 and apply neg. compound interest eq.
+	#for rivers only!
+	rivers.all6[r.rivers, c.sed] <- ((1 - df01$sum[r.rivers])^rivers.all6$length_m[r.rivers])
+	
+	#5% min water contamination (max sed = 0.95000000000000001)
+	for (i in c.sed) {
+		over95 <- which(st_drop_geometry(rivers.all6[ , i]) > 0.95000000000000001)
+		if(length(over95) > 0){
+			rivers.all6[over95, i] <- 0.95000000000000001
+		}
+		
+	}
+	
+	
+	### lakes ###
+	r.lakes <- which(rivers.all6$isLake == T)
+	#linear equations
+	
+	rivers.all6[r.lakes, c.sed] <- 0 #sed for lakes = 0
+	
+	##### cleaning####
+	c.clean <- grep("clean.fac_", c.names)
+	rivers.all6[ , c.clean] <- 0.20000000000000001
+	rivers.all6[r.lakes, c.clean] <- 0
+	
+	
+	#### resus ##
+	c.resus <- grep("resus.fac_", c.names)
+	rivers.all6[r.rivers, c.resus] <- 0.20000000000000001 #for all rivers 20%
+	rivers.all6[r.lakes, c.resus] <- 0 #for all lakes 0%; is included in sedimentation
+	
+	
+	
+	#### accumulation ###
+	c.acc <- grep("acc.fac_", c.names)
+	# rivers.all6[rivers.all6$outflow==0,c.acc] <- 1- st_drop_geometry(rivers.all6[rivers.all6$outflow==0,c.clean]) - st_drop_geometry(rivers.all6[rivers.all6$outflow==0,c.resus]) # the rest will be accumulation, causes problems of rounding
+	rivers.all6[rivers.all6$outflow==0,c.acc] <- 1 #can be as high as 1 means that the entire rest will be accumulated.
+	
+	
+	#warning if sed. factors are 1 or higher
+	if(length(which(rivers.all6$sed.fac_PET_MaP >= 1)) >=1){
+		warning("sedimentation factors are 1 or higher!")
+		break
+	}
+	
+	
+	#safe file####
+	extra_name <- "baseRivers"
+	c.numeric <- names(select_if(st_drop_geometry(rivers.all6), is.numeric))
+	rivers.all6[ ,c.numeric] <- round(st_drop_geometry(rivers.all6[ , c.numeric]), digits = 10) #round numbers to avoid problems
+	save(rivers.all6,extra_name, file = paste0(main.path, "temp_data/rivers_all6_", extra_name, ".Rdata"))
+	
+	
+	
+	rm(list = ls())	
+	
+	
+	
+	
+	##############################################################
+	
+	#path to sub-folders
+	setwd("~/")
+	main.path <- "PhD/mennekes2.0/"
+	# 
+	# 
+	#polymers
+	polymers <- c("LDPE", "HDPE", "PP", "PS", "EPS", "PVC", "PET")
+	
+	###############################
+	##### scenario baseRiversnoResus   ####
+	###############################
+	
+	###############################
+	# load data
+	###############################
+	
+	# # load river data
+	load(paste0(main.path, "temp_data/rivers_all5_2.Rdata"))
+	rivers.all6 <- rivers.all5
+	rm(rivers.all5)
+	
+	#load factors for river
+	load(paste0(main.path, "temp_data/factor_rivers_MaP.Rdata")) #high middle low
+	
+	fac_rivers["zero"] <- 0 #add a value for no change
+	
+	
+	
+	
+	#############
+	# define factors
+	#############
+	
+	
+	# add all data to rivers.calc
+	
+	for (i in polymers) {
+		a <- as.data.frame(matrix(0, nrow = nrow(rivers.all6), ncol = 5))
+		names(a) <- c(paste0("sed.fac_", i, "_MaP"), 
+									paste0("removal.fac_", i, "_MaP"),
+									paste0("acc.fac_", i, "_MaP"),
+									paste0("clean.fac_", i, "_MaP"),
+									paste0("resus.fac_", i, "_MaP"))
+		
+		rivers.all6 <- cbind(rivers.all6, a)
+		rm(a)
+	}
+	
+	c.names <- names(rivers.all6)
+	r.rivers <- which(rivers.all6$isLake==F & rivers.all6$outflow == 0)	
+	
+	##### removal #####
+	c.removal <- grep("removal.fac_", c.names)
+	rivers.all6[rivers.all6$isDam==T, c.removal] <- 0.75000000000000001 #for all dams assume a removal rate of 75% accross all polymers
+	
+	
+	
+	##### sedimentation######
+	#------------------#
+	
+	c.sed <- grep("sed.fac_", c.names) #columns with name sedimentation
+	
+	
+	### rivers ###
+	#create dataframe to calculate factor
+	df01 <- st_drop_geometry(rivers.all6 %>% select(id_all,discharge, isLake, isDam, forest, rocks, unknown, urban, agriculture, glacier, water, meandering_factor))
+	
+	
+	# for rivers ###
+	#create factors for each category for sedimentation: landuse, sinuosity, discharge
+	
+	df01$fac_sed_landuse <- 0
+	df01$fac_sed_sinuosity <- 0
+	df01$fac_sed_discharge <- 0
+	
+	# for landuse:
+	#apply the landuse factors high, middle, low according to the groupping of landuse
+	# forest, agriculture -> high
+	# rocks, unknown (grassland) -> mid
+	# urban -> low
+	# water, glacier -> zero (=0)
+	
+	df01$fac_sed_landuse <- df01$forest*fac_rivers["high"]+df01$agriculture*fac_rivers["high"]+
+		df01$rocks*fac_rivers["mid"]+df01$unknown*fac_rivers["mid"]+
+		df01$urban*fac_rivers["low"]+
+		df01$water*fac_rivers["zero"]+df01$glacier*fac_rivers["zero"]
+	df01$fac_sed_landuse[is.na(df01$fac_sed_landuse)] <- fac_rivers["zero"] #replace NA with zero value
+	
+	# for discharge
+	# 1.) find theoretical max distance dmax
+	# case different equation for discharge below = 0.3 and over 0.3
+	df01$dmax[df01$discharge<= 0.3] <- 3333*df01$discharge[df01$discharge<= 0.3] #for discharge <= 0.3
+	df01$dmax[df01$discharge> 0.3] <- 330*df01$discharge[df01$discharge> 0.3]+901 #for discharge >0.3
+	
+	#2. use dmax to calculate factor x in the for one step (x = log(0.05)/ dmax)
+	df01$x <- -(log(0.05) / df01$dmax)
+	
+	#3.) find fac for 1 time step -> f(x) = 1-exp(1)^(-x * 1)
+	df01$fac_sed_discharge <- 1-exp(1)^(-df01$x*1)
+	
+	
+	# for sinuosity
+	# apply equation based on Newbould 2021
+	df01$fac_sed_sinuosity <- (1-(1/(df01$meandering_factor)^0.3))*0.1
+	
+	
+	
+	#use df01 for rivers in river.all6 data
+	df01$sum <- 1-(1-df01$fac_sed_landuse)*(1-df01$fac_sed_discharge)*(1-df01$fac_sed_sinuosity)
+	# summary(df01)
+	
+	# bring numbers to rivers.all6 and apply neg. compound interest eq.
+	#for rivers only!
+	rivers.all6[r.rivers, c.sed] <- ((1 - df01$sum[r.rivers])^rivers.all6$length_m[r.rivers])
+	
+	
+	### lakes ###
+	r.lakes <- which(rivers.all6$isLake == T)
+	#linear equations
+	
+	rivers.all6[r.lakes, c.sed] <- 0 #sed for lakes = 0
+	
+	
+	#5% min water contamination (max sed = 0.95000000000000001)
+	for (i in c.sed) {
+		over95 <- which(st_drop_geometry(rivers.all6[ , i]) > 0.95000000000000001)
+		if(length(over95) > 0){
+			rivers.all6[over95, i] <- 0.95000000000000001
+		}
+		
+	}
+	
+	##### cleaning####
+	c.clean <- grep("clean.fac_", c.names)
+	rivers.all6[ , c.clean] <- 0.20000000000000001
+	rivers.all6[r.lakes, c.clean] <- 0
+	
+	
+	#### resus ##
+	c.resus <- grep("resus.fac_", c.names)
+	rivers.all6[r.rivers, c.resus] <- 0 #for all rivers 20%
+	rivers.all6[r.lakes, c.resus] <- 0 #for all lakes 0%; is included in sedimentation
+	
+	
+	
+	#### accumulation ###
+	c.acc <- grep("acc.fac_", c.names)
+	# rivers.all6[rivers.all6$outflow==0,c.acc] <- 1- st_drop_geometry(rivers.all6[rivers.all6$outflow==0,c.clean]) - st_drop_geometry(rivers.all6[rivers.all6$outflow==0,c.resus]) # the rest will be accumulation, causes problems of rounding
+	rivers.all6[rivers.all6$outflow==0,c.acc] <- 1 #can be as high as 1 means that the entire rest will be accumulated.
+	
+	
+	#warning if sed. factors are 1 or higher
+	if(length(which(rivers.all6$sed.fac_PET_MaP >= 1)) >=1){
+		warning("sedimentation factors are 1 or higher!")
+		break
+	}
+	
+	
+	
+	#safe file####
+	extra_name <- "baseRiversnoResus"
+	c.numeric <- names(select_if(st_drop_geometry(rivers.all6), is.numeric))
+	rivers.all6[ ,c.numeric] <- round(st_drop_geometry(rivers.all6[ , c.numeric]), digits = 10) #round numbers to avoid problems
+	save(rivers.all6,extra_name, file = paste0(main.path, "temp_data/rivers_all6_", extra_name, ".Rdata"))
+	
+	
+	
+	rm(list = ls())
+	
+	
+	
+	
+	###################################################################
+	#path to sub-folders
+	setwd("~/")
+	main.path <- "PhD/mennekes2.0/"
+	# 
+	# 
+	#polymers
+	polymers <- c("LDPE", "HDPE", "PP", "PS", "EPS", "PVC", "PET")
+	
+	###############################
+	# scenario LUlow           ####
+	###############################
+	
+	###############################
+	# load data
+	###############################
+	
+	# # load river data
+	load(paste0(main.path, "temp_data/rivers_all5_2.Rdata"))
+	rivers.all6 <- rivers.all5
+	rm(rivers.all5)
+	
+	#load factors for river
+	load(paste0(main.path, "temp_data/factor_rivers_MaP.Rdata")) #high middle low
+	
+	fac_rivers["zero"] <- 0 #add a value for no change
+	
+	
+	
+	
+	#############
+	# define factors
+	#############
+	
+	
+	# add all data to rivers.calc
+	
+	for (i in polymers) {
+		a <- as.data.frame(matrix(0, nrow = nrow(rivers.all6), ncol = 5))
+		names(a) <- c(paste0("sed.fac_", i, "_MaP"), 
+									paste0("removal.fac_", i, "_MaP"),
+									paste0("acc.fac_", i, "_MaP"),
+									paste0("clean.fac_", i, "_MaP"),
+									paste0("resus.fac_", i, "_MaP"))
+		
+		rivers.all6 <- cbind(rivers.all6, a)
+		rm(a)
+	}
+	
+	c.names <- names(rivers.all6)
+	r.rivers <- which(rivers.all6$isLake==F & rivers.all6$outflow == 0)	
+	
+	
+	
+	
+	##### sedimentation######
+	#------------------#
+	
+	c.sed <- grep("sed.fac_", c.names) #columns with name sedimentation
+	
+	
+	### rivers ###
+	#create dataframe to calculate factor
+	df01 <- st_drop_geometry(rivers.all6 %>% select(id_all,discharge, isLake, isDam, forest, rocks, unknown, urban, agriculture, glacier, water, meandering_factor))
+	
+	
+	# for rivers ###
+	#create factors for each category for sedimentation: landuse, sinuosity, discharge
+	
+	df01$fac_sed_landuse <- 0
+	df01$fac_sed_sinuosity <- 0
+	df01$fac_sed_discharge <- 0
+	
+	# for landuse:
+	#apply the landuse factors high, middle, low according to the groupping of landuse
+	# forest, agriculture -> high
+	# rocks, unknown (grassland) -> mid
+	# urban -> low
+	# water, glacier -> zero (=0)
+	
+	df01$fac_sed_landuse <- df01$forest*fac_rivers["high"]+df01$agriculture*fac_rivers["high"]+
+		df01$rocks*fac_rivers["mid"]+df01$unknown*fac_rivers["mid"]+
+		df01$urban*fac_rivers["low"]+
+		df01$water*fac_rivers["zero"]+df01$glacier*fac_rivers["zero"]
+	df01$fac_sed_landuse[is.na(df01$fac_sed_landuse)] <- fac_rivers["zero"] #replace NA with zero value
+	
+	
+	# for discharge
+	# 1.) find theoretical max distance dmax
+	# case different equation for discharge below = 0.3 and over 0.3
+	df01$dmax[df01$discharge<= 0.3] <- 3333*df01$discharge[df01$discharge<= 0.3] #for discharge <= 0.3
+	df01$dmax[df01$discharge> 0.3] <- 330*df01$discharge[df01$discharge> 0.3]+901 #for discharge >0.3
+	
+	#2. use dmax to calculate factor x in the for one step (x = log(0.05)/ dmax)
+	df01$x <- -(log(0.05) / df01$dmax)
+	
+	#3.) find fac for 1 time step -> f(x) = 1-exp(1)^(-x * 1)
+	df01$fac_sed_discharge <- 1-exp(1)^(-df01$x*1)
+	
+
+	# for sinuosity
+	# apply equation based on Newbould 2021
+	df01$fac_sed_sinuosity <- (1-(1/(df01$meandering_factor)^0.3))*0.1
+	
+	
+	#use df01 for rivers in river.all6 data
+	# df01$sum <- 1-(1-df01$fac_sed_landuse)*(1-df01$fac_sed_discharge)*(1-df01$fac_sed_sinuosity)
+	df01$sum <- df01$fac_sed_landuse
+	# summary(df01)
+	
+	# bring numbers to rivers.all6 and apply neg. compound interest eq.
+	#for rivers only!
+	rivers.all6[r.rivers, c.sed] <- (1-(1 - df01$sum[r.rivers])^rivers.all6$length_m[r.rivers])
+	
+	
+	#manipulate:
+	rivers.all6[r.rivers, c.sed] <- st_drop_geometry(rivers.all6[r.rivers, c.sed])*0.5
+	
+	#5% min water contamination
+	for (i in c.sed) {
+		over95 <- which(st_drop_geometry(rivers.all6[ , i]) > 0.95000000000000001)
+		if(length(over95) > 0){
+			rivers.all6[over95, i] <- 0.95000000000000001
+		}
+		
+	}
+	
+	
+	#### accumulation ###
+	c.acc <- grep("acc.fac_", c.names)
+	# rivers.all6[rivers.all6$outflow==0,c.acc] <- 1- st_drop_geometry(rivers.all6[rivers.all6$outflow==0,c.clean]) - st_drop_geometry(rivers.all6[rivers.all6$outflow==0,c.resus]) # the rest will be accumulation, causes problems of rounding
+	rivers.all6[rivers.all6$outflow==0,c.acc] <- 1 #can be as high as 1 means that the entire rest will be accumulated.
+	
+	
+	
+	#warning if sed. factors are 1 or higher
+	if(length(which(rivers.all6$sed.fac_PET_MaP >= 1)) >=1){
+		warning("sedimentation factors are 1 or higher!")
+		break
+	}
+	
+	#safe file####
+	extra_name <- "LUlow"
+	c.numeric <- names(select_if(st_drop_geometry(rivers.all6), is.numeric))
+	rivers.all6[ ,c.numeric] <- round(st_drop_geometry(rivers.all6[ , c.numeric]), digits = 10) #round numbers to avoid problems
+	save(rivers.all6,extra_name, file = paste0(main.path, "temp_data/rivers_all6_", extra_name, ".Rdata"))
+	
+	
+	
+	rm(list = ls())	
+	
+	
+	
+	
+	
+	###################################################################
+	#path to sub-folders
+	setwd("~/")
+	main.path <- "PhD/mennekes2.0/"
+	# 
+	# 
+	#polymers
+	polymers <- c("LDPE", "HDPE", "PP", "PS", "EPS", "PVC", "PET")
+	
+	###############################
+	# scenario LUmid           ####
+	###############################
+	
+	###############################
+	# load data
+	###############################
+	
+	# # load river data
+	load(paste0(main.path, "temp_data/rivers_all5_2.Rdata"))
+	rivers.all6 <- rivers.all5
+	rm(rivers.all5)
+	
+	#load factors for river
+	load(paste0(main.path, "temp_data/factor_rivers_MaP.Rdata")) #high middle low
+	
+	fac_rivers["zero"] <- 0 #add a value for no change
+	
+	
+	
+	
+	#############
+	# define factors
+	#############
+	
+	
+	# add all data to rivers.calc
+	
+	for (i in polymers) {
+		a <- as.data.frame(matrix(0, nrow = nrow(rivers.all6), ncol = 5))
+		names(a) <- c(paste0("sed.fac_", i, "_MaP"), 
+									paste0("removal.fac_", i, "_MaP"),
+									paste0("acc.fac_", i, "_MaP"),
+									paste0("clean.fac_", i, "_MaP"),
+									paste0("resus.fac_", i, "_MaP"))
+		
+		rivers.all6 <- cbind(rivers.all6, a)
+		rm(a)
+	}
+	
+	c.names <- names(rivers.all6)
+	r.rivers <- which(rivers.all6$isLake==F & rivers.all6$outflow == 0)	
+	
+	
+	
+	##### sedimentation######
+	#------------------#
+	
+	c.sed <- grep("sed.fac_", c.names) #columns with name sedimentation
+	
+	
+	### rivers ###
+	#create dataframe to calculate factor
+	df01 <- st_drop_geometry(rivers.all6 %>% select(id_all,discharge, isLake, isDam, forest, rocks, unknown, urban, agriculture, glacier, water, meandering_factor))
+	
+	
+	# for rivers ###
+	#create factors for each category for sedimentation: landuse, sinuosity, discharge
+	
+	df01$fac_sed_landuse <- 0
+	df01$fac_sed_sinuosity <- 0
+	df01$fac_sed_discharge <- 0
+	
+	# for landuse:
+	#apply the landuse factors high, middle, low according to the groupping of landuse
+	# forest, agriculture -> high
+	# rocks, unknown (grassland) -> mid
+	# urban -> low
+	# water, glacier -> zero (=0)
+	
+	df01$fac_sed_landuse <- df01$forest*fac_rivers["high"]+df01$agriculture*fac_rivers["high"]+
+		df01$rocks*fac_rivers["mid"]+df01$unknown*fac_rivers["mid"]+
+		df01$urban*fac_rivers["low"]+
+		df01$water*fac_rivers["zero"]+df01$glacier*fac_rivers["zero"]
+	df01$fac_sed_landuse[is.na(df01$fac_sed_landuse)] <- fac_rivers["zero"] #replace NA with zero value
+	
+	
+	# for discharge
+	# 1.) find theoretical max distance dmax
+	# case different equation for discharge below = 0.3 and over 0.3
+	df01$dmax[df01$discharge<= 0.3] <- 3333*df01$discharge[df01$discharge<= 0.3] #for discharge <= 0.3
+	df01$dmax[df01$discharge> 0.3] <- 330*df01$discharge[df01$discharge> 0.3]+901 #for discharge >0.3
+	
+	#2. use dmax to calculate factor x in the for one step (x = log(0.05)/ dmax)
+	df01$x <- -(log(0.05) / df01$dmax)
+	
+	#3.) find fac for 1 time step -> f(x) = 1-exp(1)^(-x * 1)
+	df01$fac_sed_discharge <- 1-exp(1)^(-df01$x*1)
+	
+	
+	# for sinuosity
+	# apply equation based on Newbould 2021
+	df01$fac_sed_sinuosity <- (1-(1/(df01$meandering_factor)^0.3))*0.1
+	
+	
+	
+	#use df01 for rivers in river.all6 data
+	# df01$sum <- 1-(1-df01$fac_sed_landuse)*(1-df01$fac_sed_discharge)*(1-df01$fac_sed_sinuosity)
+	df01$sum <- 1-(1-df01$fac_sed_landuse)
+	# summary(df01)
+	
+	# bring numbers to rivers.all6 and apply neg. compound interest eq.
+	#for rivers only!
+	rivers.all6[r.rivers, c.sed] <- ((1 - df01$sum[r.rivers])^rivers.all6$length_m[r.rivers])
+	
+	
+	#5% min water contamination
+	for (i in c.sed) {
+		over95 <- which(st_drop_geometry(rivers.all6[ , i]) > 0.95000000000000001)
+		if(length(over95) > 0){
+			rivers.all6[over95, i] <- 0.95000000000000001
+		}
+		
+	}
+	
+	
+	
+	#### accumulation ###
+	c.acc <- grep("acc.fac_", c.names)
+	# rivers.all6[rivers.all6$outflow==0,c.acc] <- 1- st_drop_geometry(rivers.all6[rivers.all6$outflow==0,c.clean]) - st_drop_geometry(rivers.all6[rivers.all6$outflow==0,c.resus]) # the rest will be accumulation, causes problems of rounding
+	rivers.all6[rivers.all6$outflow==0,c.acc] <- 1 #can be as high as 1 means that the entire rest will be accumulated.
+	
+	
+	
+	
+	
+	#safe file####
+	extra_name <- "LUmid"
+	c.numeric <- names(select_if(st_drop_geometry(rivers.all6), is.numeric))
+	rivers.all6[ ,c.numeric] <- round(st_drop_geometry(rivers.all6[ , c.numeric]), digits = 10) #round numbers to avoid problems
+	save(rivers.all6,extra_name, file = paste0(main.path, "temp_data/rivers_all6_", extra_name, ".Rdata"))
+	
+	
+	
+	rm(list = ls())	
+	
+	
+	
+	
+	###################################################################
+	#path to sub-folders
+	setwd("~/")
+	main.path <- "PhD/mennekes2.0/"
+	# 
+	# 
+	#polymers
+	polymers <- c("LDPE", "HDPE", "PP", "PS", "EPS", "PVC", "PET")
+	
+	###############################
+	# scenario LUhigh           ####
+	###############################
+	
+	###############################
+	# load data
+	###############################
+	
+	# # load river data
+	load(paste0(main.path, "temp_data/rivers_all5_2.Rdata"))
+	rivers.all6 <- rivers.all5
+	rm(rivers.all5)
+	
+	#load factors for river
+	load(paste0(main.path, "temp_data/factor_rivers_MaP.Rdata")) #high middle low
+	
+	fac_rivers["zero"] <- 0 #add a value for no change
+	
+	
+	
+	
+	#############
+	# define factors
+	#############
+	
+	
+	# add all data to rivers.calc
+	
+	for (i in polymers) {
+		a <- as.data.frame(matrix(0, nrow = nrow(rivers.all6), ncol = 5))
+		names(a) <- c(paste0("sed.fac_", i, "_MaP"), 
+									paste0("removal.fac_", i, "_MaP"),
+									paste0("acc.fac_", i, "_MaP"),
+									paste0("clean.fac_", i, "_MaP"),
+									paste0("resus.fac_", i, "_MaP"))
+		
+		rivers.all6 <- cbind(rivers.all6, a)
+		rm(a)
+	}
+	
+	c.names <- names(rivers.all6)
+	r.rivers <- which(rivers.all6$isLake==F & rivers.all6$outflow == 0)	
+	
+	
+	
+	
+	##### sedimentation######
+	#------------------#
+	
+	c.sed <- grep("sed.fac_", c.names) #columns with name sedimentation
+	
+	
+	### rivers ###
+	#create dataframe to calculate factor
+	df01 <- st_drop_geometry(rivers.all6 %>% select(id_all,discharge, isLake, isDam, forest, rocks, unknown, urban, agriculture, glacier, water, meandering_factor))
+	
+	
+	# for rivers ###
+	#create factors for each category for sedimentation: landuse, sinuosity, discharge
+	
+	df01$fac_sed_landuse <- 0
+	df01$fac_sed_sinuosity <- 0
+	df01$fac_sed_discharge <- 0
+	
+	# for landuse:
+	#apply the landuse factors high, middle, low according to the groupping of landuse
+	# forest, agriculture -> high
+	# rocks, unknown (grassland) -> mid
+	# urban -> low
+	# water, glacier -> zero (=0)
+	
+	df01$fac_sed_landuse <- df01$forest*fac_rivers["high"]+df01$agriculture*fac_rivers["high"]+
+		df01$rocks*fac_rivers["mid"]+df01$unknown*fac_rivers["mid"]+
+		df01$urban*fac_rivers["low"]+
+		df01$water*fac_rivers["zero"]+df01$glacier*fac_rivers["zero"]
+	df01$fac_sed_landuse[is.na(df01$fac_sed_landuse)] <- fac_rivers["zero"] #replace NA with zero value
+	
+	# for discharge
+	# 1.) find theoretical max distance dmax
+	# case different equation for discharge below = 0.3 and over 0.3
+	df01$dmax[df01$discharge<= 0.3] <- 3333*df01$discharge[df01$discharge<= 0.3] #for discharge <= 0.3
+	df01$dmax[df01$discharge> 0.3] <- 330*df01$discharge[df01$discharge> 0.3]+901 #for discharge >0.3
+	
+	#2. use dmax to calculate factor x in the for one step (x = log(0.05)/ dmax)
+	df01$x <- -(log(0.05) / df01$dmax)
+	
+	#3.) find fac for 1 time step -> f(x) = 1-exp(1)^(-x * 1)
+	df01$fac_sed_discharge <- 1-exp(1)^(-df01$x*1)
+	
+	
+	# for sinuosity
+	# apply equation based on Newbould 2021
+	df01$fac_sed_sinuosity <- (1-(1/(df01$meandering_factor)^0.3))*0.1
+	
+	
+	
+	#use df01 for rivers in river.all6 data
+	# df01$sum <- 1-(1-df01$fac_sed_landuse)*(1-df01$fac_sed_discharge)*(1-df01$fac_sed_sinuosity)
+	df01$sum <- 1-(1-df01$fac_sed_landuse)
+	# summary(df01)
+	
+	# bring numbers to rivers.all6 and apply neg. compound interest eq.
+	#for rivers only!
+	rivers.all6[r.rivers, c.sed] <- ((1 - df01$sum[r.rivers])^rivers.all6$length_m[r.rivers])
+	
+	#manipulate:
+	rivers.all6[r.rivers, c.sed] <- st_drop_geometry(rivers.all6[r.rivers, c.sed])*2
+	
+	#5% min water contamination
+	for (i in c.sed) {
+		over95 <- which(st_drop_geometry(rivers.all6[ , i]) > 0.95000000000000001)
+		if(length(over95) > 0){
+			rivers.all6[over95, i] <- 0.95000000000000001
+		}
+		
+	}
+	
+	
+	
+	#### accumulation ###
+	c.acc <- grep("acc.fac_", c.names)
+	# rivers.all6[rivers.all6$outflow==0,c.acc] <- 1- st_drop_geometry(rivers.all6[rivers.all6$outflow==0,c.clean]) - st_drop_geometry(rivers.all6[rivers.all6$outflow==0,c.resus]) # the rest will be accumulation, causes problems of rounding
+	rivers.all6[rivers.all6$outflow==0,c.acc] <- 1 #can be as high as 1 means that the entire rest will be accumulated.
+	
+	
+	
+	
+	
+	#safe file####
+	extra_name <- "LUhigh"
+	c.numeric <- names(select_if(st_drop_geometry(rivers.all6), is.numeric))
+	rivers.all6[ ,c.numeric] <- round(st_drop_geometry(rivers.all6[ , c.numeric]), digits = 10) #round numbers to avoid problems
+	save(rivers.all6,extra_name, file = paste0(main.path, "temp_data/rivers_all6_", extra_name, ".Rdata"))
+	
+	
+	
+	rm(list = ls())	
+	
+	
+	
+	###################################################################
+	#path to sub-folders
+	setwd("~/")
+	main.path <- "PhD/mennekes2.0/"
+	# 
+	# 
+	#polymers
+	polymers <- c("LDPE", "HDPE", "PP", "PS", "EPS", "PVC", "PET")
+	
+	###############################
+	# scenario Qlow           ####
+	###############################
+	
+	###############################
+	# load data
+	###############################
+	
+	# # load river data
+	load(paste0(main.path, "temp_data/rivers_all5_2.Rdata"))
+	rivers.all6 <- rivers.all5
+	rm(rivers.all5)
+	
+	#load factors for river
+	load(paste0(main.path, "temp_data/factor_rivers_MaP.Rdata")) #high middle low
+	
+	fac_rivers["zero"] <- 0 #add a value for no change
+	
+	
+	
+	
+	#############
+	# define factors
+	#############
+	
+	
+	# add all data to rivers.calc
+	
+	for (i in polymers) {
+		a <- as.data.frame(matrix(0, nrow = nrow(rivers.all6), ncol = 5))
+		names(a) <- c(paste0("sed.fac_", i, "_MaP"), 
+									paste0("removal.fac_", i, "_MaP"),
+									paste0("acc.fac_", i, "_MaP"),
+									paste0("clean.fac_", i, "_MaP"),
+									paste0("resus.fac_", i, "_MaP"))
+		
+		rivers.all6 <- cbind(rivers.all6, a)
+		rm(a)
+	}
+	
+	c.names <- names(rivers.all6)
+	r.rivers <- which(rivers.all6$isLake==F & rivers.all6$outflow == 0)	
+	
+	
+	
+	
+	##### sedimentation######
+	#------------------#
+	
+	c.sed <- grep("sed.fac_", c.names) #columns with name sedimentation
+	
+	
+	### rivers ###
+	#create dataframe to calculate factor
+	df01 <- st_drop_geometry(rivers.all6 %>% select(id_all,discharge, isLake, isDam, forest, rocks, unknown, urban, agriculture, glacier, water, meandering_factor))
+	
+	
+	# for rivers ###
+	#create factors for each category for sedimentation: landuse, sinuosity, discharge
+	
+	df01$fac_sed_landuse <- 0
+	df01$fac_sed_sinuosity <- 0
+	df01$fac_sed_discharge <- 0
+	
+	# for landuse:
+	#apply the landuse factors high, middle, low according to the groupping of landuse
+	# forest, agriculture -> high
+	# rocks, unknown (grassland) -> mid
+	# urban -> low
+	# water, glacier -> zero (=0)
+	
+	df01$fac_sed_landuse <- df01$forest*fac_rivers["high"]+df01$agriculture*fac_rivers["high"]+
+		df01$rocks*fac_rivers["mid"]+df01$unknown*fac_rivers["mid"]+
+		df01$urban*fac_rivers["low"]+
+		df01$water*fac_rivers["zero"]+df01$glacier*fac_rivers["zero"]
+	df01$fac_sed_landuse[is.na(df01$fac_sed_landuse)] <- fac_rivers["zero"] #replace NA with zero value
+	
+	# for discharge
+	# 1.) find theoretical max distance dmax
+	# case different equation for discharge below = 0.3 and over 0.3
+	df01$dmax[df01$discharge<= 0.3] <- 3333*df01$discharge[df01$discharge<= 0.3] #for discharge <= 0.3
+	df01$dmax[df01$discharge> 0.3] <- 330*df01$discharge[df01$discharge> 0.3]+901 #for discharge >0.3
+	
+	#2. use dmax to calculate factor x in the for one step (x = log(0.05)/ dmax)
+	df01$x <- -(log(0.05) / df01$dmax)
+	
+	#3.) find fac for 1 time step -> f(x) = 1-exp(1)^(-x * 1)
+	df01$fac_sed_discharge <- (1-exp(1)^(-df01$x*1)) #for low discharge
+	
+	
+	# for sinuosity
+	# apply equation based on Newbould 2021
+	df01$fac_sed_sinuosity <- (1-(1/(df01$meandering_factor)^0.3))*0.1
+	
+	
+
+	
+	#use df01 for rivers in river.all6 data
+	# df01$sum <- 1-(1-df01$fac_sed_landuse)*(1-df01$fac_sed_discharge)*(1-df01$fac_sed_sinuosity)
+	df01$sum <- 1-(1-df01$fac_sed_discharge)
+	# summary(df01)
+	
+	# bring numbers to rivers.all6 and apply neg. compound interest eq.
+	#for rivers only!
+	rivers.all6[r.rivers, c.sed] <- ((1 - df01$sum[r.rivers])^rivers.all6$length_m[r.rivers])
+	
+	
+	#manipulate:
+	rivers.all6[r.rivers, c.sed] <- st_drop_geometry(rivers.all6[r.rivers, c.sed])*0.5
+	
+	#5% min water contamination
+	for (i in c.sed) {
+		over95 <- which(st_drop_geometry(rivers.all6[ , i]) > 0.95000000000000001)
+		if(length(over95) > 0){
+			rivers.all6[over95, i] <- 0.95000000000000001
+		}
+		
+	}
+	
+	
+	
+	
+	
+	#### accumulation ###
+	c.acc <- grep("acc.fac_", c.names)
+	# rivers.all6[rivers.all6$outflow==0,c.acc] <- 1- st_drop_geometry(rivers.all6[rivers.all6$outflow==0,c.clean]) - st_drop_geometry(rivers.all6[rivers.all6$outflow==0,c.resus]) # the rest will be accumulation, causes problems of rounding
+	rivers.all6[rivers.all6$outflow==0,c.acc] <- 1 #can be as high as 1 means that the entire rest will be accumulated.
+	
+	
+	
+	
+	
+	#safe file####
+	extra_name <- "Qlow"
+	c.numeric <- names(select_if(st_drop_geometry(rivers.all6), is.numeric))
+	rivers.all6[ ,c.numeric] <- round(st_drop_geometry(rivers.all6[ , c.numeric]), digits = 10) #round numbers to avoid problems
+	save(rivers.all6,extra_name, file = paste0(main.path, "temp_data/rivers_all6_", extra_name, ".Rdata"))
+	
+	
+	
+	rm(list = ls())	
+	
+	
+	
+	
+	
+	###################################################################
+	#path to sub-folders
+	setwd("~/")
+	main.path <- "PhD/mennekes2.0/"
+	# 
+	# 
+	#polymers
+	polymers <- c("LDPE", "HDPE", "PP", "PS", "EPS", "PVC", "PET")
+	
+	###############################
+	# scenario Qmid           ####
+	###############################
+	
+	###############################
+	# load data
+	###############################
+	
+	# # load river data
+	load(paste0(main.path, "temp_data/rivers_all5_2.Rdata"))
+	rivers.all6 <- rivers.all5
+	rm(rivers.all5)
+	
+	#load factors for river
+	load(paste0(main.path, "temp_data/factor_rivers_MaP.Rdata")) #high middle low
+	
+	fac_rivers["zero"] <- 0 #add a value for no change
+	
+	
+	
+	
+	#############
+	# define factors
+	#############
+	
+	
+	# add all data to rivers.calc
+	
+	for (i in polymers) {
+		a <- as.data.frame(matrix(0, nrow = nrow(rivers.all6), ncol = 5))
+		names(a) <- c(paste0("sed.fac_", i, "_MaP"), 
+									paste0("removal.fac_", i, "_MaP"),
+									paste0("acc.fac_", i, "_MaP"),
+									paste0("clean.fac_", i, "_MaP"),
+									paste0("resus.fac_", i, "_MaP"))
+		
+		rivers.all6 <- cbind(rivers.all6, a)
+		rm(a)
+	}
+	
+	c.names <- names(rivers.all6)
+	r.rivers <- which(rivers.all6$isLake==F & rivers.all6$outflow == 0)	
+	
+	
+	
+	
+	##### sedimentation######
+	#------------------#
+	
+	c.sed <- grep("sed.fac_", c.names) #columns with name sedimentation
+	
+	
+	### rivers ###
+	#create dataframe to calculate factor
+	df01 <- st_drop_geometry(rivers.all6 %>% select(id_all,discharge, isLake, isDam, forest, rocks, unknown, urban, agriculture, glacier, water, meandering_factor))
+	
+	
+	# for rivers ###
+	#create factors for each category for sedimentation: landuse, sinuosity, discharge
+	
+	df01$fac_sed_landuse <- 0
+	df01$fac_sed_sinuosity <- 0
+	df01$fac_sed_discharge <- 0
+	
+	# for landuse:
+	#apply the landuse factors high, middle, low according to the groupping of landuse
+	# forest, agriculture -> high
+	# rocks, unknown (grassland) -> mid
+	# urban -> low
+	# water, glacier -> zero (=0)
+	
+	df01$fac_sed_landuse <- df01$forest*fac_rivers["high"]+df01$agriculture*fac_rivers["high"]+
+		df01$rocks*fac_rivers["mid"]+df01$unknown*fac_rivers["mid"]+
+		df01$urban*fac_rivers["low"]+
+		df01$water*fac_rivers["zero"]+df01$glacier*fac_rivers["zero"]
+	df01$fac_sed_landuse[is.na(df01$fac_sed_landuse)] <- fac_rivers["zero"] #replace NA with zero value
+	
+	# for discharge
+	# 1.) find theoretical max distance dmax
+	# case different equation for discharge below = 0.3 and over 0.3
+	df01$dmax[df01$discharge<= 0.3] <- 3333*df01$discharge[df01$discharge<= 0.3] #for discharge <= 0.3
+	df01$dmax[df01$discharge> 0.3] <- 330*df01$discharge[df01$discharge> 0.3]+901 #for discharge >0.3
+	
+	#2. use dmax to calculate factor x in the for one step (x = log(0.05)/ dmax)
+	df01$x <- -(log(0.05) / df01$dmax)
+	
+	#3.) find fac for 1 time step -> f(x) = 1-exp(1)^(-x * 1)
+	df01$fac_sed_discharge <- 1-exp(1)^(-df01$x*1)
+	
+	
+	# for sinuosity
+	# apply equation based on Newbould 2021
+	df01$fac_sed_sinuosity <- (1-(1/(df01$meandering_factor)^0.3))*0.1
+	
+
+	#use df01 for rivers in river.all6 data
+	# df01$sum <- 1-(1-df01$fac_sed_landuse)*(1-df01$fac_sed_discharge)*(1-df01$fac_sed_sinuosity)
+	df01$sum <- 1-(1-df01$fac_sed_discharge)
+	# summary(df01)
+	
+	# bring numbers to rivers.all6 and apply neg. compound interest eq.
+	#for rivers only!
+	rivers.all6[r.rivers, c.sed] <- ((1 - df01$sum[r.rivers])^rivers.all6$length_m[r.rivers])
+	
+	
+	#5% min water contamination
+	for (i in c.sed) {
+		over95 <- which(st_drop_geometry(rivers.all6[ , i]) > 0.95000000000000001)
+		if(length(over95) > 0){
+			rivers.all6[over95, i] <- 0.95000000000000001
+		}
+		
+	}
+	
+	
+	
+	#### accumulation ###
+	c.acc <- grep("acc.fac_", c.names)
+	# rivers.all6[rivers.all6$outflow==0,c.acc] <- 1- st_drop_geometry(rivers.all6[rivers.all6$outflow==0,c.clean]) - st_drop_geometry(rivers.all6[rivers.all6$outflow==0,c.resus]) # the rest will be accumulation, causes problems of rounding
+	rivers.all6[rivers.all6$outflow==0,c.acc] <- 1 #can be as high as 1 means that the entire rest will be accumulated.
+	
+	
+	
+	
+	
+	#safe file####
+	extra_name <- "Qmid"
+	c.numeric <- names(select_if(st_drop_geometry(rivers.all6), is.numeric))
+	rivers.all6[ ,c.numeric] <- round(st_drop_geometry(rivers.all6[ , c.numeric]), digits = 10) #round numbers to avoid problems
+	save(rivers.all6,extra_name, file = paste0(main.path, "temp_data/rivers_all6_", extra_name, ".Rdata"))
+	
+	
+	
+	rm(list = ls())	
+	
+	
+	
+	###################################################################
+	#path to sub-folders
+	setwd("~/")
+	main.path <- "PhD/mennekes2.0/"
+	# 
+	# 
+	#polymers
+	polymers <- c("LDPE", "HDPE", "PP", "PS", "EPS", "PVC", "PET")
+	
+	###############################
+	# scenario Qhigh           ####
+	###############################
+	
+	###############################
+	# load data
+	###############################
+	
+	# # load river data
+	load(paste0(main.path, "temp_data/rivers_all5_2.Rdata"))
+	rivers.all6 <- rivers.all5
+	rm(rivers.all5)
+	
+	#load factors for river
+	load(paste0(main.path, "temp_data/factor_rivers_MaP.Rdata")) #high middle low
+	
+	fac_rivers["zero"] <- 0 #add a value for no change
+	
+	
+	
+	
+	#############
+	# define factors
+	#############
+	
+	
+	# add all data to rivers.calc
+	
+	for (i in polymers) {
+		a <- as.data.frame(matrix(0, nrow = nrow(rivers.all6), ncol = 5))
+		names(a) <- c(paste0("sed.fac_", i, "_MaP"), 
+									paste0("removal.fac_", i, "_MaP"),
+									paste0("acc.fac_", i, "_MaP"),
+									paste0("clean.fac_", i, "_MaP"),
+									paste0("resus.fac_", i, "_MaP"))
+		
+		rivers.all6 <- cbind(rivers.all6, a)
+		rm(a)
+	}
+	
+	c.names <- names(rivers.all6)
+	r.rivers <- which(rivers.all6$isLake==F & rivers.all6$outflow == 0)	
+	
+	
+	
+	
+	##### sedimentation######
+	#------------------#
+	
+	c.sed <- grep("sed.fac_", c.names) #columns with name sedimentation
+	
+	
+	### rivers ###
+	#create dataframe to calculate factor
+	df01 <- st_drop_geometry(rivers.all6 %>% select(id_all,discharge, isLake, isDam, forest, rocks, unknown, urban, agriculture, glacier, water, meandering_factor))
+	
+	
+	# for rivers ###
+	#create factors for each category for sedimentation: landuse, sinuosity, discharge
+	
+	df01$fac_sed_landuse <- 0
+	df01$fac_sed_sinuosity <- 0
+	df01$fac_sed_discharge <- 0
+	
+	# for landuse:
+	#apply the landuse factors high, middle, low according to the groupping of landuse
+	# forest, agriculture -> high
+	# rocks, unknown (grassland) -> mid
+	# urban -> low
+	# water, glacier -> zero (=0)
+	
+	df01$fac_sed_landuse <- df01$forest*fac_rivers["high"]+df01$agriculture*fac_rivers["high"]+
+		df01$rocks*fac_rivers["mid"]+df01$unknown*fac_rivers["mid"]+
+		df01$urban*fac_rivers["low"]+
+		df01$water*fac_rivers["zero"]+df01$glacier*fac_rivers["zero"]
+	df01$fac_sed_landuse[is.na(df01$fac_sed_landuse)] <- fac_rivers["zero"] #replace NA with zero value
+	
+	# for discharge
+	# 1.) find theoretical max distance dmax
+	# case different equation for discharge below = 0.3 and over 0.3
+	df01$dmax[df01$discharge<= 0.3] <- 3333*df01$discharge[df01$discharge<= 0.3] #for discharge <= 0.3
+	df01$dmax[df01$discharge> 0.3] <- 330*df01$discharge[df01$discharge> 0.3]+901 #for discharge >0.3
+	
+	#2. use dmax to calculate factor x in the for one step (x = log(0.05)/ dmax)
+	df01$x <- -(log(0.05) / df01$dmax)
+	
+	#3.) find fac for 1 time step -> f(x) = 1-exp(1)^(-x * 1)
+	df01$fac_sed_discharge <- (1-exp(1)^(-df01$x*1))
+	
+	
+	# for sinuosity
+	# apply equation based on Newbould 2021
+	df01$fac_sed_sinuosity <- (1-(1/(df01$meandering_factor)^0.3))*0.1
+	
+	
+	#use df01 for rivers in river.all6 data
+	# df01$sum <- 1-(1-df01$fac_sed_landuse)*(1-df01$fac_sed_discharge)*(1-df01$fac_sed_sinuosity)
+	df01$sum <- 1-(1-df01$fac_sed_discharge)
+	# summary(df01)
+	
+	# bring numbers to rivers.all6 and apply neg. compound interest eq.
+	#for rivers only!
+	rivers.all6[r.rivers, c.sed] <- ((1 - df01$sum[r.rivers])^rivers.all6$length_m[r.rivers])
+	
+	
+	#manipulate:
+	rivers.all6[r.rivers, c.sed] <- st_drop_geometry(rivers.all6[r.rivers, c.sed])*2
+	
+	#5% min water contamination
+	for (i in c.sed) {
+		over95 <- which(st_drop_geometry(rivers.all6[ , i]) > 0.95000000000000001)
+		if(length(over95) > 0){
+			rivers.all6[over95, i] <- 0.95000000000000001
+		}
+		
+	}
+	
+	
+	
+	
+	
+	#### accumulation ###
+	c.acc <- grep("acc.fac_", c.names)
+	# rivers.all6[rivers.all6$outflow==0,c.acc] <- 1- st_drop_geometry(rivers.all6[rivers.all6$outflow==0,c.clean]) - st_drop_geometry(rivers.all6[rivers.all6$outflow==0,c.resus]) # the rest will be accumulation, causes problems of rounding
+	rivers.all6[rivers.all6$outflow==0,c.acc] <- 1 #can be as high as 1 means that the entire rest will be accumulated.
+	
+	
+	
+	
+	
+	#safe file####
+	extra_name <- "Qhigh"
+	c.numeric <- names(select_if(st_drop_geometry(rivers.all6), is.numeric))
+	rivers.all6[ ,c.numeric] <- round(st_drop_geometry(rivers.all6[ , c.numeric]), digits = 10) #round numbers to avoid problems
+	save(rivers.all6,extra_name, file = paste0(main.path, "temp_data/rivers_all6_", extra_name, ".Rdata"))
+	
+	
+	
+	rm(list = ls())	
+	
+	
+	
+	
+	###################################################################
+	#path to sub-folders
+	setwd("~/")
+	main.path <- "PhD/mennekes2.0/"
+	# 
+	# 
+	#polymers
+	polymers <- c("LDPE", "HDPE", "PP", "PS", "EPS", "PVC", "PET")
+	
+	###############################
+	# scenario Slow           ####
+	###############################
+	
+	###############################
+	# load data
+	###############################
+	
+	# # load river data
+	load(paste0(main.path, "temp_data/rivers_all5_2.Rdata"))
+	rivers.all6 <- rivers.all5
+	rm(rivers.all5)
+	
+	#load factors for river
+	load(paste0(main.path, "temp_data/factor_rivers_MaP.Rdata")) #high middle low
+	
+	fac_rivers["zero"] <- 0 #add a value for no change
+	
+	
+	
+	
+	#############
+	# define factors
+	#############
+	
+	
+	# add all data to rivers.calc
+	
+	for (i in polymers) {
+		a <- as.data.frame(matrix(0, nrow = nrow(rivers.all6), ncol = 5))
+		names(a) <- c(paste0("sed.fac_", i, "_MaP"), 
+									paste0("removal.fac_", i, "_MaP"),
+									paste0("acc.fac_", i, "_MaP"),
+									paste0("clean.fac_", i, "_MaP"),
+									paste0("resus.fac_", i, "_MaP"))
+		
+		rivers.all6 <- cbind(rivers.all6, a)
+		rm(a)
+	}
+	
+	c.names <- names(rivers.all6)
+	r.rivers <- which(rivers.all6$isLake==F & rivers.all6$outflow == 0)	
+	
+	
+	
+	
+	##### sedimentation######
+	#------------------#
+	
+	c.sed <- grep("sed.fac_", c.names) #columns with name sedimentation
+	
+	
+	### rivers ###
+	#create dataframe to calculate factor
+	df01 <- st_drop_geometry(rivers.all6 %>% select(id_all,discharge, isLake, isDam, forest, rocks, unknown, urban, agriculture, glacier, water, meandering_factor))
+	
+	
+	# for rivers ###
+	#create factors for each category for sedimentation: landuse, sinuosity, discharge
+	
+	df01$fac_sed_landuse <- 0
+	df01$fac_sed_sinuosity <- 0
+	df01$fac_sed_discharge <- 0
+	
+	# for landuse:
+	#apply the landuse factors high, middle, low according to the groupping of landuse
+	# forest, agriculture -> high
+	# rocks, unknown (grassland) -> mid
+	# urban -> low
+	# water, glacier -> zero (=0)
+	
+	df01$fac_sed_landuse <- df01$forest*fac_rivers["high"]+df01$agriculture*fac_rivers["high"]+
+		df01$rocks*fac_rivers["mid"]+df01$unknown*fac_rivers["mid"]+
+		df01$urban*fac_rivers["low"]+
+		df01$water*fac_rivers["zero"]+df01$glacier*fac_rivers["zero"]
+	df01$fac_sed_landuse[is.na(df01$fac_sed_landuse)] <- fac_rivers["zero"] #replace NA with zero value
+	
+	# for discharge
+	# 1.) find theoretical max distance dmax
+	# case different equation for discharge below = 0.3 and over 0.3
+	df01$dmax[df01$discharge<= 0.3] <- 3333*df01$discharge[df01$discharge<= 0.3] #for discharge <= 0.3
+	df01$dmax[df01$discharge> 0.3] <- 330*df01$discharge[df01$discharge> 0.3]+901 #for discharge >0.3
+	
+	#2. use dmax to calculate factor x in the for one step (x = log(0.05)/ dmax)
+	df01$x <- -(log(0.05) / df01$dmax)
+	
+	#3.) find fac for 1 time step -> f(x) = 1-exp(1)^(-x * 1)
+	df01$fac_sed_discharge <- 1-exp(1)^(-df01$x*1)
+	
+	
+	# for sinuosity
+	# apply equation based on Newbould 2021
+	df01$fac_sed_sinuosity <- (1-(1/(df01$meandering_factor)^0.3))*0.1
+	
+	
+
+	
+	#use df01 for rivers in river.all6 data
+	# df01$sum <- 1-(1-df01$fac_sed_landuse)*(1-df01$fac_sed_discharge)*(1-df01$fac_sed_sinuosity)
+	df01$sum <- 1-(1-df01$fac_sed_sinuosity)
+	# summary(df01)
+	
+	# bring numbers to rivers.all6 and apply neg. compound interest eq.
+	#for rivers only!
+	rivers.all6[r.rivers, c.sed] <- ((1 - df01$sum[r.rivers])^rivers.all6$length_m[r.rivers])
+	
+	
+	#manipulate:
+	rivers.all6[r.rivers, c.sed] <- st_drop_geometry(rivers.all6[r.rivers, c.sed])*0.5
+	
+	#5% min water contamination
+	for (i in c.sed) {
+		over95 <- which(st_drop_geometry(rivers.all6[ , i]) > 0.95000000000000001)
+		if(length(over95) > 0){
+			rivers.all6[over95, i] <- 0.95000000000000001
+		}
+		
+	}
+	
+	
+	
+	
+	
+	#### accumulation ###
+	c.acc <- grep("acc.fac_", c.names)
+	# rivers.all6[rivers.all6$outflow==0,c.acc] <- 1- st_drop_geometry(rivers.all6[rivers.all6$outflow==0,c.clean]) - st_drop_geometry(rivers.all6[rivers.all6$outflow==0,c.resus]) # the rest will be accumulation, causes problems of rounding
+	rivers.all6[rivers.all6$outflow==0,c.acc] <- 1 #can be as high as 1 means that the entire rest will be accumulated.
+	
+	
+	
+	
+	
+	#safe file####
+	extra_name <- "Slow"
+	c.numeric <- names(select_if(st_drop_geometry(rivers.all6), is.numeric))
+	rivers.all6[ ,c.numeric] <- round(st_drop_geometry(rivers.all6[ , c.numeric]), digits = 10) #round numbers to avoid problems
+	save(rivers.all6,extra_name, file = paste0(main.path, "temp_data/rivers_all6_", extra_name, ".Rdata"))
+	
+	
+	
+	rm(list = ls())	
+	
+	
+	
+	
+	###################################################################
+	#path to sub-folders
+	setwd("~/")
+	main.path <- "PhD/mennekes2.0/"
+	# 
+	# 
+	#polymers
+	polymers <- c("LDPE", "HDPE", "PP", "PS", "EPS", "PVC", "PET")
+	
+	###############################
+	# scenario Smid           ####
+	###############################
+	
+	###############################
+	# load data
+	###############################
+	
+	# # load river data
+	load(paste0(main.path, "temp_data/rivers_all5_2.Rdata"))
+	rivers.all6 <- rivers.all5
+	rm(rivers.all5)
+	
+	#load factors for river
+	load(paste0(main.path, "temp_data/factor_rivers_MaP.Rdata")) #high middle low
+	
+	fac_rivers["zero"] <- 0 #add a value for no change
+	
+	
+	
+	
+	#############
+	# define factors
+	#############
+	
+	
+	# add all data to rivers.calc
+	
+	for (i in polymers) {
+		a <- as.data.frame(matrix(0, nrow = nrow(rivers.all6), ncol = 5))
+		names(a) <- c(paste0("sed.fac_", i, "_MaP"), 
+									paste0("removal.fac_", i, "_MaP"),
+									paste0("acc.fac_", i, "_MaP"),
+									paste0("clean.fac_", i, "_MaP"),
+									paste0("resus.fac_", i, "_MaP"))
+		
+		rivers.all6 <- cbind(rivers.all6, a)
+		rm(a)
+	}
+	
+	c.names <- names(rivers.all6)
+	r.rivers <- which(rivers.all6$isLake==F & rivers.all6$outflow == 0)	
+	
+	
+	
+	
+	##### sedimentation######
+	#------------------#
+	
+	c.sed <- grep("sed.fac_", c.names) #columns with name sedimentation
+	
+	
+	### rivers ###
+	#create dataframe to calculate factor
+	df01 <- st_drop_geometry(rivers.all6 %>% select(id_all,discharge, isLake, isDam, forest, rocks, unknown, urban, agriculture, glacier, water, meandering_factor))
+	
+	
+	# for rivers ###
+	#create factors for each category for sedimentation: landuse, sinuosity, discharge
+	
+	df01$fac_sed_landuse <- 0
+	df01$fac_sed_sinuosity <- 0
+	df01$fac_sed_discharge <- 0
+	
+	# for landuse:
+	#apply the landuse factors high, middle, low according to the groupping of landuse
+	# forest, agriculture -> high
+	# rocks, unknown (grassland) -> mid
+	# urban -> low
+	# water, glacier -> zero (=0)
+	
+	df01$fac_sed_landuse <- df01$forest*fac_rivers["high"]+df01$agriculture*fac_rivers["high"]+
+		df01$rocks*fac_rivers["mid"]+df01$unknown*fac_rivers["mid"]+
+		df01$urban*fac_rivers["low"]+
+		df01$water*fac_rivers["zero"]+df01$glacier*fac_rivers["zero"]
+	df01$fac_sed_landuse[is.na(df01$fac_sed_landuse)] <- fac_rivers["zero"] #replace NA with zero value
+	
+	# for discharge
+	# 1.) find theoretical max distance dmax
+	# case different equation for discharge below = 0.3 and over 0.3
+	df01$dmax[df01$discharge<= 0.3] <- 3333*df01$discharge[df01$discharge<= 0.3] #for discharge <= 0.3
+	df01$dmax[df01$discharge> 0.3] <- 330*df01$discharge[df01$discharge> 0.3]+901 #for discharge >0.3
+	
+	#2. use dmax to calculate factor x in the for one step (x = log(0.05)/ dmax)
+	df01$x <- -(log(0.05) / df01$dmax)
+	
+	#3.) find fac for 1 time step -> f(x) = 1-exp(1)^(-x * 1)
+	df01$fac_sed_discharge <- 1-exp(1)^(-df01$x*1)
+	
+	
+	# for sinuosity
+	# apply equation based on Newbould 2021
+	df01$fac_sed_sinuosity <- (1-(1/(df01$meandering_factor)^0.3))*0.1
+	
+	
+
+	
+	#use df01 for rivers in river.all6 data
+	# df01$sum <- 1-(1-df01$fac_sed_landuse)*(1-df01$fac_sed_discharge)*(1-df01$fac_sed_sinuosity)
+	df01$sum <- 1-(1-df01$fac_sed_sinuosity)
+	# summary(df01)
+	
+	# bring numbers to rivers.all6 and apply neg. compound interest eq.
+	#for rivers only!
+	rivers.all6[r.rivers, c.sed] <- ((1 - df01$sum[r.rivers])^rivers.all6$length_m[r.rivers])
+	
+	
+	#5% min water contamination
+	for (i in c.sed) {
+		over95 <- which(st_drop_geometry(rivers.all6[ , i]) > 0.95000000000000001)
+		if(length(over95) > 0){
+			rivers.all6[over95, i] <- 0.95000000000000001
+		}
+		
+	}
+	
+	
+	
+	
+	
+	#### accumulation ###
+	c.acc <- grep("acc.fac_", c.names)
+	# rivers.all6[rivers.all6$outflow==0,c.acc] <- 1- st_drop_geometry(rivers.all6[rivers.all6$outflow==0,c.clean]) - st_drop_geometry(rivers.all6[rivers.all6$outflow==0,c.resus]) # the rest will be accumulation, causes problems of rounding
+	rivers.all6[rivers.all6$outflow==0,c.acc] <- 1 #can be as high as 1 means that the entire rest will be accumulated.
+	
+	
+	
+	
+	
+	#safe file####
+	extra_name <- "Smid"
+	c.numeric <- names(select_if(st_drop_geometry(rivers.all6), is.numeric))
+	rivers.all6[ ,c.numeric] <- round(st_drop_geometry(rivers.all6[ , c.numeric]), digits = 10) #round numbers to avoid problems
+	save(rivers.all6,extra_name, file = paste0(main.path, "temp_data/rivers_all6_", extra_name, ".Rdata"))
+	
+	
+	
+	rm(list = ls())	
+	
+	
+	
+	
+	###################################################################
+	#path to sub-folders
+	setwd("~/")
+	main.path <- "PhD/mennekes2.0/"
+	# 
+	# 
+	#polymers
+	polymers <- c("LDPE", "HDPE", "PP", "PS", "EPS", "PVC", "PET")
+	
+	###############################
+	# scenario Shigh          ####
+	###############################
+	
+	###############################
+	# load data
+	###############################
+	
+	# # load river data
+	load(paste0(main.path, "temp_data/rivers_all5_2.Rdata"))
+	rivers.all6 <- rivers.all5
+	rm(rivers.all5)
+	
+	#load factors for river
+	load(paste0(main.path, "temp_data/factor_rivers_MaP.Rdata")) #high middle low
+	
+	fac_rivers["zero"] <- 0 #add a value for no change
+	
+	
+	
+	
+	#############
+	# define factors
+	#############
+	
+	
+	# add all data to rivers.calc
+	
+	for (i in polymers) {
+		a <- as.data.frame(matrix(0, nrow = nrow(rivers.all6), ncol = 5))
+		names(a) <- c(paste0("sed.fac_", i, "_MaP"), 
+									paste0("removal.fac_", i, "_MaP"),
+									paste0("acc.fac_", i, "_MaP"),
+									paste0("clean.fac_", i, "_MaP"),
+									paste0("resus.fac_", i, "_MaP"))
+		
+		rivers.all6 <- cbind(rivers.all6, a)
+		rm(a)
+	}
+	
+	c.names <- names(rivers.all6)
+	r.rivers <- which(rivers.all6$isLake==F & rivers.all6$outflow == 0)	
+	
+	
+	
+	
+	##### sedimentation######
+	#------------------#
+	
+	c.sed <- grep("sed.fac_", c.names) #columns with name sedimentation
+	
+	
+	### rivers ###
+	#create dataframe to calculate factor
+	df01 <- st_drop_geometry(rivers.all6 %>% select(id_all,discharge, isLake, isDam, forest, rocks, unknown, urban, agriculture, glacier, water, meandering_factor))
+	
+	
+	# for rivers ###
+	#create factors for each category for sedimentation: landuse, sinuosity, discharge
+	
+	df01$fac_sed_landuse <- 0
+	df01$fac_sed_sinuosity <- 0
+	df01$fac_sed_discharge <- 0
+	
+	# for landuse:
+	#apply the landuse factors high, middle, low according to the groupping of landuse
+	# forest, agriculture -> high
+	# rocks, unknown (grassland) -> mid
+	# urban -> low
+	# water, glacier -> zero (=0)
+	
+	df01$fac_sed_landuse <- df01$forest*fac_rivers["high"]+df01$agriculture*fac_rivers["high"]+
+		df01$rocks*fac_rivers["mid"]+df01$unknown*fac_rivers["mid"]+
+		df01$urban*fac_rivers["low"]+
+		df01$water*fac_rivers["zero"]+df01$glacier*fac_rivers["zero"]
+	df01$fac_sed_landuse[is.na(df01$fac_sed_landuse)] <- fac_rivers["zero"] #replace NA with zero value
+	
+	# for discharge
+	# 1.) find theoretical max distance dmax
+	# case different equation for discharge below = 0.3 and over 0.3
+	df01$dmax[df01$discharge<= 0.3] <- 3333*df01$discharge[df01$discharge<= 0.3] #for discharge <= 0.3
+	df01$dmax[df01$discharge> 0.3] <- 330*df01$discharge[df01$discharge> 0.3]+901 #for discharge >0.3
+	
+	#2. use dmax to calculate factor x in the for one step (x = log(0.05)/ dmax)
+	df01$x <- -(log(0.05) / df01$dmax)
+	
+	#3.) find fac for 1 time step -> f(x) = 1-exp(1)^(-x * 1)
+	df01$fac_sed_discharge <- 1-exp(1)^(-df01$x*1)
+	
+	
+	# for sinuosity
+	# apply equation based on Newbould 2021
+	df01$fac_sed_sinuosity <- (1-(1/(df01$meandering_factor)^0.3))*0.1
+	
+	
+	#use df01 for rivers in river.all6 data
+	# df01$sum <- 1-(1-df01$fac_sed_landuse)*(1-df01$fac_sed_discharge)*(1-df01$fac_sed_sinuosity)
+	df01$sum <- 1-(1-df01$fac_sed_sinuosity)
+	# summary(df01)
+	
+	# bring numbers to rivers.all6 and apply neg. compound interest eq.
+	#for rivers only!
+	rivers.all6[r.rivers, c.sed] <- ((1 - df01$sum[r.rivers])^rivers.all6$length_m[r.rivers])
+	
+	
+	#manipulate:
+	rivers.all6[r.rivers, c.sed] <- st_drop_geometry(rivers.all6[r.rivers, c.sed])*2
+	Sys.sleep(3)
+	
+	#5% min water contamination
+	for (i in c.sed) {
+		over95 <- which(st_drop_geometry(rivers.all6[ , i]) > 0.95000000000000001)
+		if(length(over95) > 0){
+			rivers.all6[over95, i] <- 0.95000000000000001
+		}
+		
+	}
+	
+	
+	
+	
+	
+	#### accumulation ###
+	c.acc <- grep("acc.fac_", c.names)
+	# rivers.all6[rivers.all6$outflow==0,c.acc] <- 1- st_drop_geometry(rivers.all6[rivers.all6$outflow==0,c.clean]) - st_drop_geometry(rivers.all6[rivers.all6$outflow==0,c.resus]) # the rest will be accumulation, causes problems of rounding
+	rivers.all6[rivers.all6$outflow==0,c.acc] <- 1 #can be as high as 1 means that the entire rest will be accumulated.
+	
+	
+	
+	
+	
+	#safe file####
+	extra_name <- "Shigh"
+	c.numeric <- names(select_if(st_drop_geometry(rivers.all6), is.numeric))
+	rivers.all6[ ,c.numeric] <- round(st_drop_geometry(rivers.all6[ , c.numeric]), digits = 10) #round numbers to avoid problems
+	save(rivers.all6,extra_name, file = paste0(main.path, "temp_data/rivers_all6_", extra_name, ".Rdata"))
+	
+	
+	
+	rm(list = ls())	
+	
+	
+	
+	
+	###################################################################
+	#path to sub-folders
+	setwd("~/")
+	main.path <- "PhD/mennekes2.0/"
+	# 
+	# 
+	#polymers
+	polymers <- c("LDPE", "HDPE", "PP", "PS", "EPS", "PVC", "PET")
+	
+	###############################
+	# scenario low_all ####
+	###############################
+	
+	###############################
+	# load data
+	###############################
+	
+	# # load river data
+	load(paste0(main.path, "temp_data/rivers_all5_2.Rdata"))
+	rivers.all6 <- rivers.all5
+	rm(rivers.all5)
+	
+	#load factors for river
+	load(paste0(main.path, "temp_data/factor_rivers_MaP.Rdata")) #high middle low
+	
+	fac_rivers["zero"] <- 0 #add a value for no change
+	
+	
+	
+	
+	#############
+	# define factors
+	#############
+	
+	
+	# add all data to rivers.calc
+	
+	for (i in polymers) {
+		a <- as.data.frame(matrix(0, nrow = nrow(rivers.all6), ncol = 5))
+		names(a) <- c(paste0("sed.fac_", i, "_MaP"), 
+									paste0("removal.fac_", i, "_MaP"),
+									paste0("acc.fac_", i, "_MaP"),
+									paste0("clean.fac_", i, "_MaP"),
+									paste0("resus.fac_", i, "_MaP"))
+		
+		rivers.all6 <- cbind(rivers.all6, a)
+		rm(a)
+	}
+	
+	c.names <- names(rivers.all6)
+	r.rivers <- which(rivers.all6$isLake==F & rivers.all6$outflow == 0)	
+	
+	##### removal #####
+	c.removal <- grep("removal.fac_", c.names)
+	rivers.all6[rivers.all6$isDam==T, c.removal] <- 0.05000000000000001 #for all dams assume a removal rate of 75% accross all polymers
+	
+	
+	
+	##### sedimentation######
+	#------------------#
+	
+	c.sed <- grep("sed.fac_", c.names) #columns with name sedimentation
+	
+	
+	### rivers ###
+	#create dataframe to calculate factor
+	df01 <- st_drop_geometry(rivers.all6 %>% select(id_all,discharge, isLake, isDam, forest, rocks, unknown, urban, agriculture, glacier, water, meandering_factor))
+	
+	
+	# for rivers ###
+	#create factors for each category for sedimentation: landuse, sinuosity, discharge
+	
+	df01$fac_sed_landuse <- 0
+	df01$fac_sed_sinuosity <- 0
+	df01$fac_sed_discharge <- 0
+	
+	# for landuse:
+	#apply the landuse factors high, middle, low according to the groupping of landuse
+	# forest, agriculture -> high
+	# rocks, unknown (grassland) -> mid
+	# urban -> low
+	# water, glacier -> zero (=0)
+	
+	df01$fac_sed_landuse <- df01$forest*fac_rivers["high"]+df01$agriculture*fac_rivers["high"]+
+		df01$rocks*fac_rivers["mid"]+df01$unknown*fac_rivers["mid"]+
+		df01$urban*fac_rivers["low"]+
+		df01$water*fac_rivers["zero"]+df01$glacier*fac_rivers["zero"]
+	df01$fac_sed_landuse[is.na(df01$fac_sed_landuse)] <- fac_rivers["zero"] #replace NA with zero value
+	
+	# for discharge
+	# 1.) find theoretical max distance dmax
+	# case different equation for discharge below = 0.3 and over 0.3
+	df01$dmax[df01$discharge<= 0.3] <- 3333*df01$discharge[df01$discharge<= 0.3] #for discharge <= 0.3
+	df01$dmax[df01$discharge> 0.3] <- 330*df01$discharge[df01$discharge> 0.3]+901 #for discharge >0.3
+	
+	#2. use dmax to calculate factor x in the for one step (x = log(0.05)/ dmax)
+	df01$x <- -(log(0.05) / df01$dmax)
+	
+	#3.) find fac for 1 time step -> f(x) = 1-exp(1)^(-x * 1)
+	df01$fac_sed_discharge <- 1-exp(1)^(-df01$x*1)
+	
+	
+	# for sinuosity
+	# apply equation based on Newbould 2021
+	df01$fac_sed_sinuosity <- (1-(1/(df01$meandering_factor)^0.3))*0.1
+	
+	
+	
+	#use df01 for rivers in river.all6 data
+	df01$sum <- 1-(1-df01$fac_sed_landuse)*(1-df01$fac_sed_discharge)*(1-df01$fac_sed_sinuosity)
+	# summary(df01)
+	
+	# bring numbers to rivers.all6 and apply neg. compound interest eq.
+	#for rivers only!
+	rivers.all6[r.rivers, c.sed] <- ((1 - df01$sum[r.rivers])^rivers.all6$length_m[r.rivers])
+	
+	#manipulate
+	rivers.all6[r.rivers, c.sed] <- st_drop_geometry(rivers.all6[r.rivers, c.sed]*0.5)
+	
+	
+	### lakes ###
+	r.lakes <- which(rivers.all6$isLake == T)
+	
+	rivers.all6[r.lakes, c.sed] <- 0.05000000000000001 #lakes = 5%
+	
+	
+	#5% min water contamination (max sed = 0.95000000000000001)
+	for (i in c.sed) {
+		over95 <- which(st_drop_geometry(rivers.all6[ , i]) > 0.95000000000000001)
+		if(length(over95) > 0){
+			rivers.all6[over95, i] <- 0.95000000000000001
+		}
+		
+	}
+	
+	
+	##### cleaning####
+	c.clean <- grep("clean.fac_", c.names)
+	rivers.all6[ , c.clean] <- 0.0
+	
+	
+	#### resus ##
+	c.resus <- grep("resus.fac_", c.names)
+	rivers.all6[r.rivers, c.resus] <- 0.20000000000000001 #for all rivers 20%
+	rivers.all6[r.lakes, c.resus] <- 0 #for all lakes 0%; is included in sedimentation
+	
+	
+	
+	#### accumulation ###
+	c.acc <- grep("acc.fac_", c.names)
+	# rivers.all6[rivers.all6$outflow==0,c.acc] <- 1- st_drop_geometry(rivers.all6[rivers.all6$outflow==0,c.clean]) - st_drop_geometry(rivers.all6[rivers.all6$outflow==0,c.resus]) # the rest will be accumulation, causes problems of rounding
+	rivers.all6[rivers.all6$outflow==0,c.acc] <- 1 #can be as high as 1 means that the entire rest will be accumulated.
+	
+	#warning if sed. factors are 1 or higher
+	if(length(which(rivers.all6$sed.fac_PET_MaP >= 1)) >=1){
+		warning("sedimentation factors are 1 or higher!")
+		break
+	}
+	
+	
+	#safe file####
+	extra_name <- "low_all"
+	c.numeric <- names(select_if(st_drop_geometry(rivers.all6), is.numeric))
+	rivers.all6[ ,c.numeric] <- round(st_drop_geometry(rivers.all6[ , c.numeric]), digits = 10) #round numbers to avoid problems
+	save(rivers.all6,extra_name, file = paste0(main.path, "temp_data/rivers_all6_", extra_name, ".Rdata"))
+	
+	
+	
+	rm(list = ls())	
+	
+	
+	
+	
+	
+	
+	
+	###################################################################
+	#path to sub-folders
+	setwd("~/")
+	main.path <- "PhD/mennekes2.0/"
+	# 
+	# 
+	#polymers
+	polymers <- c("LDPE", "HDPE", "PP", "PS", "EPS", "PVC", "PET")
+	
+	###############################
+	# scenario high_all ####
+	###############################
+	
+	###############################
+	# load data
+	###############################
+	
+	# # load river data
+	load(paste0(main.path, "temp_data/rivers_all5_2.Rdata"))
+	rivers.all6 <- rivers.all5
+	rm(rivers.all5)
+	
+	#load factors for river
+	load(paste0(main.path, "temp_data/factor_rivers_MaP.Rdata")) #high middle low
+	
+	fac_rivers["zero"] <- 0 #add a value for no change
+	
+	
+	
+	
+	#############
+	# define factors
+	#############
+	
+	
+	# add all data to rivers.calc
+	
+	for (i in polymers) {
+		a <- as.data.frame(matrix(0, nrow = nrow(rivers.all6), ncol = 5))
+		names(a) <- c(paste0("sed.fac_", i, "_MaP"), 
+									paste0("removal.fac_", i, "_MaP"),
+									paste0("acc.fac_", i, "_MaP"),
+									paste0("clean.fac_", i, "_MaP"),
+									paste0("resus.fac_", i, "_MaP"))
+		
+		rivers.all6 <- cbind(rivers.all6, a)
+		rm(a)
+	}
+	
+	c.names <- names(rivers.all6)
+	r.rivers <- which(rivers.all6$isLake==F & rivers.all6$outflow == 0)	
+	
+	##### removal #####
+	c.removal <- grep("removal.fac_", c.names)
+	rivers.all6[rivers.all6$isDam==T, c.removal] <- 0.95000000000000001 #for all dams assume a 
+	
+	
+	
+	##### sedimentation######
+	#------------------#
+	
+	c.sed <- grep("sed.fac_", c.names) #columns with name sedimentation
+	
+	
+	### rivers ###
+	#create dataframe to calculate factor
+	df01 <- st_drop_geometry(rivers.all6 %>% select(id_all,discharge, isLake, isDam, forest, rocks, unknown, urban, agriculture, glacier, water, meandering_factor))
+	
+	
+	# for rivers ###
+	#create factors for each category for sedimentation: landuse, sinuosity, discharge
+	
+	df01$fac_sed_landuse <- 0
+	df01$fac_sed_sinuosity <- 0
+	df01$fac_sed_discharge <- 0
+	
+	# for landuse:
+	#apply the landuse factors high, middle, low according to the groupping of landuse
+	# forest, agriculture -> high
+	# rocks, unknown (grassland) -> mid
+	# urban -> low
+	# water, glacier -> zero (=0)
+	
+	df01$fac_sed_landuse <- df01$forest*fac_rivers["high"]+df01$agriculture*fac_rivers["high"]+
+		df01$rocks*fac_rivers["mid"]+df01$unknown*fac_rivers["mid"]+
+		df01$urban*fac_rivers["low"]+
+		df01$water*fac_rivers["zero"]+df01$glacier*fac_rivers["zero"]
+	df01$fac_sed_landuse[is.na(df01$fac_sed_landuse)] <- fac_rivers["zero"] #replace NA with zero value
+	
+	# for discharge
+	# 1.) find theoretical max distance dmax
+	# case different equation for discharge below = 0.3 and over 0.3
+	df01$dmax[df01$discharge<= 0.3] <- 3333*df01$discharge[df01$discharge<= 0.3] #for discharge <= 0.3
+	df01$dmax[df01$discharge> 0.3] <- 330*df01$discharge[df01$discharge> 0.3]+901 #for discharge >0.3
+	
+	#2. use dmax to calculate factor x in the for one step (x = log(0.05)/ dmax)
+	df01$x <- -(log(0.05) / df01$dmax)
+	
+	#3.) find fac for 1 time step -> f(x) = 1-exp(1)^(-x * 1)
+	df01$fac_sed_discharge <- 1-exp(1)^(-df01$x*1)
+	
+	
+	# for sinuosity
+	# apply equation based on Newbould 2021
+	df01$fac_sed_sinuosity <- (1-(1/(df01$meandering_factor)^0.3))*0.1
+	
+	
+	
+	#use df01 for rivers in river.all6 data
+	df01$sum <- 1-(1-df01$fac_sed_landuse)*(1-df01$fac_sed_discharge)*(1-df01$fac_sed_sinuosity)
+	# summary(df01)
+	
+	# bring numbers to rivers.all6 and apply neg. compound interest eq.
+	#for rivers only!
+	rivers.all6[r.rivers, c.sed] <- ((1 - df01$sum[r.rivers])^rivers.all6$length_m[r.rivers])
+	
+	#manipulate
+	rivers.all6[r.rivers, c.sed] <- st_drop_geometry(rivers.all6[r.rivers, c.sed]*2)#double all values
+	
+	
+	
+	### lakes ###
+	r.lakes <- which(rivers.all6$isLake == T)
+	
+	rivers.all6[r.lakes, c.sed] <- 0.95000000000000001 #lakes = 95%
+	
+	
+	#5% min water contamination (max sed = 0.95000000000000001)
+	for (i in c.sed) {
+		over95 <- which(st_drop_geometry(rivers.all6[ , i]) > 0.95000000000000001)
+		if(length(over95) > 0){
+			rivers.all6[over95, i] <- 0.95000000000000001
+		}
+		
+	}
+	
+	
+	##### cleaning####
+	c.clean <- grep("clean.fac_", c.names)
+	rivers.all6[ , c.clean] <- 0.0
+	
+	
+	
+	#### resus ##
+	c.resus <- grep("resus.fac_", c.names)
+	rivers.all6[r.rivers, c.resus] <- 0.20000000000000001 #for all rivers 20%
+	rivers.all6[r.lakes, c.resus] <- 0 #for all lakes 0%; is included in sedimentation
+	
+	
+	
+	#### accumulation ###
+	c.acc <- grep("acc.fac_", c.names)
+	# rivers.all6[rivers.all6$outflow==0,c.acc] <- 1- st_drop_geometry(rivers.all6[rivers.all6$outflow==0,c.clean]) - st_drop_geometry(rivers.all6[rivers.all6$outflow==0,c.resus]) # the rest will be accumulation, causes problems of rounding
+	rivers.all6[rivers.all6$outflow==0,c.acc] <- 1 #can be as high as 1 means that the entire rest will be accumulated.
+	
+	#warning if sed. factors are 1 or higher
+	if(length(which(rivers.all6$sed.fac_PET_MaP >= 1)) >=1){
+		warning("sedimentation factors are 1 or higher!")
+		break
+	}
+	
+	
+	#safe file####
+	extra_name <- "high_all"
+	c.numeric <- names(select_if(st_drop_geometry(rivers.all6), is.numeric))
+	rivers.all6[ ,c.numeric] <- round(st_drop_geometry(rivers.all6[ , c.numeric]), digits = 10) #round numbers to avoid problems
+	save(rivers.all6,extra_name, file = paste0(main.path, "temp_data/rivers_all6_", extra_name, ".Rdata"))
+	
+	
+	
+	rm(list = ls())	
+	
diff --git a/github_calculation/03.0_run_materialflow_river.R b/github_calculation/03.0_run_materialflow_river.R
new file mode 100644
index 0000000..025f607
--- /dev/null
+++ b/github_calculation/03.0_run_materialflow_river.R
@@ -0,0 +1,344 @@
+######################
+# add data of river / lake contamination and run model
+# unit: g/ s
+# author: david mennekes, PhD Student at Empa St. Gallen / ETH Zürich, Switzerland, david.mennekes@empa.ch
+# march 2023, last edit:
+######################
+
+
+	###############################
+	#packages and path
+	###############################
+
+	library(tidyverse)
+	library(sf)
+	#path to sub-folders
+	# change this path to the directory of the model
+	setwd("~/")
+	main.path <- "PhD/mennekes2.0/" #change!
+	#
+	#
+	#polymers of interest
+	polymers <- c("LDPE", "HDPE", "PP", "PS", "EPS", "PVC", "PET")
+	
+	#important non polymer specific columns that should be saved:
+	#adjust according to your desires
+	save_c <- c("id_all", "flow_to", "outflow", "height_last", "name_river", "slope_percent", "length_m", "length_seconds", "flow_velocity", "isLake", "country", "area", "name_2", "FID_poly_s", "OBJEKTART", "NAME", "VERLAUF", "GEWISS_NR", "LAUF_NR")
+	
+	#scenarios defined in 2.7_factors. Each factor represents a different parameter set-up
+	# extra_names <- c( "_base", "_null", "_weir25", "_weir50", "_weir75")
+	extra_names <- c("_null", "_weir05", "_weir25", "_weir50", "_weir75", "_weir95", "_base", "_baseLakesLinear","_baseLakes05","_baseLakes50","_baseLakes95", "_baseRivers", "_baseRiversnoResus", "_LUlow", "_LUmid", "_LUhigh", "_Qlow", "_Qmid", "_Qhigh", "_Slow", "_Smid", "_Shigh", "_low_all", "_high_all")
+	
+	# extra_names <- c("_base")
+	
+	N <- 801 # number of runs. should be high enough to establish a constant, constant with about 600 for Rhine
+	print_round <- c(801) #rounds which will be saved, should be at least the last round
+
+	###############################
+	# functions
+	###############################
+
+
+	#loop for extra_names
+	# run the model for each scenario / parameter set-up
+	for (xxx in extra_names) {
+		
+
+	###############################
+	# load data
+	###############################
+
+	# # load river data saved in 2.7_factors
+	load(paste0(main.path, "temp_data/rivers_all6", xxx, ".Rdata"))
+
+	rivers.calc <- st_drop_geometry(rivers.all6) #drop geometry for faster calculation / change this if you have a file without geometry in the first time
+	
+	#save geometry in a different file
+	geo <- rivers.all6
+	geo <- rivers.all6[ , "id_all"]
+	names(geo)[1] <- "id_all_geo"
+
+	save(geo, file = paste0(main.path, "temp_data/flow_files/0000_geo.Rdata")) #geometry file without calculations
+
+	rm(geo) #remove file
+	rm(rivers.all6) #remove file
+
+
+
+
+	##############
+	#add data for actual contamination: sum data is yearly flow in to the environment calculated by Delphine in contamination per s and river m for rivers and total for lakes. Mass in g
+	##############
+
+	for(mat in polymers){
+		rivers.calc[ , paste0("actualcon_", mat, "_WaterMaP_concMSV")] <- 0
+	}
+
+	for(mat in polymers){
+		rivers.calc[ , paste0("actualinflow_", mat, "_WaterMaP_concMSV")] <- 0
+	}
+	
+	for(mat in polymers){
+		rivers.calc[ , paste0("actualinflow_sed_", mat, "_WaterMaP_concMSV")] <- 0
+	}
+	
+
+	# for actual accumulation
+	for(mat in polymers){
+		rivers.calc[ , paste0("actualacc_", mat, "_WaterMaP_concMSV")] <- 0
+	}
+	
+	#for actual cleaning
+	for(mat in polymers){
+		rivers.calc[ , paste0("actualclean_", mat, "_WaterMaP_concMSV")] <- 0
+	}
+
+	#for actual removal
+	for(mat in polymers){
+		rivers.calc[ , paste0("actualremoval_", mat, "_WaterMaP_concMSV")] <- 0
+	}
+
+	#actual concentration in sedimentation
+	for(mat in polymers){
+		rivers.calc[ , paste0("actualsed_", mat, "_WaterMaP_concMSV")] <- 0
+	}
+	
+	#for actual resus
+	for(mat in polymers){
+		rivers.calc[ , paste0("actualresus", mat, "_WaterMaP_concMSV")] <- 0
+	}
+
+
+	# find rows which are no outflow and lakes or rivers
+
+	r.rivers <- which(rivers.calc$isLake == F & rivers.calc$outflow == 0)
+	# r.rivers.l <- rivers.calc$isLake == F & rivers.calc$outflow == 0 #for lakes
+
+	r.lakes <- which(rivers.calc$isLake == T)
+
+
+
+
+	#find duplicated numbers, like this the calculation will be faster
+	dup <- unique(rivers.calc$flow_to[duplicated(rivers.calc$flow_to)])
+	multi_flow_to <- rivers.calc$flow_to %in% dup
+	dup_id <- rivers.calc$id_al[multi_flow_to]
+	single_flow_to <- !(multi_flow_to)
+
+	
+	rivers.calc.all <- rivers.calc #transfer data to new data with selected columns
+
+	for (mat in polymers) { #loop for each polymer. 
+		#create name vectors for each polymer
+		#create names sum (yearly outflowin MSV) for macroplastics -> without the ending "MP"
+		MaPw.sum <- paste0("sum_", mat, "_Water_concMSV")
+
+		#inflow from previous section
+		MaPw.in <- paste0("actualinflow_", mat, "_WaterMaP_concMSV")
+		
+		
+		# sediment inflow from previous section
+		MaPw.in_sed <- paste0("actualinflow_sed_", mat, "_WaterMaP_concMSV")
+
+
+
+		#create names accumulation
+		MaPw.acc <- paste0("actualacc_", mat, "_WaterMaP_concMSV")
+
+		#create names removal
+		MaPw.removal <- paste0("actualremoval_", mat, "_WaterMaP_concMSV")
+
+
+		MaPw.clean <- paste0("actualclean_", mat, "_WaterMaP_concMSV")
+		
+		#create names sedimentation
+		MaPw.sed <- paste0("actualsed_", mat, "_WaterMaP_concMSV")
+		
+		MaPw.resus <- paste0("actualresus_", mat, "_WaterMaP_concMSV")
+		
+		#select only columns that are needed
+		c.mat <- grep(paste0(mat, "_"), names(rivers.calc.all))
+		rivers.calc <- rivers.calc.all[, c(save_c, names(rivers.calc.all)[c.mat])]
+
+
+		for (i in 1:N) { #loop for each calculation step
+			# print(i)
+			# create empty container for data
+			temp_MaP <- rep(0, nrow(rivers.calc)) #MaP in suspension
+			
+			temp_MaP_sed <- rep(0, nrow(rivers.calc)) #MaP in sediment
+			
+			
+			# important: the order of calculation is important!
+			# first removal (inflow*removal + input * removal)
+			MaP <- tibble(removal = ((rivers.calc[ , MaPw.sum])  * (rivers.calc[ , paste0("removal.fac_", mat, "_MaP")]) + (rivers.calc[ , MaPw.in]) * (rivers.calc[ , paste0("removal.fac_", mat, "_MaP")]))*-1)
+			
+			# second sedimentation (inflow + input in segment - removal) (removal is neg. number, thus +)
+			MaP$sed_wo_sedinflow <- (((rivers.calc[ , MaPw.sum] + rivers.calc[ , MaPw.in] + MaP$removal) * rivers.calc[ , paste0("sed.fac_", mat, "_MaP")]) ) *-1
+			MaP$sed <- MaP$sed_wo_sedinflow - rivers.calc[ ,MaPw.in_sed]# add (substract because of neg. number) inflowing sediments
+			
+			
+			# third cleaning resuspension and burial / accumulation (all together must be smaller than 1)
+			# calculated per segment
+			#based on sedimented portion plus actual sediments (from inflow)
+			# MaP$sed * -1 because sed is negative number but we need positive numbers.
+			MaP$sed_pos <- MaP$sed*-1
+			
+			
+			MaP$clean <- (MaP$sed_pos) * rivers.calc[ , paste0("clean.fac_", mat, "_MaP")]*-1
+			
+			#  resuspension
+			MaP$resus <- (MaP$sed_pos) * rivers.calc[ , paste0("resus.fac_", mat, "_MaP")]
+			
+			#accumulation
+			MaP$burial <- (MaP$sed_pos) * rivers.calc[ , paste0("acc.fac_", mat, "_MaP")]*-1
+
+			MaP <- MaP*1e15 #to avoid rounding errors
+			#cut of numbers at position 15 -> to avoid rounding errors.
+			# for neg. numbers use ceiling for pos. numbers use floor
+			MaP[, c("removal", "sed_wo_sedinflow", "sed", "clean", "burial")] <- ceiling(MaP[, c("removal", "sed_wo_sedinflow", "sed", "clean", "burial")])
+			MaP[ , c("sed_pos", "resus")] <- floor(MaP[ , c("sed_pos", "resus")])
+			
+			# accumulation cant be higher than the rest after clean and resuspension
+			w1 <- MaP$clean*-1 + MaP$resus + MaP$burial*-1
+			w2 <- which(w1 > MaP$sed_pos)
+			#sum w2
+			w2_sum <- MaP$clean[w2]*-1 + MaP$resus[w2]
+			if(length(w2)>0){
+				MaP$burial[w2]<- (MaP$sed_pos[w2] - w2_sum)*-1 #burial is mass in sed - clean - resus (! clean is a negative number!), floor and ceiling avoid rounding problems. number might leave very small rest. can be passed on via sed transport...
+			}
+			
+			#futher information:
+			MaP$sum <- rivers.calc[ , MaPw.sum]*1e15
+			MaP$inflow <- rivers.calc[ , MaPw.in]*1e15
+			
+
+
+			
+			
+			
+			
+			# summary(MaP)
+			########## ################
+			#sum the MaP dataframes per row ->negative numbers are subtracted (sedimentation, burial) while positive number are added (input emission, resuspension, inflow from upstream)
+			#assumptions: inflow is per second and all other data is for the entire segment. therefore all "changes" along the segment are included. Thus the result is per second at the end of the segment
+			
+			# to reduce computation time we separate multiflow vs. single flow
+			#if only one section flows to another section:
+			# just sum the rows of removal, burial, sum and act. conc. -> because of the negative numbers of sed_wo_sedinflow and removal this is a easy solution to find the new act.conc. in the water
+			temp_MaP[rivers.calc$flow_to[single_flow_to]] <- rowSums(MaP[single_flow_to, c("inflow", "sum", "removal", "sed_wo_sedinflow", "resus")], na.rm = T) # because sed and clean up are stored as neg. numbers this amount will be substrected.resuspension, sum (data by Kawecki) and inflow are positive numbers
+			
+			
+			
+			# for summing in groups / meaning multiple flows go into one, rowsum takes a grouping argument
+			temp_MaP[sort(dup)] <- rowSums(rowsum(MaP[multi_flow_to, c("inflow", "sum", "removal", "sed_wo_sedinflow", "resus")], rivers.calc$flow_to[multi_flow_to])) #sorts always according to second argument
+			
+			
+			#same for sediments
+			#pass on sedimentation..  sed_pos (including sed_inflow) are positive numbers. burial, resus_neg and cleaning are negative numbers
+			MaP$resus_neg <- MaP$resus*-1
+			temp_MaP_sed[rivers.calc$flow_to[single_flow_to]] <- rowSums(MaP[single_flow_to, c("burial", "sed_pos", "resus_neg", "clean")], na.rm = T)
+			
+			
+			# for summing in groups / meaning multiple flows go into one, rowsum takes a grouping argument
+			temp_MaP_sed[sort(dup)] <- rowSums(rowsum(MaP[multi_flow_to, c("burial","sed_pos", "resus_neg", "clean")], rivers.calc$flow_to[multi_flow_to], na.rm = T))
+			
+			#back transfer temp_MaP
+			temp_MaP <- temp_MaP*1e-15
+			temp_MaP_sed <- temp_MaP_sed*1e-15
+			
+			
+
+			#eliminate too small numbers
+			temp_MaP[temp_MaP > -1e-18 & temp_MaP < 1e-18] <- 0
+			temp_MaP_sed[temp_MaP_sed > -1e-18 & temp_MaP_sed < 1e-18] <- 0
+			
+			
+			
+			# use the temp_data as new inflow concentration data.
+			rivers.calc[ ,MaPw.in] <- temp_MaP 
+			
+			#use the temp_data of sed. for sed inflow
+			rivers.calc[ , MaPw.in_sed] <- temp_MaP_sed
+			
+			#controll that no negative accumulation. possible when cleaning + accumulation is higher than "inflow"
+			if(length(which((rivers.calc[ ,MaPw.in]) < 0)) >=1 ){
+				warning(paste0("negative contamination in water (MaP)! polymer: ", mat, "; round: ", i, "; scenario: ", xxx))
+				
+				break
+			}
+			
+			
+			if(length(which(MaP$burial > 0)) >=1 ){
+				warning(paste0("negative contamination in accumulation (MaP)! polymer: ", mat, "; round: ", i, "; scenario: ", xxx))
+				
+				break
+			}
+			if(length(which((rivers.calc[ ,MaPw.in_sed]) < 0)) >=1 ){
+				warning(paste0("negative contamination in sediments (MaP)! polymer: ", mat, "; round: ", i, "; scenario: ", xxx))
+				break
+			}
+			
+			# actual concentration of plastic in the water
+			rivers.calc[ , paste0("actualcon_", mat, "_WaterMaP_concMSV")] <- rowSums(MaP[ , c("inflow", "sum", "removal", "sed_wo_sedinflow")], na.rm = T) #inflow contains resus from previous segment
+			rivers.calc[ , paste0("actualcon_", mat, "_WaterMaP_concMSV")] <- rivers.calc[ , paste0("actualcon_", mat, "_WaterMaP_concMSV")]*1e-15 #back transfer
+			
+			
+			
+			
+			if(length(which((rivers.calc[ , paste0("actualcon_", mat, "_WaterMaP_concMSV")]) < 0)) >=1 ){
+				warning(paste0("negative contamination in water (MaP)! polymer: ", mat, "; round: ", i, "; scenario: ", xxx))
+				
+				break
+			}
+			
+			#back transfer MaP
+			MaP <- MaP*1e-15
+			
+			#transfer data to rivers.calc dataframe
+			rivers.calc[ , MaPw.acc] <- MaP[ , "burial"]*-1 #neg numbers were needed before
+			
+			
+			rivers.calc[ , MaPw.removal] <- MaP[ , "removal"]*-1 #neg numbers were needed before
+			
+			rivers.calc[ , MaPw.clean] <- MaP[ , "clean"]*-1 #neg numbers were needed before
+			
+			#for sed: what you will find / is present in the entire river segment!!! in one second
+			rivers.calc[ , MaPw.sed] <- MaP[ , "sed_pos"] #sed_pos is a positive numbers
+			
+			
+			if(length(which((rivers.calc[ , MaPw.removal]) < 0)) >=1 ){
+				warning(paste0("negative removal in water (MaP)! polymer: ", mat, "; round: ", i, "; scenario: ", xxx))
+				break
+			}
+			
+			if(length(which((rivers.calc[ , MaPw.acc]) < 0)) >=1 ){
+				warning(paste0("negative accumulation in water (MaP)! polymer: ", mat, "; round: ", i, "; scenario: ", xxx))
+				break
+			}
+			
+			if(length(which((rivers.calc[ , MaPw.clean]) < 0)) >=1 ){
+				warning(paste0("negative cleaning from water (MaP)! polymer: ", mat, "; round: ", i, "; scenario: ", xxx))
+				break
+			}
+			
+			
+			
+			
+
+			if(i %in% print_round){
+				Sys.sleep(10)
+				save(rivers.calc, file = paste0(main.path, "temp_data/flow_files/round_", i, "_", mat,"_",  extra_name, ".Rdata"))
+				print(paste(Sys.time(), ":", mat, extra_name, "done!"))
+				Sys.sleep(5)
+			}
+		}
+	}
+
+
+
+	} #end loop extra_names
+
+	save(print_round,extra_names, file = paste0(main.path, "temp_data/flow_files/print_round.Rdata"))
+	rm(list = ls())
+
diff --git a/github_calculation/03.1_printMaps.R b/github_calculation/03.1_printMaps.R
new file mode 100644
index 0000000..f60d340
--- /dev/null
+++ b/github_calculation/03.1_printMaps.R
@@ -0,0 +1,164 @@
+############################
+# script to read saved Rdata file and produce gpkg file which can be viewed in GIS software, also this scripts generates Rdata files which can be used for graphs
+# please, adjust file accordingly to your input files -> see L44
+# to save gpkg file: un-comment L158! saving a gpkg file take much more time than saving only Rdata files!
+# make graphs
+# unit: general in g / s
+# rivers per m in g/ m (river section length)
+# lakes per m in g / m2 
+# author: David Mennekes, PhD Student at Empa, Switzerland, david.mennekes@empa.ch
+# May 2021, last edited: May 2021
+############################
+
+	
+	# packages
+	library(sf)
+	library(dplyr)
+
+	# main path
+	
+	setwd("~/")
+	main.path <- "PhD/mennekes2.0/"
+	
+	#subfolder (change if needed)
+	sub.path <- "temp_data/flow_files/"
+
+	
+	# define output folder
+	output.gpkg <- paste0(main.path, "output_files/GIS/")
+	
+	#load geo
+	load(paste0(main.path, sub.path, "0000_geo.Rdata"))
+	
+	# polymers
+	polymers <- c("LDPE", "HDPE", "PP", "PS", "EPS", "PVC", "PET")
+	
+
+	# important: runs you want to save, default you will save all rounds you printed in the script 3.0
+	load(paste0(main.path, "temp_data/flow_files/print_round.Rdata"))
+	rounds <- print_round
+	
+	#extra names are the scenarios. will be loaded from Rdata. If you want only few scenarios, plase change extra_name
+	extra_names <- extra_names
+	# rounds <- c(801)
+	
+	#columns that should be included in final report beside  contamination columns
+	nselection <- c("NAME", "isLake", "id_all", "flow_velocity", "flow_to", "outflow", "name_river")
+	
+	
+	
+
+	#files directionary
+	rfiles_short <- list.files(path = paste0(main.path, sub.path))
+	rfiles_long <- list.files(path = paste0(main.path, sub.path), full.names = T)
+
+
+	
+	# loop for extra names and all files: 
+	for (extra_name in extra_names) {
+			
+		for(mat in polymers){
+				load(paste0(main.path, sub.path, "round_801_", mat, extra_name, ".Rdata"))
+				r.rivers <- which(rivers.calc$isLake == F & rivers.calc$outflow == 0) #find rivers
+				r.lakes <- which(rivers.calc$isLake == T) #find lakes
+				r.outflow <- which(rivers.calc$outflow != 2)
+				lake_id <- id_lakes <- unique(rivers.calc$FID_poly_s)[-is.na(unique(rivers.calc$FID_poly_s))]
+				
+				n_old <- names(rivers.calc)
+				#generate final columns for the data
+				rivers.calc[ , paste0("water_perM_", mat, "_MaP")] <- 0
+				rivers.calc[ , paste0("sediment_tot_", mat, "_MaP")] <- 0
+				rivers.calc[ , paste0("sediment_perM_", mat, "_MaP")] <- 0
+				rivers.calc[ , paste0("clean_tot_", mat, "_MaP")] <- 0
+				rivers.calc[ , paste0("clean_perM_", mat, "_MaP")] <- 0
+				rivers.calc[ , paste0("removal_tot_", mat, "_MaP")] <- 0
+				rivers.calc[ , paste0("removal_perM_", mat, "_MaP")] <- 0
+				rivers.calc[ , paste0("accumulation_tot_", mat, "_MaP")] <- 0
+				rivers.calc[ , paste0("accumulation_perM_", mat, "_MaP")] <- 0
+				rivers.calc[ , paste0("inputKawecki_perS_", mat, "_MaP")] <- rivers.calc[ , paste0("sum_",mat, "_Water_concMSV")]
+				rivers.calc[ , paste0("acutalinflow_water_", mat, "_MaP")] <- rivers.calc[ , paste0("actualinflow_", mat, "_WaterMaP_concMSV")]
+				rivers.calc[ , paste0("acutalinflow_sediment_", mat, "_MaP")] <- rivers.calc[ , paste0("actualinflow_sed_", mat, "_WaterMaP_concMSV")]
+				n_new <- names(rivers.calc)
+				n1 <- n_new[!(n_new %in% n_old)]
+				
+				
+				#calculate new numbers for sections
+				#weight in gramms
+				#for rivers (perM in per m of the river section length)
+				# lake section all have the length 1m therefore the numbers will not be changed and water_tot, accumulation.... etc are per second!!!
+				rivers.calc[ , paste0("water_tot_", mat, "_MaP")] <- rivers.calc[ , paste0("actualcon_", mat, "_WaterMaP_concMSV")] *round(rivers.calc$length_m, 2)
+				
+				rivers.calc[ , paste0("water_perM_", mat, "_MaP")] <- rivers.calc[ , paste0("water_tot_", mat, "_MaP")] / rivers.calc$length_m
+				
+				#for sediments
+				
+				rivers.calc[ r.rivers, paste0("sediment_tot_", mat, "_MaP")] <- rivers.calc[ r.rivers, paste0("actualsed_", mat, "_WaterMaP_concMSV")]
+				
+				
+				rivers.calc[ r.rivers, paste0("sediment_perM_", mat, "_MaP")] <- rivers.calc[ r.rivers, paste0("sediment_tot_", mat, "_MaP")] / rivers.calc$length_m[r.rivers]
+				
+				#accumulation
+				rivers.calc[ , paste0("accumulation_tot_", mat, "_MaP")] <- rivers.calc[ , paste0("actualacc_", mat, "_WaterMaP_concMSV")]
+				
+				rivers.calc[ , paste0("accumulation_perM_", mat, "_MaP")] <- rivers.calc[ , paste0("accumulation_tot_", mat, "_MaP")] / rivers.calc$length_m
+				
+				#cleaning
+				rivers.calc[ , paste0("clean_tot_", mat, "_MaP")] <- rivers.calc[ , paste0("actualclean_", mat, "_WaterMaP_concMSV")]
+				
+				rivers.calc[ , paste0("clean_perM_", mat, "_MaP")] <- rivers.calc[ , paste0("clean_tot_", mat, "_MaP")] / rivers.calc$length_m
+				
+				#removal
+				rivers.calc[ , paste0("removal_tot_", mat, "_MaP")] <- rivers.calc[ , paste0("actualremoval_", mat, "_WaterMaP_concMSV")]
+				
+				#removal doesn´t exist perM -> is point value
+				
+				
+				
+				
+				rivers.calc[r.lakes , paste0("inputKawecki_perS_", mat, "_MaP")] <- rivers.calc[r.lakes, paste0("sum_", mat, "_Water_concMSV")] / rivers.calc$area[r.lakes]
+				
+				
+				## for all lakes... per lake ID if needed
+				# all sections per lake will have the same value. this is better for interpretation
+				
+				
+				lakes_single <- rivers.calc #jeder abschnitt bleibt unabhängig voneinander...
+				for (id in lake_id) {
+					x = which(rivers.calc$FID_poly_s == id)
+					rivers.calc[x , paste0("water_tot_", mat, "_MaP")] <- sum(rivers.calc[x, paste0("actualcon_", mat, "_WaterMaP_concMSV")], na.rm = T) # nothing in sediments, because sediments = accumulation
+					
+					rivers.calc[x , paste0("water_perS_", mat, "_MaP")] <- sum(rivers.calc[x, paste0("actualcon_", mat, "_WaterMaP_concMSV")], na.rm = T)
+					
+					rivers.calc[x , paste0("water_perM_", mat, "_MaP")] <- rivers.calc[x , paste0("water_tot_", mat, "_MaP")] / rivers.calc$area[x]
+					
+					rivers.calc[x , paste0("sediment_tot_", mat, "_MaP")] <- 0
+					rivers.calc[x , paste0("sediment_perM_", mat, "_MaP")] <- 0
+					
+					rivers.calc[x , paste0("accumulation_tot_", mat, "_MaP")] <- sum(rivers.calc[x , paste0("actualacc_", mat, "_WaterMaP_concMSV")])
+					rivers.calc[x , paste0("accumulation_perM_", mat, "_MaP")] <- rivers.calc[x , paste0("accumulation_tot_", mat, "_MaP")]/rivers.calc$area[x]
+					
+					rivers.calc[x , paste0("clean_tot_", mat, "_MaP")] <- sum(rivers.calc[x , paste0("actualclean_", mat, "_WaterMaP_concMSV")])
+					rivers.calc[x , paste0("clean_perM_", mat, "_MaP")] <- rivers.calc[x , paste0("clean_tot_", mat, "_MaP")]/rivers.calc$area[x]
+					#removal effects river not lakes!
+				}
+				
+				
+				n2 <- c(nselection, n1) #make vector with all col names which should be selected
+				geo_x <- geo
+				geo_x[ , n2] <- NA
+				geo_x[ , n2] <- rivers.calc[ , n2]
+				s_r <- rivers.calc[ , n2]
+				s_r2 <- lakes_single[ , n2]
+				Sys.sleep(8)
+				# st_write(geo_x, paste0(output.gpkg, "cont_", mat, "_round_801", extra_name, ".gpkg" ), append = F)
+				save(s_r, file = paste0(main.path, "output_files/rdata/cont_",mat,"_801", extra_name, ".Rdata"))
+				Sys.sleep(1)
+				save(s_r2, file = paste0(main.path, "output_files/rdata/lakes_single/cont_",mat,"_801", extra_name, ".Rdata"))
+				Sys.sleep(8)
+				print(paste0(extra_name, " ", mat, " done! (", Sys.time(), ")"))
+		}
+	}
+	
+
+	rm(list = ls())
+	
\ No newline at end of file
diff --git a/github_calculation/04_numbers.R b/github_calculation/04_numbers.R
new file mode 100644
index 0000000..08dcb9c
--- /dev/null
+++ b/github_calculation/04_numbers.R
@@ -0,0 +1,565 @@
+#numbers for the paper
+#### plot 02
+
+#total masses outflows:
+
+####
+# plotting figures of the model; the plots might give you an idea for plotting; however, the actual results depend highly on your input data set.
+# author: david mennekes, david.mennekes@empa.ch,
+# march 2022
+##################
+
+
+
+main.path <- "PhD/mennekes2.0/"# library packages
+
+library(reshape)
+library(ggplot2)
+library(dplyr)
+library(tidyverse)
+library(ggrepel)
+library(patchwork) #for making all images the same dimensions.
+library(cowplot)
+library(readxl)
+
+
+#load data
+
+polymers <- c("EPS", "PP", "PS", "LDPE", "HDPE", "PVC", "PET")
+
+base <- "_base"
+rounds <- "801"
+
+load(paste0(main.path, "output_files/rdata/cont_HDPE_", rounds, base, ".Rdata"))
+compartments <- c("outflow", "sediment_tot", "accumulation_tot", "removal_tot")
+
+# load for each variable a one data frame
+
+# overall contamination switzerland, figure with overall burial, accumulation, sedimentation and plastics in water
+#create dataframe
+
+
+### load data in water
+df01 <- as.data.frame(matrix(NA, nrow = nrow(s_r), ncol = I(length(polymers)+ 4))) #*2 for scenarios
+names(df01) <- c(polymers, "flow_to", "isLake", "id_all", "outflow")
+
+
+#load data in water
+for (mat in polymers) {
+	load(paste0(main.path, "output_files/rdata/lakes_single/cont_", mat,"_", rounds, "_base.Rdata"))
+	df01[, mat] <- s_r2[ , paste0("water_perM_", mat, "_MaP")]
+	df01[ , c("flow_to", "isLake", "id_all", "outflow")] <- s_r2[ , c("flow_to", "isLake", "id_all", "outflow")]
+}
+rm(s_r2)
+df_water_perM <- df01
+df_water_perM$sum <- rowSums(df_water_perM[ , polymers])
+tail(df_water_perM)
+df_water_perM[c(441454,441462), "sum"]*60*60*24*365/1000
+s_r[s_r$outflow!=0, ]
+
+
+### load data removal tot
+df01 <- as.data.frame(matrix(NA, nrow = nrow(s_r), ncol = I(length(polymers)+ 4))) #*2 for scenarios
+names(df01) <- c(polymers, "flow_to", "isLake", "id_all", "outflow")
+
+for (mat in polymers) {
+	load(paste0(main.path, "output_files/rdata/lakes_single/cont_", mat,"_", rounds, "_base.Rdata"))
+	df01[, mat] <- s_r2[ , paste0("removal_tot_", mat, "_MaP")]
+	df01[ , c("flow_to", "isLake", "id_all", "outflow")] <- s_r2[ , c("flow_to", "isLake", "id_all", "outflow")]
+}
+rm(s_r2)
+df_removal_tot <- df01
+df_removal_tot$sum <- rowSums(df_removal_tot[ , polymers])
+
+### load data clean tot
+df01 <- as.data.frame(matrix(NA, nrow = nrow(s_r), ncol = I(length(polymers)+ 4))) #*2 for scenarios
+names(df01) <- c(polymers, "flow_to", "isLake", "id_all", "outflow")
+
+for (mat in polymers) {
+	load(paste0(main.path, "output_files/rdata/lakes_single/cont_", mat,"_", rounds, "_base.Rdata"))
+	df01[, mat] <- s_r2[ , paste0("clean_tot_", mat, "_MaP")]
+	df01[ , c("flow_to", "isLake", "id_all", "outflow")] <- s_r2[ , c("flow_to", "isLake", "id_all", "outflow")]
+}
+rm(s_r2)
+df_clean_tot <- df01
+df_clean_tot$sum <- rowSums(df_clean_tot[ , polymers])
+
+
+### load data accumulation tot
+df01 <- as.data.frame(matrix(NA, nrow = nrow(s_r), ncol = I(length(polymers)+ 4))) #*2 for scenarios
+names(df01) <- c(polymers, "flow_to", "isLake", "id_all", "outflow")
+
+for (mat in polymers) {
+	load(paste0(main.path, "output_files/rdata/lakes_single/cont_", mat,"_", rounds, "_base.Rdata"))
+	df01[, mat] <- s_r2[ , paste0("accumulation_tot_", mat, "_MaP")]
+	df01[ , c("flow_to", "isLake", "id_all", "outflow")] <- s_r2[ , c("flow_to", "isLake", "id_all", "outflow")]
+}
+rm(s_r2)
+df_accumulation_tot <- df01
+df_accumulation_tot$sum <- rowSums(df_accumulation_tot[ , polymers])
+
+
+### load data temp storage
+
+df01 <- as.data.frame(matrix(NA, nrow = nrow(s_r), ncol = I(length(polymers)+ 4))) #*2 for scenarios
+names(df01) <- c(polymers, "flow_to", "isLake", "id_all", "outflow")
+
+for (mat in polymers) {
+	load(paste0(main.path, "output_files/rdata/lakes_single/cont_", mat,"_", rounds, "_base.Rdata"))
+	df01[, mat] <- s_r2[ , paste0("sediment_tot_", mat, "_MaP")]
+	df01[ , c("flow_to", "isLake", "id_all", "outflow")] <- s_r2[ , c("flow_to", "isLake", "id_all", "outflow")]
+}
+rm(s_r2)
+df_sediment_tot <- df01
+df_sediment_tot$sum <- rowSums(df_sediment_tot[ , polymers])
+
+
+### load data for control (scenario Null)
+df01 <- as.data.frame(matrix(NA, nrow = nrow(s_r), ncol = I(length(polymers)+ 4))) #*2 for scenarios
+names(df01) <- c(polymers, "flow_to", "isLake", "id_all", "outflow")
+
+for (mat in polymers) {
+	load(paste0(main.path, "output_files/rdata/lakes_single/cont_", mat,"_", rounds, "_null.Rdata"))
+	df01[, mat] <- s_r2[ , paste0("water_perM_", mat, "_MaP")]
+	df01[ , c("flow_to", "isLake", "id_all", "outflow")] <- s_r2[ , c("flow_to", "isLake", "id_all", "outflow")]
+}
+rm(s_r2)
+df_null <- df01
+df_null$sum <- rowSums(df_null[ , polymers])
+
+
+
+
+# get network of one river
+#######################################
+outflow_1_Rhine <- 441464
+outflow_1_Rhone <- 441470
+
+######### results for Rhine ##########
+#find all rivers connected to the stream rhine
+trib <- data.frame(flow_to <- s_r$flow_to,
+									 id_all <- s_r$id_all)
+trib$partof <- 0 #part of the tributaries
+trib$partof[outflow_1_Rhine] <- 1 #all sections of the main river are selected
+for (i in 1:700) {
+	ids <- trib$id_all[trib$partof == 1] #get geo IDs with one
+	trib$partof[trib$flow_to %in% ids] <- 1 #write 1 when the flow to refers to a an id with 1
+}
+
+ids_trib <- trib$id_all[trib$partof==1]
+
+water_rhine <- melt(df_water_perM[outflow_1_Rhine, polymers])
+water_rhine$value <- water_rhine$value*60*60*24*365/1000 #in kg / year
+water_rhine$river <- "Rhine"
+
+
+ids_trib_river <- ids_trib[which(ids_trib%in%s_r$id_all[s_r$isLake == F])]
+ids_trib_lakes <- ids_trib[which(ids_trib%in%s_r$id_all[s_r$isLake == T])]
+
+
+ezg_rhine <- data.frame(ausfluss = df_water_perM[outflow_1_Rhine, "sum"],
+												acc_river = sum(df_accumulation_tot$sum[ids_trib_river], na.rm = T),
+												acc_lake = sum(df_accumulation_tot$sum[ids_trib_lakes], na.rm = T),
+												clean_river = sum(df_clean_tot$sum[ids_trib_river], na.rm = T),
+												clean_lake = sum(df_clean_tot$sum[ids_trib_lakes], na.rm = T),
+												rem = sum(df_removal_tot$sum[ids_trib], na.rm = T))
+temp_storage_rhine = sum(df_sediment_tot$sum[ids_trib], na.rm = T) #is per second
+ezg_rhine_melt <- melt(ezg_rhine)
+ezg_rhine_melt$value <- ezg_rhine_melt$value*60*60*24*365/1000 #in kg per year
+
+
+#control shows me: the null retention is the same value assuming up different values. all perfect!
+tot_input_rhine <- df_null[outflow_1_Rhine, "sum"]
+tot_input_rhine
+
+ezg_rhine_melt$value_percent <- ezg_rhine_melt$value/ (tot_input_rhine*60*60*24*365/1000)*100
+##
+
+ezg_rhine_melt$color <- c("a", "b", "b", "c", "c", "d") #add factors for colors
+ezg_rhine_melt$pattern <- c("x", "x", "y", "x", "y", "x")
+
+ids_trib_rhine <- ids_trib
+
+######### results for rhone ##########
+#find all rivers connected to the stream rhone
+trib <- data.frame(flow_to <- s_r$flow_to,
+									 id_all <- s_r$id_all)
+trib$partof <- 0 #part of the tributaries
+trib$partof[outflow_1_Rhone] <- 1 #all sections of the main river are selected
+for (i in 1:700) {
+	ids <- trib$id_all[trib$partof == 1] #get geo IDs with one
+	trib$partof[trib$flow_to %in% ids] <- 1 #write 1 when the flow to refers to a an id with 1
+}
+
+ids_trib <- trib$id_all[trib$partof==1]
+
+water_rhone <- melt(df_water_perM[outflow_1_Rhone, polymers])
+water_rhone$river <- "Rhône"
+water_rhone$value <- water_rhone$value*60*60*24*365/1000
+
+
+ids_trib_river <- ids_trib[which(ids_trib%in%s_r$id_all[s_r$isLake == F])]
+ids_trib_lakes <- ids_trib[which(ids_trib%in%s_r$id_all[s_r$isLake == T])]
+
+
+
+ezg_rhone <- data.frame(ausfluss = df_water_perM[outflow_1_Rhone, "sum"],
+												acc_river = sum(df_accumulation_tot$sum[ids_trib_river], na.rm = T),
+												acc_lake = sum(df_accumulation_tot$sum[ids_trib_lakes], na.rm = T),
+												clean_river = sum(df_clean_tot$sum[ids_trib_river], na.rm = T),
+												clean_lake = sum(df_clean_tot$sum[ids_trib_lakes], na.rm = T),
+												rem = sum(df_removal_tot$sum[ids_trib], na.rm = T))
+ezg_rhone_melt <- melt(ezg_rhone)
+ezg_rhone_melt$value <- ezg_rhone_melt$value*60*60*24*365/1000 #in kg per year
+
+#control shows me: the null retention is the same value assuming up different values. all perfect!
+tot_input_rhone <- df_null[outflow_1_Rhone, "sum"]
+tot_input_rhone
+
+ezg_rhone_melt$value_percent <- ezg_rhone_melt$value/ (tot_input_rhone*60*60*24*365/1000)*100
+##
+
+ezg_rhone_melt$color <- c("a", "b", "b", "c", "c", "d") #add factors for colors
+ezg_rhone_melt$pattern <- c("x", "x", "y", "x", "y", "x")
+
+
+#### rbind both tables
+ezg_rhine_melt$river <- "Rhine"
+ezg_rhone_melt$river <- "Rhône"
+
+ezg_rr <- rbind(ezg_rhine_melt, ezg_rhone_melt)
+ezg_rr$color <- factor(ezg_rr$color, levels = c("a", "b", "c", "d"))
+
+# ezg_rr$pattern <- fct_reorder(ezg_rr$pattern)
+
+
+
+
+
+
+#### data for total masses
+###################
+
+######### results for all ##########
+#find all rivers connected to the stream rhone
+
+water_all <- melt(colSums(df_water_perM[df_water_perM$outflow %in% c(1,3), polymers]))
+water_all <- cbind(variable = rownames(water_all), water_all)
+water_all$value <- water_all$value*60*60*24*365/1000
+water_all$river <- "all"
+
+
+
+
+ezg_all <- data.frame(ausfluss = sum(df_water_perM[df_water_perM$outflow %in% c(1,3) , "sum"], na.rm = T),
+											acc_river = sum(df_accumulation_tot$sum[df_accumulation_tot$isLake == F], na.rm = T),
+											acc_lake = sum(df_accumulation_tot$sum[df_accumulation_tot$isLake == T], na.rm = T),
+											clean_river = sum(df_clean_tot$sum[df_clean_tot$isLake == F], na.rm = T),
+											clean_lake = sum(df_clean_tot$sum[df_clean_tot$isLake == T], na.rm = T),
+											rem = sum(df_removal_tot$sum, na.rm = T))
+ezg_all_melt <- melt(ezg_all)
+ezg_all_melt$value <- ezg_all_melt$value*60*60*24*365/1000 #in kg per year
+
+#control shows me: the null retention is the same value assuming up different values. all perfect!
+tot_input_all <- sum(ezg_all, na.rm = T)
+tot_input_all
+
+ezg_all_melt$value_percent <- ezg_all_melt$value/ (tot_input_all*60*60*24*365/1000)*100
+##
+
+ezg_all_melt$color <- c("a", "b", "b", "c", "c", "d") #add factors for colors
+ezg_all_melt$pattern <- c("x", "x", "y", "x", "y", "x")
+
+
+#### rbind all tables
+ezg_rhine_melt$river <- "Rhine *"
+ezg_rhone_melt$river <- "Rhône *"
+ezg_all_melt$river <- "all Swiss water bodies"
+
+ezg_rr <- rbind(ezg_rhine_melt, ezg_rhone_melt, ezg_all_melt)
+ezg_rr$color <- factor(ezg_rr$color, levels = c("a", "b", "c", "d"))
+
+
+
+########################## calculation##########################
+#total mass
+total_mass <- colSums(df_null[df_null$outflow %in% c(1,3), c(polymers, "sum")])*60*60*24*365/1000000 #in tons /year
+total_mass
+
+rivers_outflow <- data.frame(mass_total = df_water_perM[df_water_perM$outflow %in% c(1,3), "sum"],
+														 names = s_r$name_river[s_r$outflow %in% c(1,3)])
+rivers_outflow$mass_kg_year <- rivers_outflow$mass_total*60*60*24*365/1000
+rivers_outflow
+
+rivers_outflow$mass_total[11]/ sum(rivers_outflow$mass_total)
+
+rivers_outflow_null <- data.frame(mass_total = df_null[df_water_perM$outflow %in% c(1,3), "sum"]*60*60*24*365/1000000, #in tons /year
+																	names = s_r$name_river[s_r$outflow %in% c(1,3)])
+rivers_outflow_null
+
+
+#percentage
+rivers_outflow$mass_total / rivers_outflow_null$mass_total*100
+
+library(sf)
+breggia <- st_read("PhD/data/processed maps/breggia.gpkg")
+
+plot(st_geometry(breggia))
+br_km2 <- as.numeric(st_area(breggia)/1000000)
+
+rhone <- st_read("PhD/data/processed maps/rhone.gpkg")
+plot(st_geometry(rhone))
+rh <- as.numeric(st_area(rhone)/100000)
+rh / br_km2
+
+
+####
+load("PhD/mennekes2.0/temp_data/flow_files/round_801_PET_base.Rdata")
+rivers.calc[93992, ]
+
+sum(df_sediment_tot[ids_trib_rhine, "sum"])
+length(p)
+p <- (rivers.calc$actualacc_PET_WaterMaP_concMSV / rivers.calc$actualsed_PET_WaterMaP_concMSV*100)
+length(which(p == 100))
+rivers.calc[which(p == 100), "actualacc_PET_WaterMaP_concMSV"]
+
+rivers.calc[ids_trib_river[823], ]
+
+ezg_rr
+ezg_rr %>% group_by(river, color) %>% summarise(sum(value))
+
+
+#peak concentratin per km
+df_acc_per_m <- df_accumulation_tot$sum /  rivers.calc$length_m
+max(df_acc_per_m[df_sediment_tot$outflow == 0 & df_acc_per_m != 0])*60*60*24*365
+summary(df_acc_per_m[df_sediment_tot$outflow == 0 & df_acc_per_m != 0])*60*60*24*365
+
+#number of rivers that are contaminated
+r.river <- !(rivers.calc$isLake)
+r.river[rivers.calc$outflow!=0] <- F
+r.lake <- rivers.calc$isLake
+
+cont_river <- df_water_perM$sum[r.river] > 0
+sum(cont_river)/sum(r.river)
+
+
+#potential outflow null scenario
+df_null[outflow_1_Rhine, "sum"] *60*60*24*365/1000
+df_null[outflow_1_Rhone, "sum"] *60*60*24*365/1000
+
+
+###############################
+#find reason for change in Aare river at km a bit over 200
+
+main.path <- "PhD/mennekes2.0/"
+load(paste0(main.path, "temp_data/forPlot.Rdata"))
+
+load(paste0(main.path, "temp_data/flow_files/print_round.Rdata"))
+# extra_names <- c("_weir05", "_weir95")
+rounds <- "801"
+polymers <- c("EPS", "PP", "LDPE", "HDPE", "PS", "PVC", "PET")
+
+rhein <- 65062
+doubs <- 329205
+aare <- 79433
+rhone <- 325768
+
+
+d <- rivers.all %>% dplyr::select(id_all, flow_to) %>% st_drop_geometry()
+
+d$x <- 0
+d$x[aare] <- 1
+ft <- d$flow_to[which(d$x == 1)]
+ft_long <- aare
+for (i in 1:800) {
+	d$x[ft] <- 1
+	ft_long <- c(ft_long, ft)
+	ft <- d$flow_to[ft]
+}
+sum(d$x)
+
+ft_rhine <- ft_long[1:sum(d$x)]
+
+len <- as.numeric(st_length(rivers.all[ft_rhine, ]))
+len_cum <- cumsum(len)
+
+
+
+df01 <- as_tibble(matrix(nrow = 1, ncol = length(polymers)+2))
+names(df01) <- c(polymers, "scenario", "x")
+
+#for loading data
+df_temp <- as_tibble(matrix(nrow = length(ft_rhine), ncol = length(polymers)+2))
+names(df_temp) <- c(polymers, "scenario", "x")
+
+#load data
+for (scenario in extra_names) {
+	df_temp$scenario <- scenario
+	df_temp$x <- len_cum
+	for (mat in polymers) {
+		load(paste0(main.path, "output_files/rdata/cont_", mat,"_801", scenario, ".Rdata"))
+		df_temp[ , mat] <- s_r[ft_rhine, paste0("water_perM_", mat, "_MaP")]
+	}
+	df01 <- rbind(df01, df_temp)
+}
+
+
+df01 <- df01[2:nrow(df01), ]
+
+
+df01$sum <- rowSums(df01[ , polymers])
+
+#find max row for PET scenario _base
+df01_PET <- df01 %>% filter(scenario == "_base")
+  x<- df01_PET$x[which.max(df01_PET$PET)]
+  id_aare <- which.max(df01_PET$PET)
+  
+ids_interest <- ft_rhine[c(id_aare-1, id_aare, id_aare+1)]
+len_cum[c(id_aare-1, id_aare, id_aare+1)]
+df01_PET$PET[c(id_aare-1, id_aare, id_aare+1)]*1000
+
+load("PhD/mennekes2.0/temp_data/rivers_all6_base.Rdata")
+#rivers.all6
+names(rivers.all6)
+fac_pet <- grepl(".fac_PET_", names(rivers.all6))
+
+#find fac. data for interesting section
+rivers.all6[ids_interest, fac_pet]
+
+
+#find other weirs in aare river
+w_aare <- which(rivers.all6$removal.fac_PET_MaP[ft_rhine] == 0.75) #all weirs in aare
+length(w_aare) # number of dams in Aare: 17
+
+len_cum[w_aare]/1000
+
+
+
+
+
+
+
+
+#############################
+#effect of different scenarios
+
+
+polymers <- c("LDPE", "HDPE", "PP", "PS", "EPS", "PVC", "PET")
+
+main.path <- "PhD/mennekes2.0/"
+
+#load extra names
+load(paste0(main.path, "temp_data/flow_files/print_round.Rdata"))
+rounds <- "801"	
+
+# load(paste0(main.path, "output_files/rdata/cont_HDPE_", rounds, extra_names[1], ".Rdata"))
+# rm(s_r)
+scenarios <- extra_names
+
+###df 02 for water
+df02 <- data.frame(river = rep(NA, 3*length(polymers)),
+									 polymer = NA)
+for (i in scenarios) {
+	df02[ , i] <- NA
+}
+
+
+counter <- 1
+for (mat in polymers) {
+	c2 <- 3
+	for (j in scenarios) {
+		load(paste0(main.path, "output_files/rdata/cont_", mat,"_", rounds, j, ".Rdata"))
+		df02[counter:I(counter +2), "river"] <- c("rhine", "rhone", "Le doubs") 
+		df02[counter:I(counter +2), "polymer"] <- mat
+		df02[counter:I(counter +2), c2] <- (s_r[c(441464, 441470, 441468), paste0("water_perM_", mat, "_MaP")])
+		c2 <- c2 +1
+	}
+	counter <- counter +3
+}
+
+
+df02
+total_inputs_perS <- sum(s_r$inputKawecki_perS_PET_MaP)
+
+df03 <- melt(df02, id.vars = c("river", "polymer")) %>% group_by(river, variable) %>% summarise(value = sum(value))
+
+x.cat <- c("weir", "lake", "river", "sedimentation", "combined", "base")
+df03$plot.cat <- NA
+
+df03$plot.cat[df03$variable %in% c("_weir05", "_weir25", "_weir50", "_weir75", "_weir95")] <- x.cat[1]
+df03$plot.cat[df03$variable %in% c("_baseLakesLinear", "_baseLakes05", "_baseLakes50", "_baseLakes95")] <- x.cat[2]
+df03$plot.cat[df03$variable %in% c("_baseRivers", "_baseRiversnoResus")] <- x.cat[3]
+df03$plot.cat[df03$variable %in% c("_LUlow", "_LUmid", "_LUhigh", "_Qlow", "_Qmid", "_Qhigh","_Slow" ,"_Smid", "_Shigh")] <- x.cat[4]
+df03$plot.cat[df03$variable %in% c("_base")] <- "base"
+df03$plot.cat[df03$variable %in% c("_null")] <- "null"
+df03$plot.cat[df03$variable %in% c("_high_all", "_low_all")] <- "combined"
+df03$plot.cat <- factor(df03$plot.cat, levels = x.cat)
+df03
+
+
+### rhine and rhone ###
+#calcualte percentages:
+# 1 - (value / _null)
+
+df03a <- df03
+null_rhine <- as.numeric(df03[df03$river == "rhine" & df03$variable == "_null", "value"]) #null scenario
+null_rhone <- as.numeric(df03[df03$river == "rhone" & df03$variable == "_null", "value"])
+
+df03a$value_percent <- NA
+df03a$value_percent[df03a$river == "rhine"] <- 1 - (df03a$value[df03a$river == "rhine"] / null_rhine) #percentage for rhine
+df03a$value_percent[df03a$river == "rhone"] <- 1 - (df03a$value[df03a$river == "rhone"] / null_rhone)
+
+df03a$value_percent <- df03a$value_percent*100
+
+
+df04 <- df03a %>% filter(river %in% c("rhone", "rhine")) %>% group_by(river, plot.cat) %>% summarise(mi = min(value_percent), ma = max(value_percent))
+
+lbs <- c("weir *\n(5%, 25%, 50%,\n 75%, 95%)", "lake *\n(5%, 50%, 95%,\n 'surface A')", "LU / Q / S *\n(low, mid, high)", "resuspension\n(yes / no)", "combined\n (min / max of *)", "'best guess'")
+pc <- c("weir", "lake", "sedimentation", "river", "combined", "base")
+df04$plot.cat <- factor(df04$plot.cat, levels = pc, labels = lbs)
+df03_sel <- df03a %>% filter(river %in% c("rhone", "rhine")) %>% filter(variable != "_null")
+df03_sel$plot.cat <- factor(df03_sel$plot.cat, levels = pc, labels = lbs)
+
+
+
+df03_sel %>% group_by(plot.cat) %>% summarise(sd(value_percent)) #noise within each group
+df03_sel %>% group_by(plot.cat) %>% summarise(mean(value_percent)) #noise within each group
+df03_sel %>% filter(!(variable %in% c("_Slow", "_LUlow", "_Slow"))) %>%  group_by(plot.cat) %>% summarise(sd(value_percent)) #take out low values for LU/q/S
+df03_sel %>% filter(!(variable %in% c("_Slow", "_LUlow", "_Slow"))) %>%  group_by(plot.cat) %>% summarise(mean(value_percent)) #take out low values for LU/q/S
+
+
+##########################
+# compare with data by Boaz2023
+Basel <- 93991
+Koblenz <- 93979
+Basel_model_all <- df_water_perM[Basel, "sum"] *60*60
+Koblenz_model_all <- df_water_perM[Koblenz, "sum"] *60*60
+Koblenz_model_POsoft <- rowSums(df_water_perM[Koblenz, c("LDPE", "PP")]) *60*60
+Basel_model_POsoft <- rowSums(df_water_perM[Basel, c("LDPE", "PP")]) *60*60
+Basel_model_POsoft/ Basel_model_all #portion of PO Soft
+Koblenz_model_POsoft/ Koblenz_model_all #portion of PO Soft
+
+
+
+#data hammerdirt
+
+locations <-read_excel("PhD/text/paper/macroplastic paper/data hammerdirt/data_organized.xlsx", sheet = "locations") %>% filter(water == "r") %>% select("location")
+loc <- locations$location
+length(loc)
+mass <-read_excel("PhD/text/paper/macroplastic paper/data hammerdirt/data_organized.xlsx", sheet = "survey mass data") %>% filter(location %in% loc)
+nrow(mass)
+mean(mass$mac_plast_w) #in gramms
+mass$mac_plast_w / mass$length #length in m -> g/m
+median(mass$mac_plast_w / mass$length) #length in m -> g/m
+
+
+dup_loc <- unique(mass$location[duplicated(mass$location)]) #location with multiple measurements...
+dup_loc_selected <- dup_loc[c(2, 3,4)]#select the two location at the aare river
+
+mass %>% filter(location %in% dup_loc_selected) %>% mutate(map_per_m = mac_plast_w/length) %>% select(survey_key, date, map_per_m)
+
+
+library(lubridate)
+date("2021-02-21")- date("2020-08-08") #time difference 197 days for schusspark aare locations
+date("2020-12-31")-date("2020-11-29")#time difference 32 days for spackmatt locations
+date("2021-03-29")-date("2020-06-12") #time difference 290 days for limmat
diff --git a/github_calculation/04_plots_effect_scenarios.R b/github_calculation/04_plots_effect_scenarios.R
new file mode 100644
index 0000000..b8b91ef
--- /dev/null
+++ b/github_calculation/04_plots_effect_scenarios.R
@@ -0,0 +1,324 @@
+####
+# plotting figures of the model
+# author: david mennekes, david.mennekes@empa.ch,
+# march 2023
+##################
+
+setwd("~/")
+# library packages
+
+	library(ggplot2)
+	library(dplyr)
+	library(tidyverse)
+	library(ggrepel)
+	library(patchwork) #for making all images the same dimensions.
+	library(cowplot)
+	library(ggpattern)
+	library(reshape2)
+	library(extrafont)
+
+	
+	
+	#load data
+	
+	polymers <- c("LDPE", "HDPE", "PP", "PS", "EPS", "PVC", "PET")
+
+	main.path <- "PhD/mennekes2.0/"
+
+	#load extra names
+	load(paste0(main.path, "temp_data/flow_files/print_round.Rdata"))
+	rounds <- "801"	
+
+	# load(paste0(main.path, "output_files/rdata/cont_HDPE_", rounds, extra_names[1], ".Rdata"))
+	# rm(s_r)
+	scenarios <- extra_names
+	
+	###df 02 for water
+	df02 <- data.frame(river = rep(NA, 3*length(polymers)),
+										 polymer = NA)
+	for (i in scenarios) {
+		df02[ , i] <- NA
+	}
+	
+	
+	counter <- 1
+	for (mat in polymers) {
+		c2 <- 3
+		for (j in scenarios) {
+			load(paste0(main.path, "output_files/rdata/cont_", mat,"_", rounds, j, ".Rdata"))
+			df02[counter:I(counter +2), "river"] <- c("rhine", "rhone", "Le doubs") 
+			df02[counter:I(counter +2), "polymer"] <- mat
+			df02[counter:I(counter +2), c2] <- (s_r[c(441464, 441470, 441468), paste0("water_perM_", mat, "_MaP")])
+			c2 <- c2 +1
+		}
+			counter <- counter +3
+	}
+	
+	
+	df02
+	total_inputs_perS <- sum(s_r$inputKawecki_perS_PET_MaP)
+	
+	df03 <- melt(df02, id.vars = c("river", "polymer")) %>% group_by(river, variable) %>% summarise(value = sum(value))
+	
+	x.cat <- c("weir", "lake", "river", "sedimentation", "combined", "base")
+	df03$plot.cat <- NA
+	
+	df03$plot.cat[df03$variable %in% c("_weir05", "_weir25", "_weir50", "_weir75", "_weir95")] <- x.cat[1]
+	df03$plot.cat[df03$variable %in% c("_baseLakesLinear", "_baseLakes05", "_baseLakes50", "_baseLakes95")] <- x.cat[2]
+	df03$plot.cat[df03$variable %in% c("_baseRivers", "_baseRiversnoResus")] <- x.cat[3]
+	df03$plot.cat[df03$variable %in% c("_LUlow", "_LUmid", "_LUhigh", "_Qlow", "_Qmid", "_Qhigh","_Slow" ,"_Smid", "_Shigh")] <- x.cat[4]
+	df03$plot.cat[df03$variable %in% c("_base")] <- "base"
+	df03$plot.cat[df03$variable %in% c("_null")] <- "null"
+	df03$plot.cat[df03$variable %in% c("_high_all", "_low_all")] <- "combined"
+	df03$plot.cat <- factor(df03$plot.cat, levels = x.cat)
+	df03
+	
+	### rhine ###
+	
+	df04 <- df03 %>% filter(river == "rhine") %>% group_by(plot.cat) %>% summarise(mi = min(value), ma = max(value))
+	df04$plot.cat <- factor(df04$plot.cat, levels = x.cat)
+	df03_rhine <- df03 %>% filter(river == "rhine")
+	#label data
+	
+	df03_median <- df03_rhine %>% filter(!(plot.cat %in% c("null", "base"))) %>% group_by(plot.cat) %>% summarise(med = median(value))
+	
+	#plot theme
+	
+	
+	nice <- theme_bw()+
+		theme(legend.position = "none",
+					legend.background = element_rect(fill = "transparent", color = NA),
+					plot.background = element_rect(fill = "transparent",colour = NA),
+					text = element_text(color = "black", size = 10),
+					axis.text.x = element_text(color = "black", face = "plain", size = 10),
+					axis.text.y = element_text(color = "black", face = "plain", size = 10),
+					legend.text = element_text(color = "black", face = "plain", size = 8),
+					panel.background = element_rect(fill = "transparent"),
+					panel.grid = element_blank(),
+					plot.subtitle = element_text(size = 10)) #trbl
+	
+	
+
+	pm = 0.01
+	
+	p01 <- ggplot(data = df04 %>% filter(plot.cat %in% c("lake", "river", "sedimentation", "weir", "combined")))+
+		geom_hline(yintercept = df03_rhine$value[df03_rhine$variable == "_base"], color = "black", lty = "dashed")+
+		geom_hline(yintercept = df03_rhine$value[df03_rhine$variable == "_null"])+
+		geom_segment(aes(x = plot.cat, xend = plot.cat,  y = mi, yend = ma), size = 5, colour = "grey80", alpha = 0.6)+
+		# geom_segmen<t(data = df03_median, aes(x = plot.cat, xend = plot.cat, y = med-pm, yend = med+pm), size = 5, colour = "black") +
+		geom_point(data = df03_rhine %>% filter(plot.cat %in% c("lake", "river", "sedimentation", "weir", "combined")), aes(x = plot.cat, y = value))+
+		scale_x_discrete(breaks = c("weir", "river", "sedimentation", "lake", "combined"), labels = c("weir", "river", "LU, Q, S", "lake", "combined"))+
+		scale_y_continuous(n.breaks = 3)+
+		labs(x = "scenarios", y = "macroplastic transport in water\nRiver Rhine in Basel [g/s]")+
+		annotate("text",x = as.factor("weir"), y = I(df03_rhine$value[df03_rhine$variable == "_null"] +2*pm), label = "no retention", hjust = "left", vjust = "right",  size = 2.5, color = "black")+
+		annotate("text",x = as.factor("weir"), y = I(df03_rhine$value[df03_rhine$variable == "_base"] -2*pm), label = "base scenario", hjust = "left", vjust = "left",  size = 2.5, color = "black")+
+		nice
+	
+	p01		
+		
+	# ggsave(plot = p01, paste0(main.path, "output_files/plots/plot01_rhine.png"), width = 8.5, height = 7, units = "cm", dpi = 500, bg = "transparent")
+	
+	
+	
+	### rhone ###
+	
+	df04 <- df03 %>% filter(river == "rhone") %>% group_by(plot.cat) %>% summarise(mi = min(value), ma = max(value))
+	df04$plot.cat <- factor(df04$plot.cat, levels = x.cat)
+	df03_rhine <- df03 %>% filter(river == "rhone")
+	#label data
+		
+		df03_median <- df03_rhine %>% filter(!(plot.cat %in% c("null", "base"))) %>% group_by(plot.cat) %>% summarise(med = median(value))
+	
+	#plot theme
+	
+	
+	nice <- theme_bw()+
+		theme(legend.position = "none",
+					legend.background = element_rect(fill = "transparent", color = NA),
+					plot.background = element_rect(fill = "transparent",colour = NA),
+					text = element_text(color = "black", size = 10),
+					axis.text.x = element_text(color = "black", face = "plain", size = 10),
+					axis.text.y = element_text(color = "black", face = "plain", size = 10),
+					legend.text = element_text(color = "black", face = "plain", size = 8),
+					panel.background = element_rect(fill = "transparent"),
+					legend.key = element_blank(),
+					panel.grid = element_blank(),
+					plot.subtitle = element_text(size = 10)) #trbl
+	
+	
+	
+	pm = 0.005
+	
+	p02 <- ggplot(data = df04 %>% filter(plot.cat %in% c("lake", "river", "sedimentation", "weir", "combined")))+
+		geom_hline(yintercept = df03_rhine$value[df03_rhine$variable == "_base"], color = "black", lty = "dashed")+
+		geom_hline(yintercept = df03_rhine$value[df03_rhine$variable == "_null"])+
+		geom_segment(aes(x = plot.cat, xend = plot.cat,  y = mi, yend = ma), size = 5, colour = "grey80", alpha = 0.6)+
+		# geom_segmen<t(data = df03_median, aes(x = plot.cat, xend = plot.cat, y = med-pm, yend = med+pm), size = 5, colour = "black") +
+		geom_point(data = df03_rhine %>% filter(plot.cat %in% c("lake", "river", "sedimentation", "weir", "combined")), aes(x = plot.cat, y = value))+
+		scale_x_discrete(breaks = c("weir", "river", "sedimentation", "lake", "combined"), labels = c("weir", "resuspension\nyes / no", "LU, Q, S", "lake", "combined"))+
+		scale_y_continuous(n.breaks = 3)+
+		labs(x = "\nscenarios", y = "macroplastic transport in water\nRiver Rhine in Basel [g/s]")+
+		annotate("text",x = as.factor("weir"), y = I(df03_rhine$value[df03_rhine$variable == "_null"] +2*pm), label = "no retention", hjust = "left", vjust = "right",  size = 2.5, color = "black")+
+		annotate("text",x = as.factor("weir"), y = I(df03_rhine$value[df03_rhine$variable == "_base"] -2*pm), label = "base scenario", hjust = "left", vjust = "left",  size = 2.5, color = "black")+
+		nice
+	
+	p02		
+	
+	# ggsave(plot = p02, paste0(main.path, "output_files/plots/plot01_rhone.png"), width = 8.5, height = 7, units = "cm", dpi = 500, bg = "transparent")
+	
+	
+	
+	### rhine and rhone ###
+	#calcualte percentages:
+	# 1 - (value / _null)
+	
+	df03a <- df03
+	null_rhine <- as.numeric(df03[df03$river == "rhine" & df03$variable == "_null", "value"]) #null scenario
+	null_rhone <- as.numeric(df03[df03$river == "rhone" & df03$variable == "_null", "value"])
+	
+	df03a$value_percent <- NA
+	df03a$value_percent[df03a$river == "rhine"] <- 1 - (df03a$value[df03a$river == "rhine"] / null_rhine) #percentage for rhine
+	df03a$value_percent[df03a$river == "rhone"] <- 1 - (df03a$value[df03a$river == "rhone"] / null_rhone)
+	
+	df03a$value_percent <- df03a$value_percent*100
+	
+	
+	df04 <- df03a %>% filter(river %in% c("rhone", "rhine")) %>% group_by(river, plot.cat) %>% summarise(mi = min(value_percent), ma = max(value_percent))
+	
+	lbs <- c("weir *\n(5%, 25%, 50%,\n 75%, 95%)", "lake *\n(5%, 50%, 95%,\n 'surface A')", "LU / Q / S *\n(low, mid, high)", "resuspension\n(yes / no)", "combined\n (min / max of *)", "'best guess'")
+	pc <- c("weir", "lake", "sedimentation", "river", "combined", "base")
+	df04$plot.cat <- factor(df04$plot.cat, levels = pc, labels = lbs)
+	df03_sel <- df03a %>% filter(river %in% c("rhone", "rhine")) %>% filter(variable != "_null")
+	df03_sel$plot.cat <- factor(df03_sel$plot.cat, levels = pc, labels = lbs)
+	
+	#plot theme
+	
+	
+	nice <- theme_bw()+
+		theme(legend.position = "none",
+					legend.background = element_rect(fill = "transparent", color = NA),
+					plot.background = element_rect(fill = "transparent",colour = NA),
+					text = element_text(color = "black", size = 10),
+					axis.text.x = element_text(color = "black", face = "plain", size = 10),
+					axis.text.y = element_text(color = "black", face = "plain", size = 10),
+					axis.title = element_text(color = "black", face = "plain", size = 10),
+					legend.text = element_text(color = "black", face = "plain", size = 8),
+					panel.background = element_rect(fill = "transparent"),
+					panel.grid = element_blank(),
+					plot.subtitle = element_text(size = 10)) #trbl
+	
+	
+	
+	pm = 0.005
+	#add shape
+	#low
+	low <- c("_weir05", "_baseLakes05", "_LUlow", "_Qlow", "_Slow", "_low_all")
+	high <- c("_weir95", "_baseLakes95", "_LUhigh", "_Qhigh", "_Shigh", "_high_all")
+	
+	df03_sel$shape_cat <- "mid"
+	df03_sel$shape_cat[df03_sel$variable %in% low] <- "low"
+	df03_sel$shape_cat[df03_sel$variable %in% high] <- "high"
+	df03_sel$shape_cat <- factor(df03_sel$shape_cat, levels = c("high", "mid", "low"))
+	df03_mima<- df03_sel %>% group_by(plot.cat, river) %>% summarise(mi = min(value_percent), ma = max(value_percent))
+	
+	p03 <- ggplot()+
+		geom_segment(data = df03_mima, aes(x = river , xend = river,  y = mi, yend = ma),size = 6.5, colour = "grey80")+
+		geom_point(data = df03_sel, aes(x = river, y = value_percent, fill = river, shape = shape_cat), size = 2.3)+
+		facet_wrap(~ plot.cat, strip.position = "bottom", scales = "free_x", nrow = 1, labeller = labeller(lbs))+
+		nice+
+		theme(panel.spacing = unit(0.3, "line"),
+					strip.background = element_blank(),
+					strip.placement = "outside",
+					legend.position = c(0.9,0.3),
+					axis.text.x = element_blank(),
+					legend.key.height = unit(0.35, "cm"),
+					legend.title = element_blank(),
+					legend.margin = margin(0,0,0,0),
+					axis.ticks.x = element_blank())+
+		scale_y_continuous(n.breaks = 3)+
+		labs(x = "\nanalyzed parameter scenarios", y = "macroplastic retention\n in catchment in [%]")+
+		scale_fill_manual(element_blank(), values = c("dodgerblue", "red3"), labels = c("Rhine", "Rhône"))+
+		scale_shape_manual(element_blank(), values = c(24,21,25), labels = c("highest", "other", "lowest"))+
+		guides(fill = guide_legend("Legend fill", override.aes = list(shape = 21)))
+	
+	p03
+	
+	ggsave(plot = p03, paste0(main.path, "output_files/plots/plot01_rhonerhine.png"), width = 17.8, height = 7, units = "cm", dpi = 500, bg = "transparent")
+	
+	
+	#for SI
+	df04 <- df03_sel
+	df04$variable
+	df04$x <- rep(c(5,25,50,75,95,NA,NA, 5,50,95,NA, NA, 14,50,86,14,50,86,14,50,86,11,89),2)
+	
+	df04$plot.cat2 <- NA
+	df04$plot.cat2[df04$variable %in% c("_weir05", "_weir25", "_weir50", "_weir75", "_weir95")] <- x.cat[1]
+	df04$plot.cat2[df04$variable %in% c("_baseLakesLinear", "_baseLakes05", "_baseLakes50", "_baseLakes95")] <- x.cat[2]
+	df04$plot.cat2[df04$variable %in% c("_baseRivers", "_baseRiversnoResus")] <- x.cat[3]
+	df04$plot.cat2[df04$variable %in% c("_LUlow", "_LUmid", "_LUhigh", "_Qlow", "_Qmid", "_Qhigh","_Slow" ,"_Smid", "_Shigh")] <- x.cat[4]
+	df04$plot.cat2[df04$variable %in% c("_base")] <- "base"
+	df04$plot.cat2[df04$variable %in% c("_null")] <- "null"
+	df04$plot.cat2[df04$variable %in% c("_high_all", "_low_all")] <- "combined"
+	
+	
+	
+	p04 <- ggplot(data = df04 %>% filter(!(is.na(x))), aes(x = x, y = value_percent, fill = plot.cat2, shape = river))+
+		geom_point( color = "black")+
+		scale_fill_manual("", values = c("combined" = '#e41a1c',"lake" = '#377eb8',"sedimentation" = '#4daf4a',"weir" = '#984ea3'),
+											labels = c("comdined *", "lake", "LU / Q / S *", "weirs"))+
+		scale_shape_manual("", values = c("rhine" = 21, "rhone"= 23), labels = c("Rhine", "Rhône"))+
+		guides(fill = guide_legend(override.aes = list(shape = 22, size = 3, color = NA)))+
+		scale_x_continuous(breaks = c(5,12.5, 25, 50, 75, 87.5, 95), labels = c("5", "low", "25", "50\nmid\n ", "75", "high", "95"))+
+		nice+
+		theme(legend.position = "right")+
+		labs(x = "retention per parameter [%]",
+				 y = "retention in catchment [%]")
+	
+	
+	
+	p04
+	ggsave(plot = p04, paste0(main.path, "output_files/plots/SI_plot01.png"), width = 13, height = 8, units = "cm", dpi = 500, bg = "transparent")
+	
+	
+	
+	
+	#plot for EGU
+	
+	nice2 <- theme_classic()+
+		theme(legend.position = "none",
+					legend.background = element_rect(fill = "transparent", color = NA),
+					plot.background = element_rect(fill = "transparent",colour = NA),
+					text = element_text(color = "white"),
+					axis.line = element_line(color = "white"),
+					axis.ticks = element_line(color = "white"),
+					axis.text.x = element_text(color = "white", face = "plain", size = 18),
+					axis.text.y = element_text(color = "white", face = "plain", size = 18),
+					axis.title = element_text(size = 15),
+					panel.background = element_rect(fill = "transparent")) #trbl
+	
+	
+	
+	p01_egu <- ggplot(data = df04 %>% filter(plot.cat %in% c("lake",  "sedimentation", "weir")))+
+		geom_segment(aes(x = plot.cat, xend = plot.cat,  y = mi, yend = ma), size = 20, colour = "black", alpha = 0)+
+		geom_hline(yintercept = df03_rhine$value[df03_rhine$variable == "_base"], color = "white", lty = "dashed")+
+		geom_hline(yintercept = df03_rhine$value[df03_rhine$variable == "_null"], color = "white")+
+		geom_segment(data = df04 %>% filter(plot.cat %in% c("lake", "weir", "sedimentation")), aes(x = plot.cat , xend = plot.cat,  y = mi, yend = ma), size = 20, colour = "grey90", alpha = 0.6)+
+		# geom_segment(data = df03_median, aes(x = plot.cat, xend = plot.cat, y = med-pm, yend = med+pm), size = 5, colour = "black") +
+		geom_point(data = df03_rhine %>% filter(variable != "_baseLakesLinear") %>% filter(plot.cat %in% c("sedimentation")), aes(x = plot.cat, y = value), fill = "#ff9900", color = "black",pch = 21, size = 8)+
+		geom_point(data = df03_rhine %>% filter(variable != "_baseLakesLinear") %>% filter(plot.cat %in% c("lake", "weir")), aes(x = plot.cat, y = value), fill = "white", color = "black",pch = 21, size = 8)+
+		scale_x_discrete(breaks = c("weir",  "sedimentation", "lake"), labels = c("weir",  "LU, Q, S", "lake"))+
+		labs(x = "scenarios", y = "macroplastic flow in [g/s]")+
+		# annotate("text",x = as.factor("weir"), y = I(df03_rhine$value[df03_rhine$variable == "_null"] -2*pm), label = "no retention", hjust = "center", vjust = "right",  size = 2, color = "black")+
+		# annotate("text",x = as.factor("lake"), y = I(df03_rhine$value[df03_rhine$variable == "_base"] +2*pm), label = "base scenario", hjust = "center", vjust = "left",  size = 2, color = "black")+
+		nice2
+	
+	p01_egu		
+	
+	# ggsave(plot = p01_egu, "PhD/präsi/für Konferenzen/2023 EGU/plot1e.png", width = 25, height = 16, units = "cm", dpi = 900, bg = "transparent")
+	
+	rm(list = ls())
+	
+	
+
+	
+	
\ No newline at end of file
diff --git a/github_calculation/04_plots_map_with_zoom.R b/github_calculation/04_plots_map_with_zoom.R
new file mode 100644
index 0000000..3a06210
--- /dev/null
+++ b/github_calculation/04_plots_map_with_zoom.R
@@ -0,0 +1,391 @@
+	#plot along ther rivers.
+	
+	# first all rivers that belong to the system
+	
+	library(ggplot2)
+	library(dplyr)
+	library(tidyverse)
+	library(ggrepel)
+	library(patchwork) #for making all images the same dimensions.
+	library(cowplot)
+	library(sf)
+	library(reshape2)
+	library(ggspatial)
+	library(scales)
+	
+	
+	#function
+	
+	#round numbers and find groups:
+	col.NR <- function(max.NR){
+		if(is.infinite(max.NR)){
+			return(c(0,0,0,0,0,0))
+		}else{
+			l <- log10(max.NR)
+			if(l == 0){start.NR <- 1} #wenn max wert genau 1 ist
+			if(l > 0){start.NR <- ceiling(max.NR/10^floor(l))*10^floor(l)}
+			if(l < 0){start.NR <- ceiling(max.NR*10^ceiling(l*-1))/10^ceiling(l*-1)}
+			return(c(start.NR,  start.NR*0.5, start.NR*0.25, start.NR*0.125, start.NR*0.0625, 0))
+		}
+	}
+	
+	col.NR2 <- function(values){ #enter value range
+		max.NR <- max(values, na.rm = T)
+		min.NR <- min(values[values>0], na.rm = T)
+		#top of the range
+		t <- log10(max.NR)
+		if(t == 0){end.NR <- 1} #wenn max wert genau 1 ist
+		if(t > 0){end.NR <- ceiling(max.NR/10^floor(t))*10^floor(t)}
+		if(t < 0){end.NR <- ceiling(max.NR*10^ceiling(t*-1))/10^ceiling(t*-1)}
+		#lower range
+		l <- log10(min.NR)
+		if(l == 0){start.NR <- 1} #wenn max wert genau 1 ist
+		if(l > 0){start.NR <- floor(min.NR/10^floor(l))*10^floor(l)}
+		if(l < 0){start.NR <- floor(min.NR*10^ceiling(l*-1))/10^ceiling(l*-1)}
+		d <- diff(c(start.NR, end.NR)) #find differences between first and last after floor / ceiling
+		if(d == 0){warning("no differences between min and max number")}
+		else{
+			med.NR <- median(values, na.rm = T) #find median of all numbers
+			if(log10(med.NR)< 0 & d >= 1){dig.med <- ceiling(abs(log10(med.NR)))} #for big differences digits are based on med value
+			if(log10(med.NR) < 0 & d < 1){dig.med <- ceiling(abs(log10(med.NR)))+ceiling(abs(log10(d)))} #if small differences ad extra digits
+			if(log10(med.NR) >= 0 & d >= 10){dig.med <- 0}
+			if(log10(med.NR) >= 0 & d < 10){dig.med <- ceiling(abs(log10(d)))}
+			q3 <- round(med.NR, dig.med) #rounded median number
+			
+			#find median of first quater
+			v <- values[values > q3]
+			med.NR <- median(v, na.rm = T)
+			if(log10(med.NR)< 0 & d >= 1){dig.med <- ceiling(abs(log10(med.NR)))} #for big differences digits are based on med value
+			if(log10(med.NR) < 0 & d < 1){dig.med <- ceiling(abs(log10(med.NR)))+ceiling(abs(log10(d)))} #if small differences ad extra digits
+			if(log10(med.NR) >= 0 & d >= 10){dig.med <- 0}
+			if(log10(med.NR) >= 0 & d < 10){dig.med <- ceiling(abs(log10(d)))}
+			q2 <- round(med.NR, dig.med) #rounded median number
+			
+			#find median of last quater
+			v <- values[values < q3]
+			med.NR <- median(v, na.rm = T)
+			if(log10(med.NR)< 0 & d >= 1){dig.med <- ceiling(abs(log10(med.NR)))} #for big differences digits are based on med value
+			if(log10(med.NR) < 0 & d < 1){dig.med <- ceiling(abs(log10(med.NR)))+ceiling(abs(log10(d)))} #if small differences ad extra digits
+			if(log10(med.NR) >= 0 & d >= 10){dig.med <- 0}
+			if(log10(med.NR) >= 0 & d < 10){dig.med <- ceiling(abs(log10(d)))}
+			q4 <- round(med.NR, dig.med) #rounded median number
+			
+			
+			
+			
+			return(c("q1" = end.NR, "q2" = q2 , "q3" = q3, "q4" = q4, "q5" = start.NR)) #return steps in equal steps
+		}
+	}
+	
+	#load dataset
+	main.path <- "PhD/mennekes2.0/"
+	load(paste0(main.path, "temp_data/forPlot.Rdata"))
+	load(paste0("PhD/mennekes/output_files/rdata/cont_EPS_801_lake15.Rdata"))
+	
+	
+	load(paste0(main.path, "temp_data/flow_files/print_round.Rdata"))
+	# extra_names <- c("_weir05", "_weir95")
+	rounds <- "801"
+	polymers <- c("EPS", "PP", "LDPE", "HDPE", "PS", "PVC", "PET")
+	
+	rhein <- 65062
+	doubs <- 329205
+	aare <- 79433
+	rhone <- 325768
+	
+	WWTP_ZH <- 14454
+	WWTP_BE<- 161439 #wwtp next to Bern (Aare River)
+	
+	
+	###wwtp Zürich
+	d <- rivers.all %>% dplyr::select(id_all, flow_to) %>% st_drop_geometry()
+	
+	d$x <- 0
+	d$x[WWTP_ZH] <- 1
+	ft <- d$flow_to[which(d$x == 1)]
+	ft_long <- WWTP_ZH
+	for (i in 1:800) {
+		d$x[ft] <- 1
+		ft_long <- c(ft_long, ft)
+		ft <- d$flow_to[ft]
+	}
+	sum(d$x)
+	
+	ft_wwtp_zh <- ft_long[1:sum(d$x)]
+	
+	len <- as.numeric(st_length(rivers.all[ft_wwtp_zh, ]))
+	len_cum <- cumsum(len)
+	ft_wwtp_zh <- ft_wwtp_zh[len_cum < 50000] #select only until km 50 from source
+	len_cum <- len_cum[len_cum <- 50000]
+	
+	
+	
+	
+	
+	
+	#load dataset
+	
+	lake <- s_r$isLake
+	no_outflow <- s_r$outflow == 0
+	rivers <- lake == F & no_outflow == T
+	
+	dfwater <- as.data.frame(matrix(NA, nrow = nrow(s_r), ncol = I(length(polymers)+ 1))) #*2 for scenarios
+	names(dfwater) <- c(polymers, "all") #value per s
+	
+	dfsed <- as.data.frame(matrix(NA, nrow = nrow(s_r), ncol = I(length(polymers)+ 1))) #*2 for scenarios
+	names(dfsed) <- c(polymers, "all")
+	
+	dfrem_acc_clean <- as.data.frame(matrix(NA, nrow = nrow(s_r), ncol = I(length(polymers)+ 1))) #*2 for scenarios
+	names(dfrem_acc_clean) <- c(polymers, "all")
+
+	dfinput <- as.data.frame(matrix(NA, nrow = nrow(s_r), ncol = I(length(polymers)+ 1))) #*2 for scenarios
+	names(dfinput) <- c(polymers, "all")
+	
+	#read the different data sets for each polymer
+	for (mat in polymers) {
+		load(paste0(main.path, "output_files/rdata/cont_", mat,"_", rounds, "_base", ".Rdata"))
+		dfwater[ , mat] <-  s_r[ , paste0("water_perM_",mat,"_MaP")]
+		dfsed[ , mat] <- s_r[ , paste0("sediment_perM_", mat, "_MaP")]
+		dfrem_acc_clean[ , mat] <- s_r[ , paste0("removal_perM_", mat, "_MaP")]+s_r[paste0("accumulation_perM_", mat, "_MaP")]+s_r[paste0("clean_perM_", mat, "_MaP")]
+		dfinput[ , mat] <- s_r[ , paste0("inputKawecki_perS_", mat, "_MaP")]
+	}
+	
+	dfwater$all <- rowSums(dfwater[ , polymers])
+	dfsed$all <- rowSums(dfsed[ , polymers])
+	dfrem_acc_clean$all <- rowSums(dfrem_acc_clean[ , polymers])
+	dfinput$all <- rowSums(dfinput[ , polymers])
+	
+	
+	
+	
+	
+	#figure##############################
+	
+	n <- names(dfwater)
+	n
+	load("PhD/mennekes/temp_data/flow_files/0000_geo.Rdata")
+	load("PhD/mennekes/data_raw/maps/lakes/lakes_poly.Rdata")
+	
+	#data for selection
+	buffer_river <- geo
+	# join the sed informatino with buffer_river
+	buffer_river$sed <- (dfsed$all)*1000 #*1000 to change the concentration from per m to per km
+	buffer_river$isLake <- s_r$isLake
+	selection_wwtp_sed <- buffer_river[ft_wwtp_zh, ]#find selection and add it to buffer data
+	selection_wwtp_sed$x <- len_cum
+	#find colors for printing in 5 groups
+	selection_wwtp_sed$conc_print <- "x"
+	# m <- mean(d2$conc, na.rm = T)
+	m_sed <- col.NR2(selection_wwtp_sed$sed) #find 5 groups of colors based on the function
+	#make factors of conc. for printing
+	selection_wwtp_sed$conc_print[selection_wwtp_sed$sed >= m_sed[2]] <- "a1" #biggest numbers
+	selection_wwtp_sed$conc_print[selection_wwtp_sed$sed <= m_sed[2]] <- "b1"
+	selection_wwtp_sed$conc_print[selection_wwtp_sed$sed <= m_sed[3]] <- "c1"
+	selection_wwtp_sed$conc_print[selection_wwtp_sed$sed <= m_sed[4]] <- "d1"
+	selection_wwtp_sed$conc_print[selection_wwtp_sed$sed <= m_sed[5]] <- "y" # 0 as conc
+	selection_wwtp_sed$conc_print <- as.factor(selection_wwtp_sed$conc_print)
+	
+	
+	
+	#same for water conc. in selection
+	conc <- dfwater[ft_wwtp_zh , "all"]
+	d2 <- geo[ft_wwtp_zh, ]
+	d2 <- cbind(d2, conc)
+	d2$conc <- d2$conc*1000 #change from per m to per km
+	d2$x <- len_cum
+	d2$conc_print <- "x"
+	m_w <- col.NR2(d2$conc) #find 5 groups of colors based on the function
+	#make factors of conc. for printing
+	d2$conc_print[d2$conc >= m_w[2]] <- "a2"
+	d2$conc_print[d2$conc <= m_w[2]] <- "b2"
+	d2$conc_print[d2$conc <= m_w[3]] <- "c2"
+	d2$conc_print[d2$conc <= m_w[4]] <- "d2"
+	d2$conc_print[d2$conc <= m_w[5]] <- "x"
+	d2$conc_print <- as.factor(d2$conc_print)
+	
+	selection_wwtp_water <- d2 #sf with water concentration for selection only
+	
+	
+	
+	
+	
+		
+		#get data for map of entire Switzerland
+		#for MiP in river water
+		conc <- dfwater[rivers, "all"]
+		d2 <- geo[rivers, ]
+		d2 <- cbind(d2, conc)
+		d2$conc <- d2$conc*1000 #change from m to km
+		d2$size <- 1
+		d2$size[d2$conc >0 ] <- 2
+		d2$conc[d2$conc == 0] <- NA
+		d2$conc_print <- "x"
+		# m <- mean(d2$conc, na.rm = T)
+		m <- col.NR2(d2$conc) #find 4 groups of colors based on the function
+		#make factors of conc. for printing
+		d2$conc_print[d2$conc >= m[2]] <- "a"
+		#extra group median of values bigger than m[2]
+		mm <- round(median(d2$conc[d2$conc >=m[2]], na.rm = T))
+		max(d2$conc, na.rm = T)
+		d2$conc_print[d2$conc <= mm] <- "b"
+		d2$conc_print[d2$conc <= m[2]] <- "c"
+		d2$conc_print[d2$conc <= m[3]] <- "d"
+		d2$conc_print[d2$conc <= m[4]] <- "e"
+		d2$conc_print[d2$conc <= m[5]] <- "x"
+		d2$conc_print <- as.factor(d2$conc_print)
+		
+		
+		#change the theme to the selection for the rivers that are in the zoomed in area
+		#	#use the same scale for all rivers in the geographical limits
+		limits_data <-  st_as_sfc(st_bbox(selection_wwtp_sed))
+		limits <- st_bbox(selection_wwtp_sed)
+		trib <- st_intersection(geo[rivers, ], limits_data)
+		trib$flow_to <- s_r$flow_to[trib$id_all_geo]
+		trib$flow_to[trib$flow_to %in% s_r$id_all[s_r$outflow != 0]] <- 0 #for all the rivers that flow to unknown; change to 0
+		
+		####
+		#find only rivers that flow into the selection
+		
+		#start with the last segment of the selection and add to all flow from a 1
+		trib$partof <- 0 #part of the tributaries
+		trib$partof[which(trib$id_all_geo %in% ft_wwtp_zh)] <- 1 #all sections of the main river are selected
+		for (i in 1:500) {
+			ids <- trib$id_all_geo[trib$partof == 1] #get geo IDs with one
+			trib$partof[trib$flow_to %in% ids] <- 1 #write 1 when the flow to refers to a an id with 1
+		}
+		
+		ids_trib <- trib$id_all_geo[trib$partof==1] #id_geo_all of all tributaries
+		
+		#bring all tributaries in the color 
+		trib <- d2[d2$id_all_geo %in% ids_trib, ]
+		trib$conc_print <- "x"
+		max(trib$conc, na.rm = T) < m_w[1] #max value in the network should be smaller than max value in the printing ranges: TRUE should be the answer
+		trib$conc_print[trib$conc >= m_w[2]] <- "a2"
+		trib$conc_print[trib$conc <= m_w[2]] <- "b2"
+		trib$conc_print[trib$conc <= m_w[3]] <- "c2"
+		trib$conc_print[trib$conc <= m_w[4]] <- "d2"
+		trib$conc_print[trib$conc <= m_w[5]] <- "x"
+		trib$conc_print <- as.factor(trib$conc_print)
+		
+		
+		
+		
+		
+	#colors for printing
+	farben <- c('#d7191c','#fdae61','#ffd700','#91bfdb','#0571b0', "grey70")
+	# farben <- c('#d01c8b', '#d7191c','#fdae61','#abd9e9','#2c7bb6', "grey70")
+	farben_blue<- c('#253494','#2c7fb8','#41b6c4','#a1dab4', "grey70")
+	farben_red <- c('#bd0026','#f03b20','#fd8d3c','#fecc5c', "grey70") 
+	
+	nice <- theme_bw()+
+		theme(legend.background = element_rect(fill = "white", color = NA),
+					legend.margin = margin(0.1,0.1,0,0.1, unit = "cm"),
+					plot.background = element_rect(fill = "transparent",colour = NA),
+					text = element_text(color = "black"),
+					axis.text.x = element_text(color = "black", face = "plain", size = 7),
+					axis.text.y = element_text(color = "black", face = "plain", size = 7),
+					legend.text = element_text(size = 7), #evtl hinzufügen: margin = margin(r = 1, unit = "cm")
+					legend.title = element_text(size = 7),
+					legend.spacing = unit(0.1, "cm"),
+					panel.background = element_rect(fill = "transparent"),
+					axis.title = element_blank(),
+					plot.title = element_text(size = 7),
+					legend.key = element_rect(fill = "transparent", colour = "transparent"),
+					legend.key.size = unit(0.4, "cm"),
+					plot.subtitle = element_text(size = 7)) #trbl
+	klein = 0.02
+	gross = 0.5
+	
+		
+		
+		
+		
+		plotlimits_big <- st_bbox(d2)
+		
+		
+		#big plot for Switzerland
+		pr <- ggplot()+
+			geom_sf(data = lakes_poly[lakes_poly$area > 100000, ], color = "black", fill = "white", linewidth = klein)+
+			geom_sf(data = d2[d2$size == 1, ],  aes(color = conc_print), linewidth = klein)+
+			geom_sf(data = d2[d2$size == 2, ],  aes(color = conc_print), linewidth = gross)+
+			scale_colour_manual(paste0("main map:\nmacroplastic mass\nin water in [g/km]"),
+													values = farben,
+													breaks = c("a", "b", "c", "d","e", "x"),
+													labels = c(paste0(mm," - ",round(max(d2$conc, na.rm = T))),paste0(m[2]," - ",mm), paste0(m[3]," - ",m[2]),paste0(m[4]," - ",m[3]),paste0(m[5]," - ",m[4]), "0"), drop = F)+
+			nice+
+			scale_y_continuous(limits = c(plotlimits_big$ymin -10000, plotlimits_big$ymax+40000), breaks = c(48,47, 46))+
+			scale_x_continuous(limits = c(plotlimits_big$xmin -40000, plotlimits_big$xmax+20000))+
+			# labs(title = paste0(i_print, " in rivers"))+
+			ggspatial::annotation_scale(location = "br", height = unit(0.2, "cm"), text_pad = unit(7, "pt"), line_width = 1)+
+			ggspatial::annotation_north_arrow(width = unit(0.4, "cm"), height = unit(1, "cm"),style = north_arrow_orienteering(text_size = 7))+
+			theme(legend.position = c(0.91,0.23))+
+			geom_sf(data = limits_data, fill = NA, color = "black", linewidth = gross*2)
+		
+		# pr
+		# ggsave(paste0("PhD/mennekes2.0/output_files/plots/map_river_allPolymer.png"), plot = pr, width = 17.8, height = 10, units = "cm", dpi = 1000, bg = "transparent")
+		#width 17.8 for EST Water
+		
+	
+	s1 <- 1.3 #size linewidth
+	p_wwtp_ZH <- st_as_sf(st_line_sample(geo[WWTP_ZH, ], sample = 0))
+	rownames(p_wwtp_ZH) <- "WWTP"
+	
+		
+	
+	#plot for selection
+	p2 <- ggplot()+
+		geom_sf(data = selection_wwtp_sed, aes(color = conc_print), linewidth = s1*3)+
+		geom_sf(data = trib, aes(color = conc_print), linewidth = s1/2)+
+		geom_sf(data = selection_wwtp_water, aes(color = conc_print), linewidth = s1)+
+		geom_sf(data = p_wwtp_ZH, color = "black", size = s1*3, pch = 18)+
+		# scale_color_manual(paste0("water [g/km]"),
+		# 										values = farben_blue,
+		# 										breaks = c("a2", "b2", "c2", "d2", "e2", "x"),
+		# 										labels = c(paste0(m_w[2]," - ",m_w[1]), paste0(m_w[3]," - ",m_w[2]),paste0(m_w[4]," - ",m_w[3]),paste0(m_w[5]," - ",m_w[4]),paste0("> 0 - ",m_w[5]), "0"), drop = F)+
+		scale_color_manual(paste0("inset map:\nwater [g/km]      temp. storage [g/(km * s)]"),
+											values = c("a1" = farben_red[1], "b1" = farben_red[2], "c1" = farben_red[3], "d1" = farben_red[4], "x" = farben_red[5],
+																 "a2" = farben_blue[1], "b2" = farben_blue[2], "c2" = farben_blue[3], "d2" = farben_blue[4], "y" = "white"),
+											breaks = c("a2", "b2", "c2", "d2", "x", "a1", "b1", "c1", "d1", "y"),
+											labels = c(paste0( m_w[2]," - ",m_w[1]), paste0(m_w[3]," - ",m_w[2]),paste0( m_w[4]," - ",m_w[3]), paste0( m_w[5]," - ",m_w[4]), "0", paste0( m_sed[2]," - ",m_sed[1]), paste0(m_sed[3]," - ",m_sed[2]),paste0( m_sed[4]," - ",m_sed[3]), paste0( m_sed[5]," - ",m_sed[4]), " "), drop = F)+
+		nice+
+		guides(color=guide_legend(ncol=2, byrow=F))+
+		scale_y_continuous(limits = c(limits$ymin-800, limits$ymax+800), expand = c(0,0))+
+		scale_x_continuous(limits = c(limits$xmin, limits$xmax+1300), expand = c(0,0))+
+		ggspatial::annotation_scale(location = "bl", height = unit(0.1, "cm"), text_pad = unit(5, "pt"), line_width = 1)+
+		geom_sf_text(data = p_wwtp_ZH, aes(label = rownames(p_wwtp_ZH)), vjust = -1.1, hjust = 0.85, size = 3)+
+		theme(legend.text = element_text( margin = margin(r = 0.1, unit = "cm"), size = 6),
+					legend.title = element_text(size = 6),
+					panel.grid = element_blank(),
+					axis.ticks = element_blank(),
+					axis.text.x = element_blank(),
+					axis.text.y = element_blank(),
+					legend.position = c(0.9,0.8),
+					panel.background = element_rect(fill = "white"),
+					legend.margin = margin(1,1,1.5,1),
+					legend.key.size = unit(0.22, "cm"),
+					legend.background = element_rect(fill = "white", color = "black", linewidth = 0.1),
+					panel.border = element_rect(linewidth = gross*4)			)
+	
+	
+	# p2
+	
+	p3 <- ggdraw(pr)+
+		draw_plot(
+			p2,
+			x = -0.03,
+			y = 0.56,
+			width = 0.42,
+			height = 0.42)
+	Sys.sleep(1)
+	ggsave(paste0("PhD/mennekes2.0/output_files/plots/map_river_all_w_insert.png"), plot = p3, width = 17.8, height = 12, units = "cm", dpi = 1000, bg = "transparent")
+	ggsave(paste0("PhD/mennekes2.0/output_files/plots/map_river_all_w_insert.pdf"), plot = p3, width = 17.8, height = 12, units = "cm", dpi = 1000, bg = "transparent")
+	
+	
+	
+	
+	
+	
+	
+	
+
+rm(list = ls())
diff --git a/github_calculation/04_plots_sums.R b/github_calculation/04_plots_sums.R
new file mode 100644
index 0000000..adf3ee1
--- /dev/null
+++ b/github_calculation/04_plots_sums.R
@@ -0,0 +1,519 @@
+	#### plot 02
+	
+	#total masses outflows:
+	
+	####
+	# plotting figures of the model
+	# author: david mennekes, david.mennekes@empa.ch, 
+	# march 2022
+	##################
+	
+	
+	setwd("~/")
+	main.path <- "PhD/mennekes2.0/"# library packages
+	
+	library(reshape)
+	library(ggplot2)
+	library(dplyr)
+	library(tidyverse)
+	library(ggrepel)
+	library(patchwork) #for making all images the same dimensions.
+	library(cowplot)
+	
+	
+	
+	#load data
+	
+	polymers <- c("EPS", "PP", "PS", "LDPE", "HDPE", "PVC", "PET")
+	
+	base <- "_base"
+	rounds <- "801"
+	
+	load(paste0(main.path, "output_files/rdata/cont_HDPE_", rounds, base, ".Rdata"))
+	compartments <- c("outflow", "sediment_tot", "accumulation_tot", "removal_tot")
+	
+	# load for each variable a one data frame
+	
+	# overall contamination switzerland, figure with overall burial, accumulation, sedimentation and plastics in water
+	#create dataframe
+	
+	
+	### load data in water
+	df01 <- as.data.frame(matrix(NA, nrow = nrow(s_r), ncol = I(length(polymers)+ 4))) #*2 for scenarios
+	names(df01) <- c(polymers, "flow_to", "isLake", "id_all", "outflow")
+	
+	
+	#load data in water
+	for (mat in polymers) {
+			load(paste0(main.path, "output_files/rdata/lakes_single/cont_", mat,"_", rounds, "_base.Rdata"))
+			df01[, mat] <- s_r2[ , paste0("water_perM_", mat, "_MaP")]
+			df01[ , c("flow_to", "isLake", "id_all", "outflow")] <- s_r2[ , c("flow_to", "isLake", "id_all", "outflow")]
+	}
+	rm(s_r2)
+	df_water_perM <- df01
+	df_water_perM$sum <- rowSums(df_water_perM[ , polymers])
+	
+	
+	
+	### load data removal tot
+	df01 <- as.data.frame(matrix(NA, nrow = nrow(s_r), ncol = I(length(polymers)+ 4))) #*2 for scenarios
+	names(df01) <- c(polymers, "flow_to", "isLake", "id_all", "outflow")
+	
+	for (mat in polymers) {
+		load(paste0(main.path, "output_files/rdata/lakes_single/cont_", mat,"_", rounds, "_base.Rdata"))
+		df01[, mat] <- s_r2[ , paste0("removal_tot_", mat, "_MaP")]
+		df01[ , c("flow_to", "isLake", "id_all", "outflow")] <- s_r2[ , c("flow_to", "isLake", "id_all", "outflow")]
+	}
+	rm(s_r2)
+	df_removal_tot <- df01
+	df_removal_tot$sum <- rowSums(df_removal_tot[ , polymers])
+	
+	### load data clean tot
+	df01 <- as.data.frame(matrix(NA, nrow = nrow(s_r), ncol = I(length(polymers)+ 4))) #*2 for scenarios
+	names(df01) <- c(polymers, "flow_to", "isLake", "id_all", "outflow")
+	
+	for (mat in polymers) {
+		load(paste0(main.path, "output_files/rdata/lakes_single/cont_", mat,"_", rounds, "_base.Rdata"))
+		df01[, mat] <- s_r2[ , paste0("clean_tot_", mat, "_MaP")]
+		df01[ , c("flow_to", "isLake", "id_all", "outflow")] <- s_r2[ , c("flow_to", "isLake", "id_all", "outflow")]
+	}
+	rm(s_r2)
+	df_clean_tot <- df01
+	df_clean_tot$sum <- rowSums(df_clean_tot[ , polymers])
+	
+	
+	### load data accumulation tot
+	df01 <- as.data.frame(matrix(NA, nrow = nrow(s_r), ncol = I(length(polymers)+ 4))) #*2 for scenarios
+	names(df01) <- c(polymers, "flow_to", "isLake", "id_all", "outflow")
+	
+	for (mat in polymers) {
+		load(paste0(main.path, "output_files/rdata/lakes_single/cont_", mat,"_", rounds, "_base.Rdata"))
+		df01[, mat] <- s_r2[ , paste0("accumulation_tot_", mat, "_MaP")]
+		df01[ , c("flow_to", "isLake", "id_all", "outflow")] <- s_r2[ , c("flow_to", "isLake", "id_all", "outflow")]
+	}
+	rm(s_r2)
+	df_accumulation_tot <- df01
+	df_accumulation_tot$sum <- rowSums(df_accumulation_tot[ , polymers])
+	
+	
+	### load data temp storage
+	
+	df01 <- as.data.frame(matrix(NA, nrow = nrow(s_r), ncol = I(length(polymers)+ 4))) #*2 for scenarios
+	names(df01) <- c(polymers, "flow_to", "isLake", "id_all", "outflow")
+	
+	for (mat in polymers) {
+		load(paste0(main.path, "output_files/rdata/lakes_single/cont_", mat,"_", rounds, "_base.Rdata"))
+		df01[, mat] <- s_r2[ , paste0("sediment_tot_", mat, "_MaP")]
+		df01[ , c("flow_to", "isLake", "id_all", "outflow")] <- s_r2[ , c("flow_to", "isLake", "id_all", "outflow")]
+	}
+	rm(s_r2)
+	df_sediment_tot <- df01
+	df_sediment_tot$sum <- rowSums(df_sediment_tot[ , polymers])
+	
+	
+	### load data for control (scenario Null)
+	df01 <- as.data.frame(matrix(NA, nrow = nrow(s_r), ncol = I(length(polymers)+ 4))) #*2 for scenarios
+	names(df01) <- c(polymers, "flow_to", "isLake", "id_all", "outflow")
+	
+	for (mat in polymers) {
+		load(paste0(main.path, "output_files/rdata/lakes_single/cont_", mat,"_", rounds, "_null.Rdata"))
+		df01[, mat] <- s_r2[ , paste0("water_perM_", mat, "_MaP")]
+		df01[ , c("flow_to", "isLake", "id_all", "outflow")] <- s_r2[ , c("flow_to", "isLake", "id_all", "outflow")]
+	}
+	rm(s_r2)
+	df_null <- df01
+	df_null$sum <- rowSums(df_null[ , polymers])
+	
+	
+	
+	
+	# get network of one river
+	#######################################
+	outflow_1_Rhine <- 441464
+	outflow_1_Rhone <- 441470
+	outflow_1_Aare_top <- 79433
+	
+	######### results for Rhine ##########
+	#find all rivers connected to the stream rhine
+	trib <- data.frame(flow_to <- s_r$flow_to,
+										 id_all <- s_r$id_all)
+	trib$partof <- 0 #part of the tributaries
+	trib$partof[outflow_1_Rhine] <- 1 #all sections of the main river are selected
+	for (i in 1:700) {
+		ids <- trib$id_all[trib$partof == 1] #get geo IDs with one
+		trib$partof[trib$flow_to %in% ids] <- 1 #write 1 when the flow to refers to a an id with 1
+	}
+	
+	ids_trib <- trib$id_all[trib$partof==1]
+	
+	water_rhine <- melt(df_water_perM[outflow_1_Rhine, polymers])
+	water_rhine$value <- water_rhine$value*60*60*24*365/1000 #in kg / year
+	water_rhine$river <- "Rhine"
+	
+	
+	ids_trib_river <- ids_trib[which(ids_trib%in%s_r$id_all[s_r$isLake == F])]
+	ids_trib_lakes <- ids_trib[which(ids_trib%in%s_r$id_all[s_r$isLake == T])]
+	
+	
+	ezg_rhine <- data.frame(ausfluss = df_water_perM[outflow_1_Rhine, "sum"],
+													acc_river = sum(df_accumulation_tot$sum[ids_trib_river], na.rm = T),
+													acc_lake = sum(df_accumulation_tot$sum[ids_trib_lakes], na.rm = T),
+													clean_river = sum(df_clean_tot$sum[ids_trib_river], na.rm = T),
+													clean_lake = sum(df_clean_tot$sum[ids_trib_lakes], na.rm = T),
+													rem = sum(df_removal_tot$sum[ids_trib], na.rm = T))
+	temp_storage_rhine = sum(df_sediment_tot$sum[ids_trib], na.rm = T) #is per second
+	ezg_rhine_melt <- melt(ezg_rhine)
+	ezg_rhine_melt$value <- ezg_rhine_melt$value*60*60*24*365/1000 #in kg per year
+	
+	#control shows me: the null retention is the same value assuming up different values. all perfect!
+	tot_input_rhine <- df_null[outflow_1_Rhine, "sum"]
+	tot_input_rhine
+	
+	ezg_rhine_melt$value_percent <- ezg_rhine_melt$value/ (tot_input_rhine*60*60*24*365/1000)*100
+	##
+	
+	ezg_rhine_melt$color <- c("a", "b", "b", "c", "c", "d") #add factors for colors
+	ezg_rhine_melt$pattern <- c("x", "x", "y", "x", "y", "x")
+	
+	
+	######### results for rhone ##########
+	#find all rivers connected to the stream rhone
+	trib <- data.frame(flow_to <- s_r$flow_to,
+										 id_all <- s_r$id_all)
+	trib$partof <- 0 #part of the tributaries
+	trib$partof[outflow_1_Rhone] <- 1 #all sections of the main river are selected
+	for (i in 1:700) {
+		ids <- trib$id_all[trib$partof == 1] #get geo IDs with one
+		trib$partof[trib$flow_to %in% ids] <- 1 #write 1 when the flow to refers to a an id with 1
+	}
+	
+	ids_trib <- trib$id_all[trib$partof==1]
+	
+	water_rhone <- melt(df_water_perM[outflow_1_Rhone, polymers])
+	water_rhone$river <- "Rhône"
+	water_rhone$value <- water_rhone$value*60*60*24*365/1000
+	
+	
+	ids_trib_river <- ids_trib[which(ids_trib%in%s_r$id_all[s_r$isLake == F])]
+	ids_trib_lakes <- ids_trib[which(ids_trib%in%s_r$id_all[s_r$isLake == T])]
+	
+	
+	ezg_rhone <- data.frame(ausfluss = df_water_perM[outflow_1_Rhone, "sum"],
+													acc_river = sum(df_accumulation_tot$sum[ids_trib_river], na.rm = T),
+													acc_lake = sum(df_accumulation_tot$sum[ids_trib_lakes], na.rm = T),
+													clean_river = sum(df_clean_tot$sum[ids_trib_river], na.rm = T),
+													clean_lake = sum(df_clean_tot$sum[ids_trib_lakes], na.rm = T),
+													rem = sum(df_removal_tot$sum[ids_trib], na.rm = T))
+	ezg_rhone_melt <- melt(ezg_rhone)
+	ezg_rhone_melt$value <- ezg_rhone_melt$value*60*60*24*365/1000 #in kg per year
+	
+	#control shows me: the null retention is the same value assuming up different values. all perfect!
+	tot_input_rhone <- df_null[outflow_1_Rhone, "sum"]
+	tot_input_rhone
+	
+	ezg_rhone_melt$value_percent <- ezg_rhone_melt$value/ (tot_input_rhone*60*60*24*365/1000)*100
+	##
+	
+	ezg_rhone_melt$color <- c("a", "b", "b", "c", "c", "d") #add factors for colors
+	ezg_rhone_melt$pattern <- c("x", "x", "y", "x", "y", "x")
+	
+	
+	#### rbind both tables
+	ezg_rhine_melt$river <- "Rhine"
+	ezg_rhone_melt$river <- "Rhône"
+	
+	ezg_rr <- rbind(ezg_rhine_melt, ezg_rhone_melt)
+	ezg_rr$color <- factor(ezg_rr$color, levels = c("a", "b", "c", "d"))
+	
+	# ezg_rr$pattern <- fct_reorder(ezg_rr$pattern)
+	
+	
+	
+	
+	
+	
+	#### data for total masses
+	###################
+	
+	######### results for rhone ##########
+	#find all rivers connected to the stream rhone
+	
+	water_all <- melt(colSums(df_water_perM[df_water_perM$outflow %in% c(1,3), polymers]))
+	water_all <- cbind(variable = rownames(water_all), water_all)
+	water_all$value <- water_all$value*60*60*24*365/1000
+	water_all$river <- "all"
+	
+	
+	
+	
+	ezg_all <- data.frame(ausfluss = sum(df_water_perM[df_water_perM$outflow %in% c(1,3) , "sum"], na.rm = T),
+													acc_river = sum(df_accumulation_tot$sum[df_accumulation_tot$isLake == F], na.rm = T),
+													acc_lake = sum(df_accumulation_tot$sum[df_accumulation_tot$isLake == T], na.rm = T),
+													clean_river = sum(df_clean_tot$sum[df_clean_tot$isLake == F], na.rm = T),
+													clean_lake = sum(df_clean_tot$sum[df_clean_tot$isLake == T], na.rm = T),
+													rem = sum(df_removal_tot$sum, na.rm = T))
+	ezg_all_melt <- melt(ezg_all)
+	ezg_all_melt$value <- ezg_all_melt$value*60*60*24*365/1000 #in kg per year
+	
+	#control shows me: the null retention is the same value assuming up different values. all perfect!
+	tot_input_all <- sum(ezg_all, na.rm = T)
+	tot_input_all
+	
+	ezg_all_melt$value_percent <- ezg_all_melt$value/ (tot_input_all*60*60*24*365/1000)*100
+	##
+	
+	ezg_all_melt$color <- c("a", "b", "b", "c", "c", "d") #add factors for colors
+	ezg_all_melt$pattern <- c("x", "x", "y", "x", "y", "x")
+	
+	
+	#### rbind all tables
+	ezg_rhine_melt$river <- "Rhine *"
+	ezg_rhone_melt$river <- "Rhône *"
+	ezg_all_melt$river <- "all Swiss water bodies"
+	
+	ezg_rr <- rbind(ezg_rhine_melt, ezg_rhone_melt, ezg_all_melt)
+	ezg_rr$color <- factor(ezg_rr$color, levels = c("a", "b", "c", "d"))
+	
+	
+	
+	
+	
+	#dataframe all
+	
+	
+	### rbind dataframes
+	
+	df_water_perPolymer <- rbind(water_rhine, water_rhone, water_all)
+	
+	##### plot
+	
+	#total outflow of Macroplastic
+	
+	nice <- theme_classic()+
+		theme(legend.position = "none",
+					legend.background = element_rect(fill = "transparent", color = NA),
+					plot.background = element_rect(fill = "transparent",colour = NA),
+					text = element_text(color = "black", size = 10),
+					axis.text.x = element_text(color = "black", face = "plain", size = 10),
+					axis.text.y = element_text(color = "black", face = "plain", size =10),
+					legend.text = element_text(color = "black", face = "plain", size = 8),
+					axis.title.x = element_blank(), 
+					axis.title.y = element_text(size = 10),
+					axis.ticks.x = element_blank(),
+					panel.background = element_rect(fill = "transparent")) #trbl
+	
+	
+	farben <- rev(c("#cc5700", "#c97544", "#bf9077", "#aaaaaa", "#92a1c7", "#6f98e3", "#1e90ff"))
+	
+	p01 <- ggplot(data=df_water_perPolymer, aes(x=river, y=value, fill=variable)) +
+		geom_bar(stat="identity")+
+		scale_y_continuous(expand = c(0,0,0,10),breaks = c(0, 1000,  2000))+
+		scale_x_discrete(labels = c("all cross border flows\nincl. to unknown", "Rhine\n(border Germany)", "Rhône\n(border France)" ), expand = c(0.2,0.1))+
+		labs(y = "total macroplastic outflow  \nin suspension [kg / year]  \n ")+
+		scale_fill_manual("",
+											values = farben)+
+		nice +
+		theme(plot.margin=unit(c(0.6,0.6,0.3,0.2),"cm")) #trbl
+	
+	
+	
+	p01
+	
+	#legende
+	l <- data.frame(value = rev(c(1,1,1,1,1,1,1)),
+									river = "Legend\n",
+									polymer = c("EPS", "PP", "LDPE", "HDPE", "PS", "PVC", "PET"),
+									pos = c(0.5,1.5,2.5,3.5,4.5,5.5,6.5))
+	l$polymer <- factor(l$polymer,
+											levels = c("EPS", "PP", "LDPE", "HDPE", "PS", "PVC", "PET"))
+	
+	legende <- ggplot(data=l, aes(x=river, y=value, fill=polymer)) +
+		geom_bar(stat="identity")+
+		scale_y_continuous(expand = c(0,0.1,0, 0))+
+		scale_x_discrete( expand = c(0.4,0.1))+
+		geom_text(aes(y = pos, label = rev(polymer)), color = c( "black"),size = 2)+
+		labs(y = "MiP\nin [kg / year]")+
+		scale_fill_manual("",
+											values = farben)+
+		theme_void()+
+		theme(plot.margin=unit(c(1.5,0,0.5,0),"cm"),
+					legend.position = "none",
+					axis.text.x = element_blank(),
+					panel.border = element_blank(),
+					panel.ontop = F,
+					plot.subtitle = element_text(size = 7))
+	
+	legende
+	
+	
+	############################ plot 2
+	
+	farben <- c('dodgerblue',  "red3", '#555555','#cccccc')
+	
+	library(ggpattern)
+	
+	p02 <- ggplot(data = ezg_rr, aes(x = river, y = value_percent))+
+		geom_bar_pattern(stat = "identity", aes(pattern = variable, fill = color), pattern_density = .1, pattern_spacing = 0.03, pattern_fill = "black", pattern_color = NA)+
+		scale_pattern_manual("", values = c(ausfluss = "none",acc_river = "none", clean_river = "none", rem = "none", acc_lake = "crosshatch", clean_lake = "crosshatch"))+
+		scale_fill_manual("", values = c("a" = farben[1], "b" = farben[3], "c" = farben[4], "d" = farben[2]))+
+		scale_y_continuous(expand = c(0,0,0,0.1), n.breaks = 3)+
+		scale_x_discrete(expand = c(0.2,0.1))+
+		nice+
+		labs(y = "distribution of macroplastic\nin catchment [%]")+
+		theme(plot.margin=unit(c(0.7,0.6,0,0.2),"cm"))
+	
+	
+	p02
+	
+	p02L <- ggplot(data = ezg_rr, aes(x = river, y = value_percent))+
+		geom_bar(stat = "identity", aes(fill = color))+
+		# scale_pattern_manual("", values = c(ausfluss = "none",acc_river = "none", clean_river = "none", rem = "none", acc_lake = "crosshatch", clean_lake = "crosshatch"))+
+		scale_fill_manual("", values = c("a" = farben[1], "b" = farben[3], "c" = farben[4], "d" = farben[2]), labels = c("outflow in suspension", "accumulated", "cleaned", "removed\n(hydro power plant)"))+
+		scale_y_continuous(expand = c(0,0,0,0.1))+
+		nice+
+		theme(legend.position = "right",
+					legend.title = element_blank())+
+		labs(y = "distribution in [%]")
+	p02L
+	l021 <- get_legend(p02L)
+	
+	
+	p02L2 <- ggplot(data = ezg_rr[2:3, ], aes(x = river, y = value_percent))+
+		geom_bar_pattern(stat = "identity", aes(pattern = variable), pattern_density = .1, pattern_spacing = 0.03, pattern_fill = "black", pattern_color = NA, fill = NA, color = "grey50")+
+		scale_pattern_manual("", values = c(ausfluss = "none",acc_river = "none", clean_river = "none", rem = "none", acc_lake = "crosshatch", clean_lake = "crosshatch"), labels = c(" - in rivers", " - in lakes"))+
+		# scale_fill_manual("", values = c("a" = farben[1], "b" = farben[3], "c" = farben[4], "d" = farben[2]), labels = c("outflow in suspension", "accumulated", "cleaned", "removed (rivers)"))+
+		scale_y_continuous(expand = c(0,0,0,0.1))+
+		nice+
+		theme(legend.position = "right",
+					legend.title = element_blank())+
+		labs(y = "distribution\nof macroplastic in [%]")
+	
+	
+	p02L2
+	l022 <- get_legend(p02L2)
+	
+	
+	#empty plot
+	
+	pe <- ggplot() +                     
+		annotate("text",
+						 x = 1,
+						 y = 1,
+						 label = "       ") + 
+		theme_void()+
+		theme(plot.margin = unit(c(0,0,0,0.9), "cm"),
+					text = element_text(face = "plain", size = 11))
+	
+	### built plot
+	#put all together
+	p2legends <- ggdraw(plot_grid(l021, l022, ncol = 1, rel_heights = c(1,0.5), align = "v"))
+	p2legends
+	
+	
+	pall <- ggdraw(plot_grid(plot_grid(p01, p02, nrow = 2, align = "v", labels = c("a)", "b)"), label_size = 10, label_fontface = "plain", label_x = 0.15), pe, plot_grid(plot_grid(legende,  pe, rel_widths = c(1,2), nrow = 1), p2legends, nrow = 2), nrow = 1, rel_widths = c(1,0.1,0.3)))
+	
+	ggsave(paste0(main.path, "output_files/plots/outflow.png"), pall, height = 10, width = 17.8, units = "cm", dpi = 500, bg = "transparent")
+	ggsave(paste0(main.path, "output_files/plots/outflow.pdf"), pall, height = 10, width = 17.8, units = "cm", dpi = 500, bg = "transparent")
+	pall
+	
+	
+	#outflows Aaare catchment##################
+	
+	#from top to bottom unit confluence with Rhine
+	outflow_1_Aare <- 178358
+	
+	
+	
+	trib <- data.frame(flow_to <- s_r$flow_to,
+										 id_all <- s_r$id_all)
+	trib$partof <- 0 #part of the tributaries
+	trib$partof[outflow_1_Aare] <- 1 #all sections of the main river are selected
+	for (i in 1:700) {
+		ids <- trib$id_all[trib$partof == 1] #get geo IDs with one
+		trib$partof[trib$flow_to %in% ids] <- 1 #write 1 when the flow to refers to a an id with 1
+	}
+	
+	ids_trib <- trib$id_all[trib$partof==1]
+	
+	water_aare <- melt(df_water_perM[outflow_1_Aare, polymers])
+	water_aare$value <- water_aare$value*60*60*24*365/1000 #in kg / year
+	water_aare$river <- "Aare"
+	
+	
+	ids_trib_river <- ids_trib[which(ids_trib%in%s_r$id_all[s_r$isLake == F])]
+	ids_trib_lakes <- ids_trib[which(ids_trib%in%s_r$id_all[s_r$isLake == T])]
+	
+	
+	ezg_aare <- data.frame(ausfluss = df_water_perM[outflow_1_Aare, "sum"],
+													acc_river = sum(df_accumulation_tot$sum[ids_trib_river], na.rm = T),
+													acc_lake = sum(df_accumulation_tot$sum[ids_trib_lakes], na.rm = T),
+													clean_river = sum(df_clean_tot$sum[ids_trib_river], na.rm = T),
+													clean_lake = sum(df_clean_tot$sum[ids_trib_lakes], na.rm = T),
+													rem = sum(df_removal_tot$sum[ids_trib], na.rm = T))
+	temp_storage_aare = sum(df_sediment_tot$sum[ids_trib], na.rm = T) #is per second
+	ezg_aare_melt <- melt(ezg_aare)
+	ezg_aare_melt$value <- ezg_aare_melt$value*60*60*24*365/1000 #in kg per year
+	
+	#control shows me: the null retention is the same value assuming up different values. all perfect!
+	tot_input_aare <- df_null[outflow_1_Aare, "sum"]
+	tot_input_aare
+	
+	ezg_aare_melt$value_percent <- ezg_aare_melt$value/ (tot_input_aare*60*60*24*365/1000)*100
+	##
+	
+	ezg_aare_melt$color <- c("a", "b", "b", "c", "c", "d") #add factors for colors
+	ezg_aare_melt$pattern <- c("x", "x", "y", "x", "y", "x")
+	
+	
+	#aare only along the main river
+	
+	trib <- data.frame(flow_to <- s_r$flow_to,
+										 id_all <- s_r$id_all)
+	d <- trib 
+	names(d) <- c("flow_to", "id_all")
+	d$x <- 0
+	d$x[outflow_1_Aare_top] <- 1
+	ft <- d$flow_to[which(d$x == 1)]
+	ft_long <- outflow_1_Aare_top
+	for (i in 1:800) {
+		d$x[ft] <- 1
+		ft_long <- c(ft_long, ft)
+		ft <- d$flow_to[ft]
+	}
+	sum(d$x)
+	
+	ids_trib <- ft_long[1:sum(d$x)]
+	
+	
+	water_aare <- melt(df_water_perM[outflow_1_Aare, polymers])
+	water_aare$value <- water_aare$value*60*60*24*365/1000 #in kg / year
+	water_aare$river <- "Aare"
+	
+	
+	ids_trib_river <- ids_trib[which(ids_trib%in%s_r$id_all[s_r$isLake == F])]
+	ids_trib_lakes <- ids_trib[which(ids_trib%in%s_r$id_all[s_r$isLake == T])]
+	
+	
+	ezg_aare <- data.frame(ausfluss = df_water_perM[outflow_1_Aare, "sum"],
+												 acc_river = sum(df_accumulation_tot$sum[ids_trib_river], na.rm = T),
+												 acc_lake = sum(df_accumulation_tot$sum[ids_trib_lakes], na.rm = T),
+												 clean_river = sum(df_clean_tot$sum[ids_trib_river], na.rm = T),
+												 clean_lake = sum(df_clean_tot$sum[ids_trib_lakes], na.rm = T),
+												 rem = sum(df_removal_tot$sum[ids_trib], na.rm = T))
+	temp_storage_aare = sum(df_sediment_tot$sum[ids_trib], na.rm = T) #is per second
+	ezg_aare_melt <- melt(ezg_aare)
+	ezg_aare_melt$value <- ezg_aare_melt$value*60*60*24*365/1000 #in kg per year
+	
+	#control shows me: the null retention is the same value assuming up different values. all perfect!
+	tot_input_aare <- df_null[outflow_1_Aare, "sum"]
+	tot_input_aare
+	
+	ezg_aare_melt$value_percent <- ezg_aare_melt$value/ (tot_input_aare*60*60*24*365/1000)*100
+	##
+	
+	ezg_aare_melt$color <- c("a", "b", "b", "c", "c", "d") #add factors for colors
+	ezg_aare_melt$pattern <- c("x", "x", "y", "x", "y", "x")
+	
+	ezg_aare_melt #only along the main river!! value_percent is for final value. does not work
+	
+	# rm(list = ls())
diff --git a/github_calculation/04_plots_verlauf_scenarios.R b/github_calculation/04_plots_verlauf_scenarios.R
new file mode 100644
index 0000000..88b73a5
--- /dev/null
+++ b/github_calculation/04_plots_verlauf_scenarios.R
@@ -0,0 +1,548 @@
+	#plot along ther rivers.
+	
+	# first all rivers that belong to the system
+	
+	library(ggplot2)
+	library(dplyr)
+	library(tidyverse)
+	library(ggrepel)
+	library(patchwork) #for making all images the same dimensions.
+	library(cowplot)
+	library(sf)
+	library(reshape2)
+	library(ggforce)
+	
+	#load dataset
+	main.path <- "PhD/mennekes2.0/"
+	load(paste0(main.path, "temp_data/forPlot.Rdata"))
+	
+	load(paste0(main.path, "temp_data/flow_files/print_round.Rdata"))
+	# extra_names <- c("_weir05", "_weir95")
+	rounds <- "801"
+	polymers <- c("EPS", "PP", "LDPE", "HDPE", "PS", "PVC", "PET")
+	
+	rhein <- 65062
+	doubs <- 329205
+	aare <- 79433
+	rhone <- 325768
+	
+	
+	
+	###rhein (Aare)
+	d <- rivers.all %>% dplyr::select(id_all, flow_to) %>% st_drop_geometry()
+	
+	d$x <- 0
+	d$x[aare] <- 1
+	ft <- d$flow_to[which(d$x == 1)]
+	ft_long <- aare
+	for (i in 1:800) {
+		d$x[ft] <- 1
+		ft_long <- c(ft_long, ft)
+		ft <- d$flow_to[ft]
+	}
+	sum(d$x)
+	
+	ft_rhine <- ft_long[1:sum(d$x)]
+	
+	len <- as.numeric(st_length(rivers.all[ft_rhine, ]))
+	len_cum <- cumsum(len)
+	
+	
+	
+	df01 <- as_tibble(matrix(nrow = 1, ncol = length(polymers)+2))
+	names(df01) <- c(polymers, "scenario", "x")
+	
+	#for loading data
+	df_temp <- as_tibble(matrix(nrow = length(ft_rhine), ncol = length(polymers)+2))
+	names(df_temp) <- c(polymers, "scenario", "x")
+	
+	#load data
+	for (scenario in extra_names) {
+		df_temp$scenario <- scenario
+		df_temp$x <- len_cum
+		for (mat in polymers) {
+			load(paste0(main.path, "output_files/rdata/cont_", mat,"_801", scenario, ".Rdata"))
+			df_temp[ , mat] <- s_r[ft_rhine, paste0("water_perM_", mat, "_MaP")]
+		}
+		df01 <- rbind(df01, df_temp)
+	}
+
+
+	df01 <- df01[2:nrow(df01), ]
+	
+	#add catogories
+	x.cat <- c("weir", "lake", "river", "sedimentation")
+	
+	df01$plot.cat <- NA
+	df01$plot.cat[df01$scenario %in% c("_weir05", "_weir25", "_weir50", "_weir75", "_weir95")] <- x.cat[1]
+	df01$plot.cat[df01$scenario %in% c("_baseLakesLinear", "_baseLakes05", "_baseLakes50", "_baseLakes95")] <- x.cat[2]
+	df01$plot.cat[df01$scenario %in% c("_baseRivers", "_baseRiversnoResus")] <- x.cat[3]
+	df01$plot.cat[df01$scenario %in% c("_LUlow", "_LUmid", "_LUhigh", "_Qlow", "_Qmid", "_Qhigh","_Slow" ,"_Smid", "_Shigh")] <- x.cat[4]
+	df01$plot.cat[df01$scenario %in% c("_base")] <- "base"
+	df01$plot.cat[df01$scenario %in% c("_null")] <- "null"
+	
+
+	#row sums
+	df01$sum <- rowSums(df01[ , polymers])
+	
+	# add isLake to file
+	df01$isLake <- rep(s_r$isLake[ft_rhine], length(extra_names))
+	
+	
+	# add information for lakes <- start end of a lake for plotting
+	lakes <- s_r$isLake[ft_rhine]
+	start_end <- data.frame(start = rep(NA, length(lakes)),
+													end = NA)
+	counter <- 1
+	y <- F
+	#if first segment is lake dann muss änderung auch auf T gesetzt werden
+	if(lakes[1]){
+		y <- T
+	}
+	
+	for (i in 1:I(length(lakes)-1)) {
+		x <- lakes[i]# check lake für  Runde
+		if(x == T & y == T){ #x ist für lake, y überprüft, ob es eine änderung gab
+			start_end$start[counter] <- len_cum[i]-100 #minus 100m
+		}
+		if(x == F & y == T){ #x = F bedeuted es ist kein lake, d. h. es ist fluss. Wenn dann noch von see auf fluss geändert hat, dann ist der See vorbei
+			start_end$end[counter] <- len_cum[i] - 100
+			counter <- counter +1
+		}
+		y = lakes[i] != lakes[i+1]
+	}
+	
+	start_end <- start_end[!(is.na(start_end$end)), ]
+	
+	df02 <- df01 %>% filter(isLake == F)
+	#delete rows that are lakes.
+	
+	
+	#calculate change towards previous
+	df02$diff <- NA #create row for saving changes
+	df02$i <- c(NA, df02$sum[1:I(nrow(df02)-1)])
+	df02$i_1 <- c(NA, df02$sum[2:nrow(df02)])
+	df02$diff <- df02$i_1 / df02$i
+	df02$diff[which(df02$x == min(df02$x, na.rm = T))] <- 1 # first timestep of river aare will be no changes -> avoid overhanging due to dataframe structure. search for min distance to find first segment- set changes to 1 which equals no change
+	
+	#change from 0 to any positive values causes inf values (x/0) -> replace with 1
+	df02[which(is.infinite(df02$diff)), "diff"] <- 1
+	df02$diff
+	
+	# replace diff = 1 for values of 0
+	df02[is.nan(df02$diff) & df02$i == 0 & df02$i_1 == 0, "diff"] <- 1
+	
+	df02[is.na(df02$diff) & df02$isLake == F, ]#after lakes the first section.. keep NA value
+	
+	df02$diff_max3 <- df02$diff
+	df02$diff_max3[df02$diff_max3 >3] <- 3
+	df02$sum[df02$isLake == T] <- NA
+	
+	#for plotting
+	
+	
+	#colors
+	blue <- "dodgerblue"
+	red <- "red3"
+	black <- "black"
+	yellow <- "orange"
+	
+
+	
+	nice <- theme_bw()+
+		theme(legend.position = "none",
+					legend.background = element_rect(fill = "transparent", color = NA),
+					plot.background = element_rect(fill = "transparent",colour = NA),
+					text = element_text(color = "black", size = 9),
+					axis.text.x = element_text(color = "black", face = "plain", size = 9),
+					axis.text.y = element_text(color = "black", face = "plain", size = 9),
+					panel.background = element_rect(fill = "transparent"),
+					plot.subtitle = element_text(size = 9),
+					panel.grid = element_blank()) #trbl
+	
+	
+	p1 <- ggplot(df02 %>% filter(!(scenario %in% c("_null", "_base"))), aes(x = x/1000, y = diff_max3, color = scenario))+
+		geom_hline(yintercept = 1, color = "grey80")+
+		geom_point(alpha = 0.3, pch = 16)+
+		geom_point(data = df02 %>% filter(scenario == "_base"), aes(x = x/1000, y = diff_max3, color = scenario))+
+		scale_color_manual("", values = c("_baseLakes05" = blue, "_baseLakes50" = blue, "_baseLakes95" = blue, "_baseLakesLinear" = blue, "_baseRivers" = blue, "_baseRiversnoResus" = blue, 
+																			"_LUhigh" = red, "_LUlow" = red, "_LUmid" = red, "_Qhigh" = red, "_Qmid" = red, "_Qlow" = red, "_Shigh" = red, "_Smid" = red, "_Slow" = red, 
+																			"_weir05" = black, "_weir25" = black, "_weir50" = black, "_weir75" = black, "_weir95" = black, "_base" = yellow))+
+		nice+
+		labs(x = "river lengths in [km]",
+				 y = "change between\ntwo segments [-]")+
+		scale_x_continuous(expand = c(0,1))+
+		scale_y_continuous(expand = c(0,0,0.01,0))+
+		theme(axis.title.x = element_blank())+
+		geom_vline(xintercept = 200)+
+		geom_vline(xintercept = 250)
+		# facet_zoom(xlim = c(200,250))
+
+	
+	p1	
+
+	ggsave("PhD/mennekes2.0/output_files/plots/aenderung_aare.png", plot = p1,  width = 12, height = 8, units = "cm")
+	
+	df03 <- cbind(df02, zoom = FALSE)#won´t be zoomed
+	df04 <- cbind(df02, zoom = TRUE) #will be zoomed
+	
+	
+	#version with zoom
+	p1zoom <- ggplot(df03 %>% filter(!(scenario %in% c("_null", "_base"))), aes(x = x/1000, y = diff_max3, color = scenario))+
+		geom_hline(yintercept = 1, color = "grey80")+
+		geom_point(alpha = 0.3, pch = 16, size = 0.8)+
+		geom_point(data = df03 %>% filter(scenario == "_base"), aes(x = x/1000, y = diff_max3, color = scenario), size = 1)+
+		geom_line(data = df04 %>% filter((scenario %in% c( "_weir05", "_weir95", "_baseLakes05", "_baseLakes95", "_Qlow", "_Qhigh"))), aes(x = x/1000, y = diff_max3, color = scenario))+
+		geom_line(data = df04 %>% filter(scenario== "_base"), aes(x = x/1000, y = diff_max3, color = scenario), linewidth = 0.9)+
+		geom_point(data = df04 %>% filter((scenario %in% c( "_weir05", "_weir95", "_baseLakes05", "_baseLakes95", "_Qlow", "_Qhigh", "_base"))), aes(x = x/1000, y = diff_max3, color = scenario), alpha = 0.5, pch = 16, size = 1.3)+
+		scale_color_manual("", values = c("_baseLakes05" = blue, "_baseLakes50" = blue, "_baseLakes95" = blue, "_baseLakesLinear" = blue, "_baseRivers" = blue, "_baseRiversnoResus" = blue, 
+																			"_LUhigh" = red, "_LUlow" = red, "_LUmid" = red, "_Qhigh" = red, "_Qmid" = red, "_Qlow" = red, "_Shigh" = red, "_Smid" = red, "_Slow" = red, 
+																			"_weir05" = black, "_weir25" = black, "_weir50" = black, "_weir75" = black, "_weir95" = black, "_base" = yellow))+
+		nice+
+		labs(x = "river lengths in [km]",
+				 y = "change between\ntwo segments [-]")+
+		scale_x_continuous(expand = c(0,1))+
+		scale_y_continuous(expand = c(0.01,0,0.01,0), breaks = c(0,1,2,3), labels = c("0", "1", "2", ">3"))+
+		theme(axis.title.x = element_blank())+
+		facet_zoom(xlim = c(200,250), zoom.data = zoom, zoom.size = 0.7)
+	
+	
+	p1zoom	
+	
+	ggsave("PhD/mennekes2.0/output_files/plots/aenderung_aare_zoom.png", plot = p1zoom,  width = 12, height = 8, units = "cm")
+	
+	
+	
+	#mit verschiedenen Scenarien
+	#colors
+	blue <- c('#deebf7','#9ecae1','#3182bd')
+	red <- c('#fee0d2','#fc9272','#de2d26')
+	black <- c('#f7f7f7','#cccccc','#969696','#636363','#252525')
+	
+	
+	
+	nice <- theme_bw()+
+		theme(legend.position = "none",
+					legend.background = element_rect(fill = "transparent", color = NA),
+					plot.background = element_rect(fill = "transparent",colour = NA),
+					text = element_text(color = "black", size = 9),
+					axis.text.x = element_text(color = "black", face = "plain", size = 9),
+					axis.text.y = element_text(color = "black", face = "plain", size = 9),
+					panel.background = element_rect(fill = "transparent"),
+					plot.subtitle = element_text(size = 9),
+					panel.grid = element_blank()) #trbl
+	
+	
+	p2 <- ggplot(df02 %>% filter(!(scenario %in% c("_base", "_null"))) %>% filter(plot.cat == "lake"), aes(x = x/1000, y = diff_max3, color = scenario))+
+		geom_hline(yintercept = 1, color = "grey80")+
+		geom_point(alpha = 0.8, pch = 16)+
+		scale_color_manual("", values = c("_baseLakes05" = blue[1], "_baseLakes50" = blue[2], "_baseLakes95" = blue[3], "_baseLakesLinear" = blue[2], "_baseRivers" = blue[2], "_baseRiversnoResus" = blue[2], 
+																			"_LUhigh" = red[3], "_LUlow" = red[1], "_LUmid" = red[2], "_Qhigh" = red[3], "_Qmid" = red[2], "_Qlow" = red[1], "_Shigh" = red[3], "_Smid" = red[2], "_Slow" = red[1], 
+																			"_weir05" = black[1], "_weir25" = black[2], "_weir50" = black[3], "_weir75" = black[4], "_weir95" = black[5]))+
+		nice+
+		labs(x = "river lengths in [km]",
+				 y = "change between\ntwo segments [-]")+
+		scale_x_continuous(expand = c(0,1))+
+		scale_y_continuous(expand = c(0,0,0.01,0), limits = c(0,3), breaks = c(0,1,2,3), labels = c("0", "1", "2", ">3"))
+	
+	
+	p2	
+	ggsave("PhD/mennekes2.0/output_files/plots/aenderung_aare2.png", plot = p2, width = 12, height = 8, units = "cm")
+	
+	
+	
+	
+	#as line between 200 and 300 km for selected scenarios
+	blue <- "dodgerblue"
+	red <- "red3"
+	black <- "black"
+	yellow <- "orange"
+	
+	
+	
+	nice <- theme_bw()+
+		theme(legend.position = "none",
+					legend.background = element_rect(fill = "transparent", color = NA),
+					plot.background = element_rect(fill = "transparent",colour = NA),
+					text = element_text(color = "black", size = 10),
+					axis.text.x = element_text(color = "black", face = "plain", size = 10),
+					axis.text.y = element_text(color = "black", face = "plain", size = 10),
+					panel.background = element_rect(fill = "transparent"),
+					plot.subtitle = element_text(size = 10),
+					panel.grid = element_blank()) #trbl
+	
+	
+	p3 <- ggplot(df02 %>% filter((scenario %in% c( "_weir05", "_weir95", "_baseLakes05", "_baseLakes95", "_Qlow", "_Qhigh"))), aes(x = x/1000, y = diff_max3, color = scenario))+
+		geom_hline(yintercept = 1, color = "grey80")+
+		geom_line(alpha = 0.8)+
+		geom_line(data = df02 %>% filter(scenario== "_base"), aes(x = x/1000, y = diff_max3, color = scenario), linewidth = 1)+
+		scale_color_manual("", values = c("_baseLakes05" = blue,  "_baseLakes95" = blue,
+																			 "_Qhigh" = red,  "_Qlow" = red,
+																			"_weir05" = black,  "_weir95" = black,
+																			"_base" = yellow))+
+		nice+
+		labs(x = "river lengths in [km]",
+				 y = "change between\ntwo segments [-]")+
+		scale_x_continuous(expand = c(0,0), limits = c(200, 250))+
+		scale_y_continuous(expand = c(0,0,0.01,0), limits = c(0,3), breaks = c(0,1,2,3), labels = c("0", "1", "2", ">3"))
+	
+	
+	p3	
+	ggsave("PhD/mennekes2.0/output_files/plots/aenderung_aare_km200_250.png", plot = p3, width = 12, height = 8, units = "cm")
+	
+	#legend for colors
+	blue <- "dodgerblue"
+	red <- "red3"
+	black <- "black"
+	yellow <- "orange"
+	
+	pL1 <- ggplot(df02 %>% filter((scenario %in% c("_baseLakes05", "_LUhigh", "_weir05", "_base"))), aes(x = x/1000, y = diff_max3, color = scenario))+
+		geom_hline(yintercept = 1, color = "grey80")+
+		geom_point( pch = 16)+
+		scale_color_manual("", values = c("_baseLakes05" = blue, "_LUhigh" = red, 
+																			"_weir05" = black, "_base" = yellow), labels = c('"best guess" scenario', "lake scenarios", "LU, Q, S scenarios", "weirs scenarios"))+
+		nice+
+		theme(legend.key = element_blank(),
+					legend.key.width = unit(0.35, "cm"))+
+		labs(x = "river lengths in [km]",
+				 y = "change between two segments [-]")+
+		scale_x_continuous(expand = c(0,1))+
+		scale_y_continuous(expand = c(0,0,0.01,0), breaks = c(0,1,2,3), labels = c("0", "1", "2", ">3"))+
+		theme(legend.position = "right")
+	
+	
+	pL1	
+	
+	le <- get_legend(pL1)
+	
+	pL1 <- ggplot(df02 %>% filter((scenario %in% c("_baseLakes05", "_LUhigh", "_weir05", "_base"))), aes(x = x/1000, y = diff_max3, color = scenario))+
+		geom_hline(yintercept = 1, color = "grey80")+
+		geom_line()+
+		scale_color_manual("", values = c("_baseLakes05" = blue, "_LUhigh" = red, 
+																			"_weir05" = black, "_base" = yellow), labels = c('"best guess" scenario', "lake scenarios", "LU, Q, S scenarios", "weirs scenarios"))+
+		nice+
+		theme(legend.key = element_blank(),
+					legend.key.width = unit(0.35, "cm"))+
+		labs(x = "river lengths in [km]",
+				 y = "change between two segments [-]")+
+		scale_x_continuous(expand = c(0,1))+
+		scale_y_continuous(expand = c(0,0,0.01,0), breaks = c(0,1,2,3), labels = c("0", "1", "2", ">3"))+
+		theme(legend.position = "right")
+	
+	
+	pL1	
+	
+	le3 <- get_legend(pL1)
+	
+	#legend for grey
+	pL2 <- ggplot(df02 %>% filter((scenario %in% c("_baseLakes05"))), aes(x = x/1000, y = diff_max3, fill = scenario))+
+		geom_area()+
+		scale_fill_manual("", values = c("_baseLakes05" = "grey90", "_LUhigh" = red, 
+																			"_weir05" = black, "_base" = yellow), labels = c("macroplastic emission\nin rivers (accumulated)*", "lake scenarios", "LU, Q, S scenarios", "weirs scenarios"))+
+		nice+
+		theme(legend.key = element_blank(),
+					legend.key.width = unit(0.4, "cm"))+
+		labs(x = "river lengths in [km]",
+				 y = "change between two segments [-]")+
+		scale_x_continuous(expand = c(0,1))+
+		scale_y_continuous(expand = c(0,0,0.01,0))+
+		theme(legend.position = "right")
+	
+	
+	pL2	
+	
+	le2 <- get_legend(pL2)
+	
+	
+	
+	
+	# Verlauf dargestellt als total mass in each segment
+	#colors
+	blue <- "dodgerblue"
+	red <- "red3"
+	black <- "black"
+	yellow <- "orange"
+	
+	
+	p4 <- ggplot(df02 %>% filter(!(scenario%in% c("_null", "_base"))), aes(x = x/1000, y = sum, color = scenario))+
+		geom_area(data = df02 %>% filter(scenario == "_null"), aes(x = x/1000 , y = sum), color = "grey90", fill = "grey90")+
+		geom_line(alpha = 0.7)+
+		geom_line(data = df02 %>% filter(plot.cat == "sedimentation"), aes(x = x/1000, y = sum, color = scenario), linewidth = 0.55)+
+		geom_line(data = df02 %>% filter(scenario == "_base"), aes(x = x/1000, y = sum, color = scenario), linewidth = 0.7)+
+		scale_color_manual("", values = c("_baseLakes05" = blue, "_baseLakes50" = blue, "_baseLakes95" = blue, "_baseLakesLinear" = blue, "_baseRivers" = blue, "_baseRiversnoResus" = blue, 
+																			"_LUhigh" = red, "_LUlow" = red, "_LUmid" = red, "_Qhigh" = red, "_Qmid" = red, "_Qlow" = red, "_Shigh" = red, "_Smid" = red, "_Slow" = red, 
+																			"_weir05" = black, "_weir25" = black, "_weir50" = black, "_weir75" = black, "_weir95" = black, "_base" = yellow))+
+		nice+
+		labs(x = "river lengths in [km]",
+				 y = "macroplastic mass\n in suspension in [g / s]")+
+		scale_x_continuous(expand = c(0,1))+
+		scale_y_continuous(expand = c(0.01,0,0.01,0), breaks = c(0,1,2))+
+		theme(axis.title.x = element_blank())
+	
+	
+	p4
+	
+	abcde <- df02 %>% filter(plot.cat == "sedimentation") %>% filter(sum!=0) %>% group_by(scenario) %>%   summarise(mean(sum),sd(sum), max(sum))
+	abcde
+	mean(abcde$`max(sum)`)
+	min(abcde$`max(sum)`)
+	df02 %>% filter(plot.cat == "base") %>% filter(sum!=0) %>%  summarise(mean(sum),sd(sum), max(sum))
+	unique(df02$plot.cat)
+	#find dams in Aare river
+	load("PhD/mennekes2.0/temp_data/rivers_all6_base.Rdata")
+	#rivers.all6
+	fac_pet <- grepl(".fac_PET_", names(rivers.all6))
+	
+	#find fac. data for interesting section
+	
+	
+	#find other weirs in aare river
+	w_aare <- which(rivers.all6$removal.fac_PET_MaP[ft_rhine] != 0) #all weirs in aare
+	length(w_aare) # number of dams in Aare: 17
+
+	#colors of polymers for best guess plot
+	df20 <- df02 %>% filter(scenario == "_base") %>% select(c(polymers,  "x"))
+	df21 <- melt(df20, id.vars = c("x"), measure.vars = polymers)
+	farben <- rev(c("#cc5700", "#c97544", "#bf9077", "#aaaaaa", "#92a1c7", "#6f98e3", "#1e90ff"))
+	
+	p6 <- ggplot(df21)+
+		geom_rect(data = start_end,
+							aes(xmin = start/1000, xmax = end/1000),
+							ymin = -Inf, ymax = Inf, alpha = 0.15, fill ="#555555")+
+		geom_vline(xintercept = len_cum[w_aare]/1000, linetype = "dashed", linewidth = 0.3)+
+		geom_area(aes(x = I(x/1000), y = value*1000, fill = variable))+
+		scale_y_continuous(expand = c(0,0))+
+		scale_x_continuous(expand = c(0,0))+
+		scale_fill_manual(values = farben)+
+		labs(x = "distance [km]",
+				 y = "macroplastic mass\nin suspension [mg/s]\n ")+
+		annotate("label",y = 37, x = 10, label = "Aare River", hjust = "left", vjust = "left",  size = 2.5, color = "black")+
+		annotate("label",y = 37, x = I(len_cum[577]/1000+5), label = "Rhine River", hjust = "left", vjust = "left",  size = 2.5, color = "black")+
+		nice
+	
+	p6
+	l <- data.frame(value = rev(c(1,1,1,1,1,1,1)),
+									river = "Legend\n",
+									polymer = c("EPS", "PP", "LDPE", "HDPE", "PS", "PVC", "PET"),
+									pos = c(0.5,1.5,2.5,3.5,4.5,5.5,6.5))
+	l$polymer <- factor(l$polymer,
+											levels = c("EPS", "PP", "LDPE", "HDPE", "PS", "PVC", "PET"))
+	
+	legende <- ggplot(data=l, aes(x=river, y=value, fill=polymer)) +
+		geom_bar(stat="identity")+
+		scale_y_continuous(expand = c(0,0.1,0, 0))+
+		scale_x_discrete( expand = c(0.4,0.1))+
+		geom_text(aes(y = pos, label = rev(polymer)), color = c( "black"),size = 2)+
+		labs(y = "MiP\nin [kg / year]")+
+		scale_fill_manual("",
+											values = farben)+
+		theme_void()+
+		theme(plot.margin=unit(c(1,0,1,0),"cm"),
+					legend.position = "none",
+					axis.text.x = element_blank(),
+					panel.border = element_blank(),
+					panel.ontop = F,
+					plot.subtitle = element_text(size = 8))
+	
+	legende
+	
+							
+	# input emission based on data by Kawecki and Nowack 2020
+	#load input emissions
+	df_temp <- as_tibble(matrix(nrow = length(ft_rhine), ncol = length(polymers)+1))
+	names(df_temp) <- c(polymers, "x")
+	df_temp$x <- len_cum
+		for (mat in polymers) {
+			load(paste0(main.path, "output_files/rdata/cont_", mat,"_801_null.Rdata"))
+			df_temp[ , mat] <- s_r[ft_rhine, paste0("inputKawecki_perS_", mat, "_MaP")]
+		}
+
+	df10 <- df_temp	
+	df10$sum <- rowSums(df10[ , polymers])
+	df10b <- data.frame(x = df10$x[2: nrow(df10)]-1,
+											sum = df10$sum[1: I(nrow(df10) - 1)])
+	df11 <- rbind(df10[ , c("x", "sum")],df10b)
+	
+	
+	
+	p5 <- ggplot(df11, aes(x = x/1000, y = sum))+
+		geom_area(fill= "grey")+
+		nice+
+		labs(x = "river lengths in [km]",
+				 y = "emission into\nwater in [g / s]")+
+		scale_x_continuous(expand = c(0,1))+
+		scale_y_continuous(expand = c(0.0,0,0.0,0), limits = c(0, 0.016), breaks = c(0, 0.008, 0.016))
+	
+	p5
+	
+	df
+	head(s_r)
+
+
+
+#empty plot
+	nice2 <- theme(legend.position = "none",
+								legend.background = element_rect(fill = "transparent", color = NA),
+								plot.background = element_rect(fill = "transparent",colour = NA),
+								text = element_text(color = "black", size = 12),
+								legend.text = element_text(size = 8),
+								plot.margin=unit(c(0.0, -0.7,0.1,-0.6),"cm"))
+	t0 <- ggplot() +                     
+		annotate("text",
+						 x = 1,
+						 y = 1,
+						 size = 1,
+						 label = "     ") + 
+		theme_void()+
+		nice2
+
+
+#plots zusammenbauen
+
+pall1 <- ggdraw(plot_grid(p3,t0, p1, p4, p5, align = "v", ncol = 1, rel_heights = c(0.8,0.2, 1,1,1), labels = c("a)", " ", "b)", "c)", "d)"), label_size = 10, label_x = 0.01))
+
+pall2 <- ggdraw(plot_grid(pall1, plot_grid( t0, le, le2,t0, nrow = 4), nrow = 1, rel_widths = c(1,0.2)))
+pall2
+
+#save figures
+ggsave(paste0(main.path, "output_files/plots/Aare_lengths01.png"), pall2, height = 17, width = 18, units = "cm", dpi = 500, bg = "transparent")
+
+ggsave(paste0(main.path, "output_files/plots/Aare_lengths01.pdf"), pall2, height = 17, width = 18, units = "cm", dpi = 500, bg = "transparent")
+
+
+#build everything with zoom figure
+pall1 <- ggdraw(plot_grid(p1zoom,t0, p4, p5, align = "v", ncol = 1, rel_heights = c(2,0.1,1,1), labels = c("a)","", "b)", "c)"), label_size = 10, label_fontface = "plain", label_x = 0.01))
+
+pall2 <- ggdraw(plot_grid(pall1, plot_grid( t0, le, le2,t0, nrow = 4), nrow = 1, rel_widths = c(1,0.25)))
+# pall2
+
+
+
+#version 2
+pall1.2 <- ggdraw(plot_grid(p4, t0, p1zoom, align = "v", ncol = 1, rel_heights = c(1,0.1,1.4), labels = c("a)","", "b)"), label_size = 10, label_fontface = "plain", label_x = 0.0))
+pall2.1 <- ggdraw(plot_grid(pall1.2, plot_grid( t0, le2, t0, le, t0, nrow = 5, rel_heights = c(0.2,1,0.01,1,2)), nrow = 1, rel_widths = c(1,0.25)))
+
+
+#save figures
+ggsave(paste0(main.path, "output_files/plots/Aare_lengths01_zoom.png"), pall2, height = 17, width = 17.8, units = "cm", dpi = 500, bg = "transparent")
+ggsave(paste0(main.path, "output_files/plots/Aare_lengths02_zoom.png"), pall2.1, height = 12, width = 17.8, units = "cm", dpi = 500, bg = "transparent")
+
+ggsave(paste0(main.path, "output_files/plots/Aare_lengths01_zoom.pdf"), pall2, height = 17, width = 17.8, units = "cm", dpi = 500, bg = "transparent")
+ggsave(paste0(main.path, "output_files/plots/Aare_lengths02_zoom.pdf"), pall2.1, height = 17, width = 17.8, units = "cm", dpi = 500, bg = "transparent")
+
+
+pall3 <- ggdraw(plot_grid(p6, t0, legende, rel_widths = c(1,0.08, 0.1), nrow = 1))
+ggsave(paste0(main.path, "output_files/plots/Aare_lengths_polymers.png"), pall3, height = 6, width = 17.8, units = "cm", dpi = 500, bg = "transparent")
+
+p5 <- p4+
+	nice
+
+pall4 <-ggdraw(plot_grid(p5, plot_grid(t0,le2,t0,le3, t0, rel_heights = c(0.1,0.3,0.01,1.2,0.1), ncol = 1), nrow = 1, rel_widths = c(1,0.27)))
+ggsave(paste0(main.path, "output_files/plots/Aare_lengths_scenarios.png"), pall4, height = 6, width = 17.8, units = "cm", dpi = 500, bg = "transparent")
+
+p1zoom <- p1zoom+nice
+pall5 <-ggdraw(plot_grid(p1zoom, plot_grid(t0,le, t0, rel_heights = c(0.1,1.2,1.3), ncol = 1), nrow = 1, rel_widths = c(1,0.27)))
+ggsave(paste0(main.path, "output_files/plots/SI_Aare_lengths_scenarios.png"), pall5, height = 10, width = 17.8, units = "cm", dpi = 500, bg = "transparent")
+
+rm(list = ls())
+#