####################################################################################### # # # sedFlowPlotGUI # # # # A graphical tool for producing plots of sedFlow simulation results # # # ####################################################################################### # # Version 1.00 # Copyright (C) 2014 Swiss Federal Research Institute WSL (http://www.wsl.ch) # Developed by F.U.M. Heimann # Published by the Swiss Federal Research Institute WSL # # This software is based on R, which is a system for statistical computation and graphics. # For details on R see http://www.r-project.org # # This software is further based on gWidgets and gWidgetsRGtk2 libraries. # # This program is free software: you can redistribute it and/or modify it # under the terms of the GNU General Public License version 3 # as published by the Free Software Foundation. # # This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; # without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. # See the GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program. If not, see http://www.gnu.org/licenses # # This software is a post-processing tool for the model sedFlow, # which is intended for the simulation of bedload dynamics in mountain streams. # # For details on sedFlow see http://www.wsl.ch/sedFlow # ####################################################################################### rm(list = ls(all = TRUE)) inGerman = F drawIndividualPlots = F printPanelLabels = F comparisonFileName = "" orderOfPlots = c("ABT","eroDepo","slope","firstGS","secondGS","channelWidth") path = "" branchesNOTbelongingToMainChannel = vector(mode="numeric") positionsOfVerticalLinesInKM = vector(mode="numeric") displayNoTributaries = F locations = vector(mode="numeric") positionsOfOtherVerticalLinesInKM = vector(mode="numeric") potentialLineTypes = c("blank", "solid", "dashed", "dotted", "dotdash", "longdash", "twodash") potentialImageFileExtensions = c("png","bmp","tif","jpg","eps","ps","pdf") imageFileExtension = "png" imageWidthInCM = 20 imageWidthToHeight = 1.5 resolution = 300 plotFontSize = 1 builtInPotentialLegendPositions = c("bottomright", "bottom", "bottomleft", "left", "topleft", "top", "topright", "right", "center", "bottomright", "bottom") potentialLegendPositions = c(builtInPotentialLegendPositions,"coordinates") legendPosition = "topleft" legendPositionCoordinates = c(0,0) referenceLTY = "solid" simulationLTY = "solid" tributaryLTY = "dashed" locationLTY = "dotted" otherVerticalLineLTY = "dashed" referenceCOL = "blue" simulationCOL = "red" tributaryCOL = "black" locationCOL = "black" otherVerticalLineCOL = "cyan" referenceLWD = 2.0 simulationLWD = 2.0 tributaryLWD = 1.0 locationLWD = 1.0 otherVerticalLineLWD = 1.0 sillCOL = "black" elevationFileName = "elevation.txt" ABTOverallVolumeFileName = "ABT-OverallVolume.txt" grainSizeFileName = "activeLayerPerUnitBedSurfaceD50.txt" secondGrainSizeFileName = "activeLayerPerUnitBedSurfaceD84.txt" alluviumThicknessFileName = "" activeWidthFileName = "" reachIDExplanationsFileName = "ReachIDExplanations.txt" firstGrainSizePercentile = 50 secondGrainSizePercentile = 84 germanReferenceLabel = "Referenz- oder Anfangswerte" englishReferenceLabel = "reference or initial values" germanSimulationLabel = "Simulation" englishSimulationLabel = "simulation" germanTributaryLabel = "Zubringer" englishTributaryLabel = "tributaries" germanSillLabel = "Schwellen" englishSillLabel = "sills" germanLocationLabel = "Ortsangaben" englishLocationLabel = "locations" germanAbscissaLabel = "Distanz zur Mündung [km]" englishAbscissaLabel = "Distance to outlet [km]" germanABTLabel = expression(paste("Geschiebefracht ",Sigma,"Q"[b]," [m"^"3","]",sep="")) englishABTLabel = expression(paste("Accumulated bedload transport ",Sigma,"Q"[b]," [m"^"3","]",sep="")) germanSlopeLabel = "Sohlengefälle [%]" englishSlopeLabel = "channel gradient [%]" germanFirstGrainSizeLabel = substitute(paste("D"[X]," [m]",sep=""),list(X=firstGrainSizePercentile)) englishFirstGrainSizeLabel = germanFirstGrainSizeLabel germanSecondGrainSizeLabel = substitute(paste("D"[X]," [m]",sep=""),list(X=secondGrainSizePercentile)) englishSecondGrainSizeLabel = germanSecondGrainSizeLabel germanBedElevationChangeLabel = "Erosion / Auflandung [m]" englishBedElevationChangeLabel = "erosion / deposition [m]" germanChannelWidthLabel = "Gerinnebreite [m]" englishChannelWidthLabel = "channel width [m]" ####################################################################################### if (is.element( "gWidgets" , installed.packages() ) == FALSE) {install.packages("gWidgets")} library(gWidgets) if (is.element( "gWidgetsRGtk2" , installed.packages() ) == FALSE) {install.packages("gWidgetsRGtk2")}; options(guiToolkit="RGtk2") ## window <- gwindow ( "Plot sedFlow", visible=FALSE ) overallGroup <- ggroup ( cont = window, horizontal = F, expand = T ) notebook <- gnotebook ( cont = overallGroup, expand = T ) basicSettings <- ggroup ( cont = notebook, horizontal = F, label = "Basic settings" , expand = T ) glabel("Simulation folder:", cont = basicSettings, anchor = c(-1,0)) simulationFolderBrowse = gfilebrowse(text = "Select a simulation folder ...", quote = FALSE, type = "selectdir", cont = basicSettings) addHandlerChanged(simulationFolderBrowse, handler = function(h,...) {.GlobalEnv$path = svalue(simulationFolderBrowse)} ) glabel("Language:", cont = basicSettings, anchor = c(-1,0)) if(inGerman) selectedLanguage = 2 else selectedLanguage = 1 language <- gcombobox ( c ( "English" , "German" ), selected=selectedLanguage , cont = basicSettings ) addHandlerChanged(language, handler = function(h,...) {.GlobalEnv$inGerman = (svalue(language)=="German")} ) glabel("Layout:", cont = basicSettings, anchor = c(-1,0)) if(drawIndividualPlots) {selectedLayout = 2} else {selectedLayout = 1} overallLayout <- gcombobox ( c ( "Alternating y axes" , "Individual plots" ) , cont = basicSettings , selected = selectedLayout ) printPanelLabelsCheck <- gcheckbox ( "Print panel labels" , cont = basicSettings) if(drawIndividualPlots) {enabled(printPanelLabelsCheck) = TRUE ; svalue(printPanelLabelsCheck) = printPanelLabels} else {enabled(printPanelLabelsCheck) = FALSE ; printPanelLabels = FALSE; svalue(printPanelLabelsCheck) = printPanelLabels} addHandlerChanged(overallLayout, handler = function(h,...) { .GlobalEnv$drawIndividualPlots = (svalue(overallLayout)=="Individual plots") if(.GlobalEnv$drawIndividualPlots) { enabled(printPanelLabelsCheck) = TRUE svalue(printPanelLabelsCheck) = .GlobalEnv$printPanelLabels } else{ enabled(printPanelLabelsCheck) = FALSE .GlobalEnv$printPanelLabels = FALSE svalue(printPanelLabelsCheck) = .GlobalEnv$printPanelLabels } } ) addHandlerChanged(printPanelLabelsCheck, handler = function(h,...) {.GlobalEnv$printPanelLabels = svalue(printPanelLabelsCheck)}) DnDframe = gframe("Properties to plot:",cont = basicSettings, expand = T) potentialValuesForOrderOfPlots = orderOfPlots orderOfPlots <- vector(mode="character") availableForOrderOfPlots <- potentialValuesForOrderOfPlots unusedGroup = ggroup ( cont = DnDframe, horizontal=F, expand = T ) glabel("Available:", cont=unusedGroup) sourceTable = gtable(availableForOrderOfPlots,cont=unusedGroup,expand=TRUE) usedGroup = ggroup ( cont = DnDframe, horizontal=F, expand = T ) glabel("Used:", cont=usedGroup) targetTable = gtable(orderOfPlots,cont=usedGroup,expand=TRUE) clearButton <- gbutton ( "Clear selection" , cont = usedGroup) addHandlerChanged(clearButton, handler = function(h,...) { .GlobalEnv$orderOfPlots = vector(mode="character") .GlobalEnv$availableForOrderOfPlots = potentialValuesForOrderOfPlots sourceTable[] <- .GlobalEnv$availableForOrderOfPlots targetTable[] <- .GlobalEnv$orderOfPlots } ) addDropSource ( sourceTable ) addDropSource ( targetTable ) addDropTarget ( sourceTable, handler = function ( h , ... ) { .GlobalEnv$availableForOrderOfPlots <- c(.GlobalEnv$availableForOrderOfPlots,h$dropdata) .GlobalEnv$orderOfPlots <- .GlobalEnv$orderOfPlots[-which(.GlobalEnv$orderOfPlots==h$dropdata,arr.ind=T)] sourceTable[] <- .GlobalEnv$availableForOrderOfPlots targetTable[] <- .GlobalEnv$orderOfPlots } ) addDropTarget ( targetTable, handler = function ( h , ... ) { .GlobalEnv$availableForOrderOfPlots <- .GlobalEnv$availableForOrderOfPlots[-which(.GlobalEnv$availableForOrderOfPlots==h$dropdata,arr.ind=T)] .GlobalEnv$orderOfPlots <- c(.GlobalEnv$orderOfPlots,h$dropdata) sourceTable[] <- .GlobalEnv$availableForOrderOfPlots targetTable[] <- .GlobalEnv$orderOfPlots } ) branchesNotBelongingToMainChannelFrame = gframe("Branches not belonging to main channel:",cont = basicSettings, expand = T) branchesNotBelongingToMainChannelEdit = gedit("", initial.msg = "Input branches separated by comas and hit enter...", cont = branchesNotBelongingToMainChannelFrame, expand=T) readInputGroup = ggroup(cont=branchesNotBelongingToMainChannelFrame,horizontal=FALSE,expand=TRUE) glabel("Branches read from input:", cont = readInputGroup, anchor = c(-1,0)) branchesNOTbelongingToMainChannelReadInput = gtable(branchesNOTbelongingToMainChannel,cont=readInputGroup,expand=TRUE) enabled(branchesNOTbelongingToMainChannelReadInput)=(length(branchesNOTbelongingToMainChannel)>0) addHandlerChanged(branchesNotBelongingToMainChannelEdit, handler = function(h,...) {.GlobalEnv$branchesNOTbelongingToMainChannel = eval(parse(text=paste("c(",svalue(branchesNotBelongingToMainChannelEdit),")",sep=""))); branchesNOTbelongingToMainChannelReadInput[] = .GlobalEnv$branchesNOTbelongingToMainChannel; enabled(branchesNOTbelongingToMainChannelReadInput)=(length(.GlobalEnv$branchesNOTbelongingToMainChannel)>0)}) glabel("File type:", cont = basicSettings, anchor = c(-1,0)) selectedFileType = which(potentialImageFileExtensions == imageFileExtension, arr.ind=T) fileTypeSelection <- gcombobox ( potentialImageFileExtensions, selected=selectedFileType , cont = basicSettings ) addHandlerChanged(fileTypeSelection, handler = function(h,...) {.GlobalEnv$imageFileExtension = svalue(fileTypeSelection)} ) imageSizeGroup = ggroup(cont = basicSettings,expand=F) imageWidthInCMGroup = ggroup(cont=imageSizeGroup,expand=T,horizontal=F) glabel("Image width in CM:", cont=imageWidthInCMGroup) imageWidthInCMEdit = gedit(imageWidthInCM, cont = imageWidthInCMGroup, expand=T) imageWidthInCMRead = glabel(paste("Value read from input:",imageWidthInCM), cont=imageWidthInCMGroup) addHandlerChanged(imageWidthInCMEdit, handler = function(h,...) {.GlobalEnv$imageWidthInCM = as.numeric(svalue(imageWidthInCMEdit)); svalue(imageWidthInCMRead) = paste("Value read from input:",.GlobalEnv$imageWidthInCM)}) imageWidthToHeightGroup = ggroup(cont=imageSizeGroup,expand=T,horizontal=F) glabel("Image width to height ratio:", cont=imageWidthToHeightGroup) imageWidthToHeightEdit = gedit(imageWidthToHeight, cont = imageWidthToHeightGroup, expand=T) imageWidthToHeightRead = glabel(paste("Value read from input:",imageWidthToHeight), cont=imageWidthToHeightGroup) addHandlerChanged(imageWidthToHeightEdit, handler = function(h,...) {.GlobalEnv$imageWidthToHeight = eval(parse(text=svalue(imageWidthToHeightEdit))); svalue(imageWidthToHeightRead) = paste("Value read from input:",.GlobalEnv$imageWidthToHeight)}) resolutionGroup = ggroup(cont=imageSizeGroup,expand=T,horizontal=F) glabel("Resolution:", cont=resolutionGroup) resolutionEdit = gedit(resolution, cont = resolutionGroup, expand=T) resolutionRead = glabel(paste("Value read from input:",resolution), cont=resolutionGroup) addHandlerChanged(resolutionEdit, handler = function(h,...) {.GlobalEnv$resolution = as.numeric(svalue(resolutionEdit)); svalue(resolutionRead) = paste("Value read from input:",.GlobalEnv$resolution)}) plotFontSizeGroup = ggroup(cont=imageSizeGroup,expand=T,horizontal=F) glabel("Plot font size:", cont=plotFontSizeGroup) plotFontSizeEdit = gedit(plotFontSize, cont = plotFontSizeGroup, expand=T) plotFontSizeRead = glabel(paste("Value read from input:",plotFontSize), cont=plotFontSizeGroup) addHandlerChanged(plotFontSizeEdit, handler = function(h,...) {.GlobalEnv$plotFontSize = as.numeric(svalue(plotFontSizeEdit)); svalue(plotFontSizeRead) = paste("Value read from input:",.GlobalEnv$plotFontSize)}) ####################################################################################### additionalSettings <- ggroup ( cont = notebook, horizontal = F, label = "Additional settings" , expand = T ) legendPositionFrame = gframe("Legend position:",cont = additionalSettings, expand = F, horizontal = F) selectedLegendPosition = which(potentialLegendPositions == legendPosition, arr.ind=T) legendPositionSelection <- gcombobox ( potentialLegendPositions, selected=selectedLegendPosition , cont = legendPositionFrame ) legendPositionCoordinatesEdit = gedit("", initial.msg = "Input coordinates separated by comas and hit enter...", cont = legendPositionFrame, expand=F) legendPositionLabel = glabel("", cont = legendPositionFrame, anchor = c(-1,0)) legendPositionHandlerFunction = function(){ if(svalue(legendPositionSelection)=="coordinates"){ .GlobalEnv$legendPosition = .GlobalEnv$legendPositionCoordinates enabled(legendPositionCoordinatesEdit) = TRUE } else { .GlobalEnv$legendPosition = svalue(legendPositionSelection) enabled(legendPositionCoordinatesEdit) = FALSE } tmpText = "Selected position:" if(length(.GlobalEnv$legendPosition)>0) { for(tmpID in 1:length(.GlobalEnv$legendPosition)) { tmpText = paste(tmpText,.GlobalEnv$legendPosition[tmpID]) } } svalue(legendPositionLabel) = tmpText rm(tmpText,tmpID) } legendPositionHandlerFunction() addHandlerChanged(legendPositionSelection, handler = function(h,...) {legendPositionHandlerFunction()} ) addHandlerChanged(legendPositionCoordinatesEdit, handler = function(h,...){.GlobalEnv$legendPositionCoordinates = eval(parse(text=paste("c(",svalue(legendPositionCoordinatesEdit),")",sep=""))); legendPositionHandlerFunction()}) comparisonFileNameLabel = glabel("Comparison file: ", cont=additionalSettings, anchor = c(-1,0)) comparisonFileNameEdit = gedit("", initial.msg = "Input file name and hit enter...", cont = additionalSettings,expand=F) addHandlerChanged(comparisonFileNameEdit, handler = function(h,...) {.GlobalEnv$comparisonFileName = svalue(comparisonFileNameEdit); svalue(comparisonFileNameLabel) = paste("Comparison file:",.GlobalEnv$comparisonFileName)}) positionsOfTributariesFrame = gframe("Positions of tributaries in km:",cont = additionalSettings, expand = T) positionsOfTributariesEditInputGroup = ggroup ( cont = positionsOfTributariesFrame, horizontal = F, expand=T) glabel("If no values are given in the following input,\n\tthe positions of the tributaries are derived from\n\tthe branches not belonging to main channel.", cont = positionsOfTributariesEditInputGroup, anchor = c(-1,0)) positionsOfTributariesEdit = gedit("", initial.msg = "Input positions of tributaries separated by comas and hit enter...", cont = positionsOfTributariesEditInputGroup, expand=F) displayNoTributariesCheck <- gcheckbox ( "Do NOT display tributaries", checked = displayNoTributaries , cont = positionsOfTributariesEditInputGroup) addHandlerChanged(displayNoTributariesCheck, handler = function(h,...){.GlobalEnv$displayNoTributaries = svalue(displayNoTributariesCheck)}) positionsOfTributariesReadInputGroup = ggroup ( cont = positionsOfTributariesFrame, horizontal = F, expand=T) positionsOfTributariesReadInputLabel = glabel("", cont = positionsOfTributariesReadInputGroup, anchor = c(-1,0)) positionsOfTributariesReadInput = gtable(positionsOfVerticalLinesInKM,cont=positionsOfTributariesReadInputGroup,expand=TRUE) positionsOfTributariesReadInputUpdate = function() { positionsOfTributariesReadInput[] = .GlobalEnv$positionsOfVerticalLinesInKM if(length(.GlobalEnv$positionsOfVerticalLinesInKM)>0) { enabled(positionsOfTributariesReadInput) = TRUE svalue(positionsOfTributariesReadInputLabel) = "Positions of tributaries based on\n\ttable below." } else { enabled(positionsOfTributariesReadInput) = FALSE svalue(positionsOfTributariesReadInputLabel) = "Positions of tributaries based on\n\tbranches not belonging to main channel." } } positionsOfTributariesReadInputUpdate() addHandlerChanged(positionsOfTributariesEdit, handler = function(h,...) {.GlobalEnv$positionsOfVerticalLinesInKM = eval(parse(text=paste("c(",svalue(positionsOfTributariesEdit),")",sep=""))); positionsOfTributariesReadInputUpdate()}) locationsFrame = gframe("Positions of locations in km:",cont = additionalSettings, expand = T) locationsEdit = gedit("", initial.msg = "Input locations positions separated by comas and hit enter...", cont = locationsFrame, expand=T) locationsReadInputGroup = ggroup(cont=locationsFrame,horizontal=FALSE,expand=TRUE) glabel("Positions read from input:", cont = locationsReadInputGroup, anchor = c(-1,0)) locationsReadInput = gtable(locations,cont=locationsReadInputGroup,expand=TRUE) enabled(locationsReadInput)=(length(locations)>0) addHandlerChanged(locationsEdit, handler = function(h,...) {.GlobalEnv$locations = eval(parse(text=paste("c(",svalue(locationsEdit),")",sep=""))); locationsReadInput[] = .GlobalEnv$locations; enabled(locationsReadInput)=(length(.GlobalEnv$locations)>0)}) positionsOfOtherVerticalLinesInKMFrame = gframe("Positions of other vertical lines in km:",cont = additionalSettings, expand = T) positionsOfOtherVerticalLinesInKMEdit = gedit("", initial.msg = "Input line positions separated by comas and hit enter...", cont = positionsOfOtherVerticalLinesInKMFrame, expand=T) positionsOfOtherVerticalLinesInKMReadInputGroup = ggroup(cont=positionsOfOtherVerticalLinesInKMFrame,horizontal=FALSE,expand=TRUE) glabel("Positions read from input:", cont = positionsOfOtherVerticalLinesInKMReadInputGroup, anchor = c(-1,0)) positionsOfOtherVerticalLinesInKMReadInput = gtable(positionsOfOtherVerticalLinesInKM,cont=positionsOfOtherVerticalLinesInKMReadInputGroup,expand=TRUE) enabled(positionsOfOtherVerticalLinesInKMReadInput)=(length(positionsOfOtherVerticalLinesInKM)>0) addHandlerChanged(positionsOfOtherVerticalLinesInKMEdit, handler = function(h,...) {.GlobalEnv$positionsOfOtherVerticalLinesInKM = eval(parse(text=paste("c(",svalue(positionsOfOtherVerticalLinesInKMEdit),")",sep=""))); positionsOfOtherVerticalLinesInKMReadInput[] = .GlobalEnv$positionsOfOtherVerticalLinesInKM; enabled(positionsOfOtherVerticalLinesInKMReadInput)=(length(.GlobalEnv$positionsOfOtherVerticalLinesInKM)>0)}) ####################################################################################### additionalFormatting <- ggroup ( cont = notebook, horizontal = F, label = "Additional formatting" , expand = T ) showPotentialColourNamesButton <- gbutton ( "Show potential colour names" , cont = additionalFormatting) addHandlerChanged(showPotentialColourNamesButton, handler = function(h,...) { showPotentialColourNamesWindow <- gwindow ( "Potential colour names", visible=FALSE ) gtable(colours(),cont=showPotentialColourNamesWindow,expand=TRUE) visible(showPotentialColourNamesWindow) = TRUE }) simulationLineFormattingFrame = gframe("Simulation:",cont = additionalFormatting, expand = F) simulationLTYGroup = ggroup( cont = simulationLineFormattingFrame, horizontal = F , expand = T) glabel("Line type:", cont = simulationLTYGroup, anchor = c(-1,0)) simulationLTYSelected = which(potentialLineTypes == simulationLTY, arr.ind=T) simulationLTYSelection <- gcombobox( potentialLineTypes, selected=simulationLTYSelected , cont = simulationLTYGroup ) addHandlerChanged(simulationLTYSelection, handler = function(h,...) {.GlobalEnv$simulationLTY = svalue(simulationLTYSelection)} ) simulationCOLGroup = ggroup( cont = simulationLineFormattingFrame, horizontal = F , expand = T) simulationCOLLabel = glabel(paste("Colour:",.GlobalEnv$simulationCOL), cont = simulationCOLGroup, anchor = c(-1,0)) simulationCOLSelection <- gedit(simulationCOL, cont = simulationCOLGroup, expand=T) addHandlerChanged(simulationCOLSelection, handler = function(h,...) {.GlobalEnv$simulationCOL = svalue(simulationCOLSelection); svalue(simulationCOLLabel)=paste("Colour:",.GlobalEnv$simulationCOL)} ) simulationLWDGroup = ggroup( cont = simulationLineFormattingFrame, horizontal = F , expand = T) simulationLWDLabel = glabel(paste("Line width:",.GlobalEnv$simulationLWD), cont = simulationLWDGroup, anchor = c(-1,0)) simulationLWDSelection <- gedit(simulationLWD, cont = simulationLWDGroup, expand=T) addHandlerChanged(simulationLWDSelection, handler = function(h,...) {.GlobalEnv$simulationLWD = as.numeric(svalue(simulationLWDSelection)); svalue(simulationLWDLabel)=paste("Line width:",.GlobalEnv$simulationLWD)} ) referenceLineFormattingFrame = gframe("Reference:",cont = additionalFormatting, expand = F) referenceLTYGroup = ggroup( cont = referenceLineFormattingFrame, horizontal = F , expand = T) glabel("Line type:", cont = referenceLTYGroup, anchor = c(-1,0)) referenceLTYSelected = which(potentialLineTypes == referenceLTY, arr.ind=T) referenceLTYSelection <- gcombobox( potentialLineTypes, selected=referenceLTYSelected , cont = referenceLTYGroup ) addHandlerChanged(referenceLTYSelection, handler = function(h,...) {.GlobalEnv$referenceLTY = svalue(referenceLTYSelection)} ) referenceCOLGroup = ggroup( cont = referenceLineFormattingFrame, horizontal = F , expand = T) referenceCOLLabel = glabel(paste("Colour:",.GlobalEnv$referenceCOL), cont = referenceCOLGroup, anchor = c(-1,0)) referenceCOLSelection <- gedit(referenceCOL, cont = referenceCOLGroup, expand=T) addHandlerChanged(referenceCOLSelection, handler = function(h,...) {.GlobalEnv$referenceCOL = svalue(referenceCOLSelection); svalue(referenceCOLLabel)=paste("Colour:",.GlobalEnv$referenceCOL)} ) referenceLWDGroup = ggroup( cont = referenceLineFormattingFrame, horizontal = F , expand = T) referenceLWDLabel = glabel(paste("Line width:",.GlobalEnv$referenceLWD), cont = referenceLWDGroup, anchor = c(-1,0)) referenceLWDSelection <- gedit(referenceLWD, cont = referenceLWDGroup, expand=T) addHandlerChanged(referenceLWDSelection, handler = function(h,...) {.GlobalEnv$referenceLWD = as.numeric(svalue(referenceLWDSelection)); svalue(referenceLWDLabel)=paste("Line width:",.GlobalEnv$referenceLWD)} ) tributaryLineFormattingFrame = gframe("Tributaries:",cont = additionalFormatting, expand = F) tributaryLTYGroup = ggroup( cont = tributaryLineFormattingFrame, horizontal = F , expand = T) glabel("Line type:", cont = tributaryLTYGroup, anchor = c(-1,0)) tributaryLTYSelected = which(potentialLineTypes == tributaryLTY, arr.ind=T) tributaryLTYSelection <- gcombobox( potentialLineTypes, selected=tributaryLTYSelected , cont = tributaryLTYGroup ) addHandlerChanged(tributaryLTYSelection, handler = function(h,...) {.GlobalEnv$tributaryLTY = svalue(tributaryLTYSelection)} ) tributaryCOLGroup = ggroup( cont = tributaryLineFormattingFrame, horizontal = F , expand = T) tributaryCOLLabel = glabel(paste("Colour:",.GlobalEnv$tributaryCOL), cont = tributaryCOLGroup, anchor = c(-1,0)) tributaryCOLSelection <- gedit(tributaryCOL, cont = tributaryCOLGroup, expand=T) addHandlerChanged(tributaryCOLSelection, handler = function(h,...) {.GlobalEnv$tributaryCOL = svalue(tributaryCOLSelection); svalue(tributaryCOLLabel)=paste("Colour:",.GlobalEnv$tributaryCOL)} ) tributaryLWDGroup = ggroup( cont = tributaryLineFormattingFrame, horizontal = F , expand = T) tributaryLWDLabel = glabel(paste("Line width:",.GlobalEnv$tributaryLWD), cont = tributaryLWDGroup, anchor = c(-1,0)) tributaryLWDSelection <- gedit(tributaryLWD, cont = tributaryLWDGroup, expand=T) addHandlerChanged(tributaryLWDSelection, handler = function(h,...) {.GlobalEnv$tributaryLWD = as.numeric(svalue(tributaryLWDSelection)); svalue(tributaryLWDLabel)=paste("Line width:",.GlobalEnv$tributaryLWD)} ) locationLineFormattingFrame = gframe("Locations:",cont = additionalFormatting, expand = F) locationLTYGroup = ggroup( cont = locationLineFormattingFrame, horizontal = F , expand = T) glabel("Line type:", cont = locationLTYGroup, anchor = c(-1,0)) locationLTYSelected = which(potentialLineTypes == locationLTY, arr.ind=T) locationLTYSelection <- gcombobox( potentialLineTypes, selected=locationLTYSelected , cont = locationLTYGroup ) addHandlerChanged(locationLTYSelection, handler = function(h,...) {.GlobalEnv$locationLTY = svalue(locationLTYSelection)} ) locationCOLGroup = ggroup( cont = locationLineFormattingFrame, horizontal = F , expand = T) locationCOLLabel = glabel(paste("Colour:",.GlobalEnv$locationCOL), cont = locationCOLGroup, anchor = c(-1,0)) locationCOLSelection <- gedit(locationCOL, cont = locationCOLGroup, expand=T) addHandlerChanged(locationCOLSelection, handler = function(h,...) {.GlobalEnv$locationCOL = svalue(locationCOLSelection); svalue(locationCOLLabel)=paste("Colour:",.GlobalEnv$locationCOL)} ) locationLWDGroup = ggroup( cont = locationLineFormattingFrame, horizontal = F , expand = T) locationLWDLabel = glabel(paste("Line width:",.GlobalEnv$locationLWD), cont = locationLWDGroup, anchor = c(-1,0)) locationLWDSelection <- gedit(locationLWD, cont = locationLWDGroup, expand=T) addHandlerChanged(locationLWDSelection, handler = function(h,...) {.GlobalEnv$locationLWD = as.numeric(svalue(locationLWDSelection)); svalue(locationLWDLabel)=paste("Line width:",.GlobalEnv$locationLWD)} ) otherVerticalLineFormattingFrame = gframe("Other vertical lines:",cont = additionalFormatting, expand = F) otherVerticalLineLTYGroup = ggroup( cont = otherVerticalLineFormattingFrame, horizontal = F , expand = T) glabel("Line type:", cont = otherVerticalLineLTYGroup, anchor = c(-1,0)) otherVerticalLineLTYSelected = which(potentialLineTypes == otherVerticalLineLTY, arr.ind=T) otherVerticalLineLTYSelection <- gcombobox( potentialLineTypes, selected=otherVerticalLineLTYSelected , cont = otherVerticalLineLTYGroup ) addHandlerChanged(otherVerticalLineLTYSelection, handler = function(h,...) {.GlobalEnv$otherVerticalLineLTY = svalue(otherVerticalLineLTYSelection)} ) otherVerticalLineCOLGroup = ggroup( cont = otherVerticalLineFormattingFrame, horizontal = F , expand = T) otherVerticalLineCOLLabel = glabel(paste("Colour:",.GlobalEnv$otherVerticalLineCOL), cont = otherVerticalLineCOLGroup, anchor = c(-1,0)) otherVerticalLineCOLSelection <- gedit(otherVerticalLineCOL, cont = otherVerticalLineCOLGroup, expand=T) addHandlerChanged(otherVerticalLineCOLSelection, handler = function(h,...) {.GlobalEnv$otherVerticalLineCOL = svalue(otherVerticalLineCOLSelection); svalue(otherVerticalLineCOLLabel)=paste("Colour:",.GlobalEnv$otherVerticalLineCOL)} ) otherVerticalLineLWDGroup = ggroup( cont = otherVerticalLineFormattingFrame, horizontal = F , expand = T) otherVerticalLineLWDLabel = glabel(paste("Line width:",.GlobalEnv$otherVerticalLineLWD), cont = otherVerticalLineLWDGroup, anchor = c(-1,0)) otherVerticalLineLWDSelection <- gedit(otherVerticalLineLWD, cont = otherVerticalLineLWDGroup, expand=T) addHandlerChanged(otherVerticalLineLWDSelection, handler = function(h,...) {.GlobalEnv$otherVerticalLineLWD = as.numeric(svalue(otherVerticalLineLWDSelection)); svalue(otherVerticalLineLWDLabel)=paste("Line width:",.GlobalEnv$otherVerticalLineLWD)} ) sillCOLLabel = glabel(paste("Sill colour:",.GlobalEnv$sillCOL), cont = additionalFormatting, anchor = c(-1,0)) sillCOLSelection <- gedit(sillCOL, cont = additionalFormatting, expand=F) addHandlerChanged(sillCOLSelection, handler = function(h,...) {.GlobalEnv$sillCOL = svalue(sillCOLSelection); svalue(sillCOLLabel)=paste("Silll colour:",.GlobalEnv$sillCOL)} ) ####################################################################################### fileNamesGroup <- ggroup ( cont = notebook, horizontal = F, label = "File names" , expand = T ) elevationFileNameLabel = glabel(paste("Elevation:",.GlobalEnv$elevationFileName), cont = fileNamesGroup, anchor = c(-1,0)) elevationFileNameSelection <- gedit(elevationFileName, cont = fileNamesGroup, expand=F) addHandlerChanged(elevationFileNameSelection, handler = function(h,...) {.GlobalEnv$elevationFileName = svalue(elevationFileNameSelection); svalue(elevationFileNameLabel)=paste("Elevation:",.GlobalEnv$elevationFileName)} ) gseparator(cont=fileNamesGroup) ABTOverallVolumeFileNameLabel = glabel(paste("ABT:",.GlobalEnv$ABTOverallVolumeFileName), cont = fileNamesGroup, anchor = c(-1,0)) ABTOverallVolumeFileNameSelection <- gedit(ABTOverallVolumeFileName, cont = fileNamesGroup, expand=F) addHandlerChanged(ABTOverallVolumeFileNameSelection, handler = function(h,...) {.GlobalEnv$ABTOverallVolumeFileName = svalue(ABTOverallVolumeFileNameSelection); svalue(ABTOverallVolumeFileNameLabel)=paste("ABT:",.GlobalEnv$ABTOverallVolumeFileName)} ) gseparator(cont=fileNamesGroup) grainSizeFileNameLabel = glabel(paste("First grain size:",.GlobalEnv$grainSizeFileName), cont = fileNamesGroup, anchor = c(-1,0)) grainSizeFileNameSelection <- gedit(grainSizeFileName, cont = fileNamesGroup, expand=F) addHandlerChanged(grainSizeFileNameSelection, handler = function(h,...) {.GlobalEnv$grainSizeFileName = svalue(grainSizeFileNameSelection); svalue(grainSizeFileNameLabel)=paste("First grain size:",.GlobalEnv$grainSizeFileName)} ) gseparator(cont=fileNamesGroup) secondGrainSizeFileNameLabel = glabel(paste("Second grain size:",.GlobalEnv$secondGrainSizeFileName), cont = fileNamesGroup, anchor = c(-1,0)) secondGrainSizeFileNameSelection <- gedit(secondGrainSizeFileName, cont = fileNamesGroup, expand=F) addHandlerChanged(secondGrainSizeFileNameSelection, handler = function(h,...) {.GlobalEnv$secondGrainSizeFileName = svalue(secondGrainSizeFileNameSelection); svalue(secondGrainSizeFileNameLabel)=paste("Second grain size:",.GlobalEnv$secondGrainSizeFileName)} ) gseparator(cont=fileNamesGroup) alluviumThicknessFileNameLabel = glabel(paste("Alluvium thickness:",.GlobalEnv$alluviumThicknessFileName), cont = fileNamesGroup, anchor = c(-1,0)) alluviumThicknessFileNameSelection <- gedit(alluviumThicknessFileName, cont = fileNamesGroup, expand=F) addHandlerChanged(alluviumThicknessFileNameSelection, handler = function(h,...) {.GlobalEnv$alluviumThicknessFileName = svalue(alluviumThicknessFileNameSelection); svalue(alluviumThicknessFileNameLabel)=paste("Alluvium thickness:",.GlobalEnv$alluviumThicknessFileName)} ) gseparator(cont=fileNamesGroup) activeWidthFileNameLabel = glabel(paste("Active width:",.GlobalEnv$activeWidthFileName), cont = fileNamesGroup, anchor = c(-1,0)) activeWidthFileNameSelection <- gedit(activeWidthFileName, cont = fileNamesGroup, expand=F) addHandlerChanged(activeWidthFileNameSelection, handler = function(h,...) {.GlobalEnv$activeWidthFileName = svalue(activeWidthFileNameSelection); svalue(activeWidthFileNameLabel)=paste("Active width:",.GlobalEnv$activeWidthFileName)} ) gseparator(cont=fileNamesGroup) reachIDExplanationsFileNameLabel = glabel(paste("Reach ID explanations:",.GlobalEnv$reachIDExplanationsFileName), cont = fileNamesGroup, anchor = c(-1,0)) reachIDExplanationsFileNameSelection <- gedit(reachIDExplanationsFileName, cont = fileNamesGroup, expand=F) addHandlerChanged(reachIDExplanationsFileNameSelection, handler = function(h,...) {.GlobalEnv$reachIDExplanationsFileName = svalue(reachIDExplanationsFileNameSelection); svalue(reachIDExplanationsFileNameLabel)=paste("Reach ID explanations:",.GlobalEnv$reachIDExplanationsFileName)} ) ####################################################################################### labelsGroupFirst <- ggroup ( cont = notebook, horizontal = F, label = "Labels 1" , expand = T ) referenceLabelFrame = gframe("Reference:",cont = labelsGroupFirst, expand = F) referenceLabelGermanGroup = ggroup( cont = referenceLabelFrame, horizontal = F , expand = T) tmpLabel = "German:"; if(class(germanReferenceLabel) == "character") {tmpLabel = paste(tmpLabel,germanReferenceLabel)} else {tmpLabel = paste(tmpLabel,"Default including formats")} referenceLabelGermanLabel = glabel(tmpLabel, cont = referenceLabelGermanGroup, anchor = c(-1,0)) if(class(germanReferenceLabel) == "character") {tmpLabel = germanReferenceLabel} else {tmpLabel = ""} referenceLabelGermanSelection <- gedit(tmpLabel, cont = referenceLabelGermanGroup, expand=T) addHandlerChanged(referenceLabelGermanSelection, handler = function(h,...) {.GlobalEnv$germanReferenceLabel = svalue(referenceLabelGermanSelection); svalue(referenceLabelGermanLabel)=paste("German:",.GlobalEnv$germanReferenceLabel)} ) referenceLabelEnglishGroup = ggroup( cont = referenceLabelFrame, horizontal = F , expand = T) tmpLabel = "English:"; if(class(englishReferenceLabel) == "character") {tmpLabel = paste(tmpLabel,englishReferenceLabel)} else {tmpLabel = paste(tmpLabel,"Default including formats")} referenceLabelEnglishLabel = glabel(tmpLabel, cont = referenceLabelEnglishGroup, anchor = c(-1,0)) if(class(englishReferenceLabel) == "character") {tmpLabel = englishReferenceLabel} else {tmpLabel = ""} referenceLabelEnglishSelection <- gedit(tmpLabel, cont = referenceLabelEnglishGroup, expand=T) addHandlerChanged(referenceLabelEnglishSelection, handler = function(h,...) {.GlobalEnv$englishReferenceLabel = svalue(referenceLabelEnglishSelection); svalue(referenceLabelEnglishLabel)=paste("English:",.GlobalEnv$englishReferenceLabel)} ) simulationLabelFrame = gframe("Simulation:",cont = labelsGroupFirst, expand = F) simulationLabelGermanGroup = ggroup( cont = simulationLabelFrame, horizontal = F , expand = T) tmpLabel = "German:"; if(class(germanSimulationLabel) == "character") {tmpLabel = paste(tmpLabel,germanSimulationLabel)} else {tmpLabel = paste(tmpLabel,"Default including formats")} simulationLabelGermanLabel = glabel(tmpLabel, cont = simulationLabelGermanGroup, anchor = c(-1,0)) if(class(germanSimulationLabel) == "character") {tmpLabel = germanSimulationLabel} else {tmpLabel = ""} simulationLabelGermanSelection <- gedit(tmpLabel, cont = simulationLabelGermanGroup, expand=T) addHandlerChanged(simulationLabelGermanSelection, handler = function(h,...) {.GlobalEnv$germanSimulationLabel = svalue(simulationLabelGermanSelection); svalue(simulationLabelGermanLabel)=paste("German:",.GlobalEnv$germanSimulationLabel)} ) simulationLabelEnglishGroup = ggroup( cont = simulationLabelFrame, horizontal = F , expand = T) tmpLabel = "English:"; if(class(englishSimulationLabel) == "character") {tmpLabel = paste(tmpLabel,englishSimulationLabel)} else {tmpLabel = paste(tmpLabel,"Default including formats")} simulationLabelEnglishLabel = glabel(tmpLabel, cont = simulationLabelEnglishGroup, anchor = c(-1,0)) if(class(englishSimulationLabel) == "character") {tmpLabel = englishSimulationLabel} else {tmpLabel = ""} simulationLabelEnglishSelection <- gedit(tmpLabel, cont = simulationLabelEnglishGroup, expand=T) addHandlerChanged(simulationLabelEnglishSelection, handler = function(h,...) {.GlobalEnv$englishSimulationLabel = svalue(simulationLabelEnglishSelection); svalue(simulationLabelEnglishLabel)=paste("English:",.GlobalEnv$englishSimulationLabel)} ) tributaryLabelFrame = gframe("Tributary:",cont = labelsGroupFirst, expand = F) tributaryLabelGermanGroup = ggroup( cont = tributaryLabelFrame, horizontal = F , expand = T) tmpLabel = "German:"; if(class(germanTributaryLabel) == "character") {tmpLabel = paste(tmpLabel,germanTributaryLabel)} else {tmpLabel = paste(tmpLabel,"Default including formats")} tributaryLabelGermanLabel = glabel(tmpLabel, cont = tributaryLabelGermanGroup, anchor = c(-1,0)) if(class(germanTributaryLabel) == "character") {tmpLabel = germanTributaryLabel} else {tmpLabel = ""} tributaryLabelGermanSelection <- gedit(tmpLabel, cont = tributaryLabelGermanGroup, expand=T) addHandlerChanged(tributaryLabelGermanSelection, handler = function(h,...) {.GlobalEnv$germanTributaryLabel = svalue(tributaryLabelGermanSelection); svalue(tributaryLabelGermanLabel)=paste("German:",.GlobalEnv$germanTributaryLabel)} ) tributaryLabelEnglishGroup = ggroup( cont = tributaryLabelFrame, horizontal = F , expand = T) tmpLabel = "English:"; if(class(englishTributaryLabel) == "character") {tmpLabel = paste(tmpLabel,englishTributaryLabel)} else {tmpLabel = paste(tmpLabel,"Default including formats")} tributaryLabelEnglishLabel = glabel(tmpLabel, cont = tributaryLabelEnglishGroup, anchor = c(-1,0)) if(class(englishTributaryLabel) == "character") {tmpLabel = englishTributaryLabel} else {tmpLabel = ""} tributaryLabelEnglishSelection <- gedit(tmpLabel, cont = tributaryLabelEnglishGroup, expand=T) addHandlerChanged(tributaryLabelEnglishSelection, handler = function(h,...) {.GlobalEnv$englishTributaryLabel = svalue(tributaryLabelEnglishSelection); svalue(tributaryLabelEnglishLabel)=paste("English:",.GlobalEnv$englishTributaryLabel)} ) sillLabelFrame = gframe("Sill:",cont = labelsGroupFirst, expand = F) sillLabelGermanGroup = ggroup( cont = sillLabelFrame, horizontal = F , expand = T) tmpLabel = "German:"; if(class(germanSillLabel) == "character") {tmpLabel = paste(tmpLabel,germanSillLabel)} else {tmpLabel = paste(tmpLabel,"Default including formats")} sillLabelGermanLabel = glabel(tmpLabel, cont = sillLabelGermanGroup, anchor = c(-1,0)) if(class(germanSillLabel) == "character") {tmpLabel = germanSillLabel} else {tmpLabel = ""} sillLabelGermanSelection <- gedit(tmpLabel, cont = sillLabelGermanGroup, expand=T) addHandlerChanged(sillLabelGermanSelection, handler = function(h,...) {.GlobalEnv$germanSillLabel = svalue(sillLabelGermanSelection); svalue(sillLabelGermanLabel)=paste("German:",.GlobalEnv$germanSillLabel)} ) sillLabelEnglishGroup = ggroup( cont = sillLabelFrame, horizontal = F , expand = T) tmpLabel = "English:"; if(class(englishSillLabel) == "character") {tmpLabel = paste(tmpLabel,englishSillLabel)} else {tmpLabel = paste(tmpLabel,"Default including formats")} sillLabelEnglishLabel = glabel(tmpLabel, cont = sillLabelEnglishGroup, anchor = c(-1,0)) if(class(englishSillLabel) == "character") {tmpLabel = englishSillLabel} else {tmpLabel = ""} sillLabelEnglishSelection <- gedit(tmpLabel, cont = sillLabelEnglishGroup, expand=T) addHandlerChanged(sillLabelEnglishSelection, handler = function(h,...) {.GlobalEnv$englishSillLabel = svalue(sillLabelEnglishSelection); svalue(sillLabelEnglishLabel)=paste("English:",.GlobalEnv$englishSillLabel)} ) locationLabelFrame = gframe("Location:",cont = labelsGroupFirst, expand = F) locationLabelGermanGroup = ggroup( cont = locationLabelFrame, horizontal = F , expand = T) tmpLabel = "German:"; if(class(germanLocationLabel) == "character") {tmpLabel = paste(tmpLabel,germanLocationLabel)} else {tmpLabel = paste(tmpLabel,"Default including formats")} locationLabelGermanLabel = glabel(tmpLabel, cont = locationLabelGermanGroup, anchor = c(-1,0)) if(class(germanLocationLabel) == "character") {tmpLabel = germanLocationLabel} else {tmpLabel = ""} locationLabelGermanSelection <- gedit(tmpLabel, cont = locationLabelGermanGroup, expand=T) addHandlerChanged(locationLabelGermanSelection, handler = function(h,...) {.GlobalEnv$germanLocationLabel = svalue(locationLabelGermanSelection); svalue(locationLabelGermanLabel)=paste("German:",.GlobalEnv$germanLocationLabel)} ) locationLabelEnglishGroup = ggroup( cont = locationLabelFrame, horizontal = F , expand = T) tmpLabel = "English:"; if(class(englishLocationLabel) == "character") {tmpLabel = paste(tmpLabel,englishLocationLabel)} else {tmpLabel = paste(tmpLabel,"Default including formats")} locationLabelEnglishLabel = glabel(tmpLabel, cont = locationLabelEnglishGroup, anchor = c(-1,0)) if(class(englishLocationLabel) == "character") {tmpLabel = englishLocationLabel} else {tmpLabel = ""} locationLabelEnglishSelection <- gedit(tmpLabel, cont = locationLabelEnglishGroup, expand=T) addHandlerChanged(locationLabelEnglishSelection, handler = function(h,...) {.GlobalEnv$englishLocationLabel = svalue(locationLabelEnglishSelection); svalue(locationLabelEnglishLabel)=paste("English:",.GlobalEnv$englishLocationLabel)} ) abscissaLabelFrame = gframe("Abscissa:",cont = labelsGroupFirst, expand = F) abscissaLabelGermanGroup = ggroup( cont = abscissaLabelFrame, horizontal = F , expand = T) tmpLabel = "German:"; if(class(germanAbscissaLabel) == "character") {tmpLabel = paste(tmpLabel,germanAbscissaLabel)} else {tmpLabel = paste(tmpLabel,"Default including formats")} abscissaLabelGermanLabel = glabel(tmpLabel, cont = abscissaLabelGermanGroup, anchor = c(-1,0)) if(class(germanAbscissaLabel) == "character") {tmpLabel = germanAbscissaLabel} else {tmpLabel = ""} abscissaLabelGermanSelection <- gedit(tmpLabel, cont = abscissaLabelGermanGroup, expand=T) addHandlerChanged(abscissaLabelGermanSelection, handler = function(h,...) {.GlobalEnv$germanAbscissaLabel = svalue(abscissaLabelGermanSelection); svalue(abscissaLabelGermanLabel)=paste("German:",.GlobalEnv$germanAbscissaLabel)} ) abscissaLabelEnglishGroup = ggroup( cont = abscissaLabelFrame, horizontal = F , expand = T) tmpLabel = "English:"; if(class(englishAbscissaLabel) == "character") {tmpLabel = paste(tmpLabel,englishAbscissaLabel)} else {tmpLabel = paste(tmpLabel,"Default including formats")} abscissaLabelEnglishLabel = glabel(tmpLabel, cont = abscissaLabelEnglishGroup, anchor = c(-1,0)) if(class(englishAbscissaLabel) == "character") {tmpLabel = englishAbscissaLabel} else {tmpLabel = ""} abscissaLabelEnglishSelection <- gedit(tmpLabel, cont = abscissaLabelEnglishGroup, expand=T) addHandlerChanged(abscissaLabelEnglishSelection, handler = function(h,...) {.GlobalEnv$englishAbscissaLabel = svalue(abscissaLabelEnglishSelection); svalue(abscissaLabelEnglishLabel)=paste("English:",.GlobalEnv$englishAbscissaLabel)} ) ####################################################################################### labelsGroupSecond <- ggroup ( cont = notebook, horizontal = F, label = "Labels 2" , expand = T ) ABTLabelFrame = gframe("ABT:",cont = labelsGroupSecond, expand = F) ABTLabelGermanGroup = ggroup( cont = ABTLabelFrame, horizontal = F , expand = T) tmpLabel = "German:"; if(class(germanABTLabel) == "character") {tmpLabel = paste(tmpLabel,germanABTLabel)} else {tmpLabel = paste(tmpLabel,"Default including formats")} ABTLabelGermanLabel = glabel(tmpLabel, cont = ABTLabelGermanGroup, anchor = c(-1,0)) if(class(germanABTLabel) == "character") {tmpLabel = germanABTLabel} else {tmpLabel = ""} ABTLabelGermanSelection <- gedit(tmpLabel, cont = ABTLabelGermanGroup, expand=T) addHandlerChanged(ABTLabelGermanSelection, handler = function(h,...) {.GlobalEnv$germanABTLabel = svalue(ABTLabelGermanSelection); svalue(ABTLabelGermanLabel)=paste("German:",.GlobalEnv$germanABTLabel)} ) ABTLabelEnglishGroup = ggroup( cont = ABTLabelFrame, horizontal = F , expand = T) tmpLabel = "English:"; if(class(englishABTLabel) == "character") {tmpLabel = paste(tmpLabel,englishABTLabel)} else {tmpLabel = paste(tmpLabel,"Default including formats")} ABTLabelEnglishLabel = glabel(tmpLabel, cont = ABTLabelEnglishGroup, anchor = c(-1,0)) if(class(englishABTLabel) == "character") {tmpLabel = englishABTLabel} else {tmpLabel = ""} ABTLabelEnglishSelection <- gedit(tmpLabel, cont = ABTLabelEnglishGroup, expand=T) addHandlerChanged(ABTLabelEnglishSelection, handler = function(h,...) {.GlobalEnv$englishABTLabel = svalue(ABTLabelEnglishSelection); svalue(ABTLabelEnglishLabel)=paste("English:",.GlobalEnv$englishABTLabel)} ) slopeLabelFrame = gframe("Slope:",cont = labelsGroupSecond, expand = F) slopeLabelGermanGroup = ggroup( cont = slopeLabelFrame, horizontal = F , expand = T) tmpLabel = "German:"; if(class(germanSlopeLabel) == "character") {tmpLabel = paste(tmpLabel,germanSlopeLabel)} else {tmpLabel = paste(tmpLabel,"Default including formats")} slopeLabelGermanLabel = glabel(tmpLabel, cont = slopeLabelGermanGroup, anchor = c(-1,0)) if(class(germanSlopeLabel) == "character") {tmpLabel = germanSlopeLabel} else {tmpLabel = ""} slopeLabelGermanSelection <- gedit(tmpLabel, cont = slopeLabelGermanGroup, expand=T) addHandlerChanged(slopeLabelGermanSelection, handler = function(h,...) {.GlobalEnv$germanSlopeLabel = svalue(slopeLabelGermanSelection); svalue(slopeLabelGermanLabel)=paste("German:",.GlobalEnv$germanSlopeLabel)} ) slopeLabelEnglishGroup = ggroup( cont = slopeLabelFrame, horizontal = F , expand = T) tmpLabel = "English:"; if(class(englishSlopeLabel) == "character") {tmpLabel = paste(tmpLabel,englishSlopeLabel)} else {tmpLabel = paste(tmpLabel,"Default including formats")} slopeLabelEnglishLabel = glabel(tmpLabel, cont = slopeLabelEnglishGroup, anchor = c(-1,0)) if(class(englishSlopeLabel) == "character") {tmpLabel = englishSlopeLabel} else {tmpLabel = ""} slopeLabelEnglishSelection <- gedit(tmpLabel, cont = slopeLabelEnglishGroup, expand=T) addHandlerChanged(slopeLabelEnglishSelection, handler = function(h,...) {.GlobalEnv$englishSlopeLabel = svalue(slopeLabelEnglishSelection); svalue(slopeLabelEnglishLabel)=paste("English:",.GlobalEnv$englishSlopeLabel)} ) firstGrainSizeLabelFrame = gframe("FirstGrainSize:",cont = labelsGroupSecond, expand = F) firstGrainSizeLabelGermanGroup = ggroup( cont = firstGrainSizeLabelFrame, horizontal = F , expand = T) tmpLabel = "German:"; if(class(germanFirstGrainSizeLabel) == "character") {tmpLabel = paste(tmpLabel,germanFirstGrainSizeLabel)} else {tmpLabel = paste(tmpLabel,"Default including formats")} firstGrainSizeLabelGermanLabel = glabel(tmpLabel, cont = firstGrainSizeLabelGermanGroup, anchor = c(-1,0)) if(class(germanFirstGrainSizeLabel) == "character") {tmpLabel = germanFirstGrainSizeLabel} else {tmpLabel = ""} firstGrainSizeLabelGermanSelection <- gedit(tmpLabel, cont = firstGrainSizeLabelGermanGroup, expand=T) addHandlerChanged(firstGrainSizeLabelGermanSelection, handler = function(h,...) {.GlobalEnv$germanFirstGrainSizeLabel = svalue(firstGrainSizeLabelGermanSelection); svalue(firstGrainSizeLabelGermanLabel)=paste("German:",.GlobalEnv$germanFirstGrainSizeLabel)} ) firstGrainSizeLabelEnglishGroup = ggroup( cont = firstGrainSizeLabelFrame, horizontal = F , expand = T) tmpLabel = "English:"; if(class(englishFirstGrainSizeLabel) == "character") {tmpLabel = paste(tmpLabel,englishFirstGrainSizeLabel)} else {tmpLabel = paste(tmpLabel,"Default including formats")} firstGrainSizeLabelEnglishLabel = glabel(tmpLabel, cont = firstGrainSizeLabelEnglishGroup, anchor = c(-1,0)) if(class(englishFirstGrainSizeLabel) == "character") {tmpLabel = englishFirstGrainSizeLabel} else {tmpLabel = ""} firstGrainSizeLabelEnglishSelection <- gedit(tmpLabel, cont = firstGrainSizeLabelEnglishGroup, expand=T) addHandlerChanged(firstGrainSizeLabelEnglishSelection, handler = function(h,...) {.GlobalEnv$englishFirstGrainSizeLabel = svalue(firstGrainSizeLabelEnglishSelection); svalue(firstGrainSizeLabelEnglishLabel)=paste("English:",.GlobalEnv$englishFirstGrainSizeLabel)} ) secondGrainSizeLabelFrame = gframe("SecondGrainSize:",cont = labelsGroupSecond, expand = F) secondGrainSizeLabelGermanGroup = ggroup( cont = secondGrainSizeLabelFrame, horizontal = F , expand = T) tmpLabel = "German:"; if(class(germanSecondGrainSizeLabel) == "character") {tmpLabel = paste(tmpLabel,germanSecondGrainSizeLabel)} else {tmpLabel = paste(tmpLabel,"Default including formats")} secondGrainSizeLabelGermanLabel = glabel(tmpLabel, cont = secondGrainSizeLabelGermanGroup, anchor = c(-1,0)) if(class(germanSecondGrainSizeLabel) == "character") {tmpLabel = germanSecondGrainSizeLabel} else {tmpLabel = ""} secondGrainSizeLabelGermanSelection <- gedit(tmpLabel, cont = secondGrainSizeLabelGermanGroup, expand=T) addHandlerChanged(secondGrainSizeLabelGermanSelection, handler = function(h,...) {.GlobalEnv$germanSecondGrainSizeLabel = svalue(secondGrainSizeLabelGermanSelection); svalue(secondGrainSizeLabelGermanLabel)=paste("German:",.GlobalEnv$germanSecondGrainSizeLabel)} ) secondGrainSizeLabelEnglishGroup = ggroup( cont = secondGrainSizeLabelFrame, horizontal = F , expand = T) tmpLabel = "English:"; if(class(englishSecondGrainSizeLabel) == "character") {tmpLabel = paste(tmpLabel,englishSecondGrainSizeLabel)} else {tmpLabel = paste(tmpLabel,"Default including formats")} secondGrainSizeLabelEnglishLabel = glabel(tmpLabel, cont = secondGrainSizeLabelEnglishGroup, anchor = c(-1,0)) if(class(englishSecondGrainSizeLabel) == "character") {tmpLabel = englishSecondGrainSizeLabel} else {tmpLabel = ""} secondGrainSizeLabelEnglishSelection <- gedit(tmpLabel, cont = secondGrainSizeLabelEnglishGroup, expand=T) addHandlerChanged(secondGrainSizeLabelEnglishSelection, handler = function(h,...) {.GlobalEnv$englishSecondGrainSizeLabel = svalue(secondGrainSizeLabelEnglishSelection); svalue(secondGrainSizeLabelEnglishLabel)=paste("English:",.GlobalEnv$englishSecondGrainSizeLabel)} ) bedElevationChangeLabelFrame = gframe("BedElevationChange:",cont = labelsGroupSecond, expand = F) bedElevationChangeLabelGermanGroup = ggroup( cont = bedElevationChangeLabelFrame, horizontal = F , expand = T) tmpLabel = "German:"; if(class(germanBedElevationChangeLabel) == "character") {tmpLabel = paste(tmpLabel,germanBedElevationChangeLabel)} else {tmpLabel = paste(tmpLabel,"Default including formats")} bedElevationChangeLabelGermanLabel = glabel(tmpLabel, cont = bedElevationChangeLabelGermanGroup, anchor = c(-1,0)) if(class(germanBedElevationChangeLabel) == "character") {tmpLabel = germanBedElevationChangeLabel} else {tmpLabel = ""} bedElevationChangeLabelGermanSelection <- gedit(tmpLabel, cont = bedElevationChangeLabelGermanGroup, expand=T) addHandlerChanged(bedElevationChangeLabelGermanSelection, handler = function(h,...) {.GlobalEnv$germanBedElevationChangeLabel = svalue(bedElevationChangeLabelGermanSelection); svalue(bedElevationChangeLabelGermanLabel)=paste("German:",.GlobalEnv$germanBedElevationChangeLabel)} ) bedElevationChangeLabelEnglishGroup = ggroup( cont = bedElevationChangeLabelFrame, horizontal = F , expand = T) tmpLabel = "English:"; if(class(englishBedElevationChangeLabel) == "character") {tmpLabel = paste(tmpLabel,englishBedElevationChangeLabel)} else {tmpLabel = paste(tmpLabel,"Default including formats")} bedElevationChangeLabelEnglishLabel = glabel(tmpLabel, cont = bedElevationChangeLabelEnglishGroup, anchor = c(-1,0)) if(class(englishBedElevationChangeLabel) == "character") {tmpLabel = englishBedElevationChangeLabel} else {tmpLabel = ""} bedElevationChangeLabelEnglishSelection <- gedit(tmpLabel, cont = bedElevationChangeLabelEnglishGroup, expand=T) addHandlerChanged(bedElevationChangeLabelEnglishSelection, handler = function(h,...) {.GlobalEnv$englishBedElevationChangeLabel = svalue(bedElevationChangeLabelEnglishSelection); svalue(bedElevationChangeLabelEnglishLabel)=paste("English:",.GlobalEnv$englishBedElevationChangeLabel)} ) channelWidthLabelFrame = gframe("ChannelWidth:",cont = labelsGroupSecond, expand = F) channelWidthLabelGermanGroup = ggroup( cont = channelWidthLabelFrame, horizontal = F , expand = T) tmpLabel = "German:"; if(class(germanChannelWidthLabel) == "character") {tmpLabel = paste(tmpLabel,germanChannelWidthLabel)} else {tmpLabel = paste(tmpLabel,"Default including formats")} channelWidthLabelGermanLabel = glabel(tmpLabel, cont = channelWidthLabelGermanGroup, anchor = c(-1,0)) if(class(germanChannelWidthLabel) == "character") {tmpLabel = germanChannelWidthLabel} else {tmpLabel = ""} channelWidthLabelGermanSelection <- gedit(tmpLabel, cont = channelWidthLabelGermanGroup, expand=T) addHandlerChanged(channelWidthLabelGermanSelection, handler = function(h,...) {.GlobalEnv$germanChannelWidthLabel = svalue(channelWidthLabelGermanSelection); svalue(channelWidthLabelGermanLabel)=paste("German:",.GlobalEnv$germanChannelWidthLabel)} ) channelWidthLabelEnglishGroup = ggroup( cont = channelWidthLabelFrame, horizontal = F , expand = T) tmpLabel = "English:"; if(class(englishChannelWidthLabel) == "character") {tmpLabel = paste(tmpLabel,englishChannelWidthLabel)} else {tmpLabel = paste(tmpLabel,"Default including formats")} channelWidthLabelEnglishLabel = glabel(tmpLabel, cont = channelWidthLabelEnglishGroup, anchor = c(-1,0)) if(class(englishChannelWidthLabel) == "character") {tmpLabel = englishChannelWidthLabel} else {tmpLabel = ""} channelWidthLabelEnglishSelection <- gedit(tmpLabel, cont = channelWidthLabelEnglishGroup, expand=T) addHandlerChanged(channelWidthLabelEnglishSelection, handler = function(h,...) {.GlobalEnv$englishChannelWidthLabel = svalue(channelWidthLabelEnglishSelection); svalue(channelWidthLabelEnglishLabel)=paste("English:",.GlobalEnv$englishChannelWidthLabel)} ) startButton <- gbutton ( "Create plot" , cont = overallGroup) enabled(startButton) = FALSE svalue(notebook) = 1 visible(window) = TRUE addHandlerChanged(startButton, handler = function(h,...) { ####################################################################################### simulationName = basename(path) rDataFile = paste("sedFlow_",simulationName,".Rdata",sep="") outputName = simulationName if(drawIndividualPlots) { distanceBetweenPlotsInLines = 2.5 } kilometrageTickInterval = 1 relativeLengthOfSubordinateTicks = 1/3 plotPortionForOrdinates = 0.1 relativePositionOfSecondOrdinate = 4/5 primaryOrdinateLabelLine = 2.5 secondaryOrdinateLabelLine = -2.0 ####################################################################################### ####################################################################################### ####################################################################################### setwd(file.path(path,"Output")) imageHeightInCM = imageWidthInCM / imageWidthToHeight imageFunction = imageFileExtension if(imageFileExtension == "jpg") {imageFunction = "jpeg"} if(imageFileExtension == "tif") {imageFunction = "tiff"} if(imageFileExtension == "ps" || imageFileExtension == "eps") {imageFunction = "postscript"} if(inGerman) { referenceLabel = germanReferenceLabel simulationLabel = germanSimulationLabel tributaryLabel = germanTributaryLabel locationLabel = germanLocationLabel sillLabel = germanSillLabel abscissaLabel = germanAbscissaLabel ABTLabel = germanABTLabel slopeLabel = germanSlopeLabel firstGrainSizeLabel = germanFirstGrainSizeLabel secondGrainSizeLabel = germanSecondGrainSizeLabel bedElevationChangeLabel = germanBedElevationChangeLabel channelWidthLabel = germanChannelWidthLabel outputName = paste(outputName,"DE",sep="_") } else { referenceLabel = englishReferenceLabel simulationLabel = englishSimulationLabel tributaryLabel = englishTributaryLabel locationLabel = englishLocationLabel sillLabel = englishSillLabel abscissaLabel = englishAbscissaLabel ABTLabel = englishABTLabel slopeLabel = englishSlopeLabel firstGrainSizeLabel = englishFirstGrainSizeLabel secondGrainSizeLabel = englishSecondGrainSizeLabel bedElevationChangeLabel = englishBedElevationChangeLabel channelWidthLabel = englishChannelWidthLabel outputName = paste(outputName,"EN",sep="_") } if(drawIndividualPlots) { outputName = paste(outputName,"indivPlots",sep="_") } if(rDataFile %in% list.files()) { load(rDataFile) } else { variablesToSave=vector() setwd(path) if( nchar(comparisonFileName) > 0 ) { comparisonData = read.table(comparisonFileName, header=TRUE, na.strings = "NaN") variablesToSave = c(variablesToSave, "comparisonData") } positionsOfSillsInKM = c() topEdgeElevationsOfSills = c() tmpFileNames = list.files() if( "LongitudinalProfile" %in% tmpFileNames ) { setwd(file.path(path, "LongitudinalProfile")) originalBranchTopology = read.table("BranchTopology.txt", header=TRUE, na.strings = "NaN") allBranches = sort(unique(unlist(c(originalBranchTopology$BranchIDs,originalBranchTopology$DownstreamBranchIDs))),decreasing = FALSE) mainChannelBranches = allBranches[-(which(allBranches %in% branchesNOTbelongingToMainChannel, arr.ind=TRUE))] rm(allBranches) initialActiveWidth = vector() initialAlluviumThickness = vector() for(currentBranch in mainChannelBranches) { tmpBranch = read.table(paste("Branch",currentBranch,"Profile.txt",sep=""), header=TRUE, na.strings = "NaN") initialActiveWidth = unlist(c(initialActiveWidth,tmpBranch$ChannelWidthInM)) initialAlluviumThickness = unlist(c(initialAlluviumThickness,tmpBranch$AlluviumThicknessInM)) rm(tmpBranch) } rm(currentBranch,mainChannelBranches) variablesToSave = c(variablesToSave,"initialActiveWidth","initialAlluviumThickness") positionsOfVerticalLinesInKMDerivedFromBranchesNotBelongingToMainChannel = vector(mode="numeric") tmpBranchTopology = originalBranchTopology tmpBranchTopology = tmpBranchTopology[which(tmpBranchTopology$BranchIDs %in% branchesNOTbelongingToMainChannel, arr.ind=TRUE),] toRemove = which(tmpBranchTopology$DownstreamBranchIDs %in% branchesNOTbelongingToMainChannel, arr.ind=TRUE) if(length(toRemove)>0) {tmpBranchTopology = tmpBranchTopology[-toRemove,]} feedsToMainChannel = unique(tmpBranchTopology$DownstreamBranchIDs) rm(tmpBranchTopology,toRemove) for(currentFeed in feedsToMainChannel) { tmpBranch = read.table(paste("Branch",currentFeed,"Profile.txt",sep=""), header=TRUE, na.strings = "NaN") positionsOfVerticalLinesInKMDerivedFromBranchesNotBelongingToMainChannel = c(positionsOfVerticalLinesInKMDerivedFromBranchesNotBelongingToMainChannel, max(tmpBranch$KilometrageUpstreamDirected)) rm(tmpBranch) } rm(currentFeed,feedsToMainChannel) rm(originalBranchTopology) tmpFileNames = list.files() if( "Sills.txt" %in% tmpFileNames ) { tmpSills = read.table("Sills.txt", header=TRUE, na.strings = "NaN") toRemove = which(tmpSills$BranchIDs %in% branchesNOTbelongingToMainChannel, arr.ind=TRUE) if(length(toRemove)>0) {tmpSills = tmpSills[-toRemove,]} positionsOfSillsInKM = tmpSills$KilometrageUpstreamDirected topEdgeElevationsOfSills = tmpSills$SillTopEdgeElevationInM rm(tmpSills,toRemove) } } rm(tmpFileNames) variablesToSave = c(variablesToSave,"positionsOfSillsInKM","positionsOfVerticalLinesInKMDerivedFromBranchesNotBelongingToMainChannel") setwd(file.path(path, "Output")) cellIDExplanations = read.table(reachIDExplanationsFileName, header=TRUE, na.strings = "NaN") if(length(branchesNOTbelongingToMainChannel) > 0) { for(currentBranchID in 1:length(branchesNOTbelongingToMainChannel)) { cellIDExplanations = cellIDExplanations[-(which(cellIDExplanations[,2]==branchesNOTbelongingToMainChannel[currentBranchID],arr.ind=TRUE)),] } rm(currentBranchID) } reachIDsToPlot = cellIDExplanations[,1] kilometrage = cellIDExplanations[,3] rm(cellIDExplanations) variablesToSave = c(variablesToSave,"kilometrage") if( nchar(comparisonFileName) > 0 ) { comparisonDataTailored = comparisonData rowsToRemove = which(comparisonDataTailored$Kilometrage < min(kilometrage),arr.ind=TRUE) if( length(rowsToRemove) > 0 ) { comparisonDataTailored = comparisonDataTailored[-( rowsToRemove ),] } rowsToRemove = which(comparisonDataTailored$Kilometrage > max(kilometrage),arr.ind=TRUE) if( length(rowsToRemove) > 0 ) { comparisonDataTailored = comparisonDataTailored[-( rowsToRemove ),] } rm(rowsToRemove) variablesToSave = c(variablesToSave,"comparisonDataTailored") } elevationRaw = read.table(elevationFileName, header=TRUE, na.strings = "NaN") elevationColumnNames = colnames(elevationRaw) elevation = matrix(NA,nrow=nrow(elevationRaw),ncol=length(reachIDsToPlot)) for(IDForReachIDToPlot in 1:length(reachIDsToPlot)) { reachIDToPlot = reachIDsToPlot[IDForReachIDToPlot] columnIDToPlot = grep(paste("Reach",reachIDToPlot,"\\>",sep=""),elevationColumnNames) if(length(columnIDToPlot) > 0) { elevation[,IDForReachIDToPlot] = elevationRaw[,columnIDToPlot[1]] } rm(columnIDToPlot) rm(reachIDToPlot) } rm(IDForReachIDToPlot) rm(elevationColumnNames) rm(elevationRaw) initialElevation = elevation[1,] finalElevation = elevation[nrow(elevation),] initialTopEdgeElevation = initialElevation finalTopEdgeElevation = finalElevation rm(elevation) elevationDifference = finalElevation - initialElevation kilometrageForElevationDifference = kilometrage if( length(positionsOfSillsInKM) > 0 ) { for(currentSillID in 1:length(positionsOfSillsInKM)) { position = which(kilometrageForElevationDifference == positionsOfSillsInKM[currentSillID],arr.ind=TRUE) positionInOriginalFiles = which(kilometrage == positionsOfSillsInKM[currentSillID],arr.ind=TRUE) if( length(positionInOriginalFiles) > 0 ) { toInsert = max(0.0,(finalElevation[positionInOriginalFiles[1]] - topEdgeElevationsOfSills[currentSillID])) elevationDifference = append(elevationDifference,toInsert,after=(position[1] - 1)) rm(toInsert) kilometrageForElevationDifference = append(kilometrageForElevationDifference,positionsOfSillsInKM[currentSillID],after=(position[1] - 1)) initialTopEdgeElevation[positionInOriginalFiles] = max(initialTopEdgeElevation[positionInOriginalFiles],topEdgeElevationsOfSills[currentSillID]) finalTopEdgeElevation[positionInOriginalFiles] = max(finalTopEdgeElevation[positionInOriginalFiles],topEdgeElevationsOfSills[currentSillID]) } rm(position,positionInOriginalFiles) } rm(currentSillID) } rm(topEdgeElevationsOfSills) variablesToSave = c(variablesToSave,"finalElevation","initialElevation","elevationDifference","kilometrageForElevationDifference") distance=vector() for(currentCellID in 2:length(kilometrage)) { distance[(1+length(distance))] = kilometrage[currentCellID-1] - kilometrage[currentCellID] } rm(currentCellID) distance = distance * 1000 #From km to m initialReachElevationDifference = vector() finalReachElevationDifference = vector() for(currentCellID in 2:length(initialElevation)) { initialReachElevationDifference[(1+length(initialReachElevationDifference))] = initialElevation[(currentCellID-1)] - initialTopEdgeElevation[currentCellID] finalReachElevationDifference[(1+length(finalReachElevationDifference))] = finalElevation[(currentCellID-1)] - finalTopEdgeElevation[currentCellID] } rm(currentCellID) rm(initialTopEdgeElevation,finalTopEdgeElevation) initialSlope = initialReachElevationDifference / distance initialSlope[(1 + length(initialSlope))] = initialSlope[length(initialSlope)] initialSlopeInPercent = initialSlope * 100 rm(initialSlope,initialReachElevationDifference) finalSlope = finalReachElevationDifference / distance finalSlope[(1 + length(finalSlope))] = finalSlope[length(finalSlope)] finalSlopeInPercent = finalSlope * 100 rm(finalSlope,finalReachElevationDifference) rm(distance) variablesToSave = c(variablesToSave,"initialSlopeInPercent","finalSlopeInPercent") ABTOverallVolumeRaw = read.table(ABTOverallVolumeFileName, header=TRUE, na.strings = "NaN") ABTOverallVolumeColumnNames = colnames(ABTOverallVolumeRaw) ABTOverallVolume = matrix(NA,nrow=nrow(ABTOverallVolumeRaw),ncol=length(reachIDsToPlot)) for(IDForReachIDToPlot in 1:length(reachIDsToPlot)) { reachIDToPlot = reachIDsToPlot[IDForReachIDToPlot] columnIDToPlot = grep(paste("Reach",reachIDToPlot,"\\>",sep=""),ABTOverallVolumeColumnNames) if(length(columnIDToPlot) > 0) { ABTOverallVolume[,IDForReachIDToPlot] = ABTOverallVolumeRaw[,columnIDToPlot[1]] } rm(columnIDToPlot) rm(reachIDToPlot) } rm(IDForReachIDToPlot) rm(ABTOverallVolumeColumnNames) rm(ABTOverallVolumeRaw) finalABT = ABTOverallVolume[nrow(ABTOverallVolume),] rm(ABTOverallVolume) variablesToSave = c(variablesToSave,"finalABT") if( nchar(secondGrainSizeFileName) == 0 ) { grainSizeRaw = read.table(grainSizeFileName, header=TRUE, na.strings = "NaN") grainSizeColumnNames = colnames(grainSizeRaw) firstGrainSizeColumnIDs = grep(paste("D",firstGrainSizePercentile,sep=""),grainSizeColumnNames) secondGrainSizeColumnIDs = grep(paste("D",secondGrainSizePercentile,sep=""),grainSizeColumnNames) firstGrainSize = matrix(NA,nrow=nrow(grainSizeRaw),ncol=length(reachIDsToPlot)) secondGrainSize = matrix(NA,nrow=nrow(grainSizeRaw),ncol=length(reachIDsToPlot)) for(IDForReachIDToPlot in 1:length(reachIDsToPlot)) { reachIDToPlot = reachIDsToPlot[IDForReachIDToPlot] reachColumnIDToPlot = grep(paste("Reach",reachIDToPlot,"\\>",sep=""),grainSizeColumnNames) firstColumnIDToPlot = intersect(firstGrainSizeColumnIDs,reachColumnIDToPlot) secondColumnIDToPlot = intersect(secondGrainSizeColumnIDs,reachColumnIDToPlot) if(length(firstColumnIDToPlot) > 0) { firstGrainSize[,IDForReachIDToPlot] = grainSizeRaw[,firstColumnIDToPlot[1]] } if(length(secondColumnIDToPlot) > 0) { secondGrainSize[,IDForReachIDToPlot] = grainSizeRaw[,secondColumnIDToPlot[1]] } rm(secondColumnIDToPlot) rm(firstColumnIDToPlot) rm(reachColumnIDToPlot) rm(reachIDToPlot) } rm(IDForReachIDToPlot) rm(grainSizeColumnNames) rm(secondGrainSizeColumnIDs) rm(firstGrainSizeColumnIDs) rm(grainSizeRaw) } else { firstGrainSizeRaw = read.table(grainSizeFileName, header=TRUE, na.strings = "NaN") firstGrainSizeColumnNames = colnames(firstGrainSizeRaw) firstGrainSize = matrix(NA,nrow=nrow(firstGrainSizeRaw),ncol=length(reachIDsToPlot)) for(IDForReachIDToPlot in 1:length(reachIDsToPlot)) { reachIDToPlot = reachIDsToPlot[IDForReachIDToPlot] columnIDToPlot = grep(paste("Reach",reachIDToPlot,"\\>",sep=""),firstGrainSizeColumnNames) if(length(columnIDToPlot) > 0) { firstGrainSize[,IDForReachIDToPlot] = firstGrainSizeRaw[,columnIDToPlot[1]] } rm(columnIDToPlot) rm(reachIDToPlot) } rm(IDForReachIDToPlot) rm(firstGrainSizeColumnNames) rm(firstGrainSizeRaw) secondGrainSizeRaw = read.table(secondGrainSizeFileName, header=TRUE, na.strings = "NaN") secondGrainSizeColumnNames = colnames(secondGrainSizeRaw) secondGrainSize = matrix(NA,nrow=nrow(secondGrainSizeRaw),ncol=length(reachIDsToPlot)) for(IDForReachIDToPlot in 1:length(reachIDsToPlot)) { reachIDToPlot = reachIDsToPlot[IDForReachIDToPlot] columnIDToPlot = grep(paste("Reach",reachIDToPlot,"\\>",sep=""),secondGrainSizeColumnNames) if(length(columnIDToPlot) > 0) { secondGrainSize[,IDForReachIDToPlot] = secondGrainSizeRaw[,columnIDToPlot[1]] } rm(columnIDToPlot) rm(reachIDToPlot) } rm(IDForReachIDToPlot) rm(secondGrainSizeColumnNames) rm(secondGrainSizeRaw) } initialFirstGrainSize = firstGrainSize[1,] finalFirstGrainSize = firstGrainSize[nrow(firstGrainSize),] initialSecondGrainSize = secondGrainSize[1,] finalSecondGrainSize = secondGrainSize[nrow(secondGrainSize),] rm(secondGrainSize) rm(firstGrainSize) variablesToSave = c(variablesToSave,"initialFirstGrainSize","finalFirstGrainSize","initialSecondGrainSize","finalSecondGrainSize") if( nchar(alluviumThicknessFileName) > 0 ) { alluviumThicknessRaw = read.table(alluviumThicknessFileName, header=TRUE, na.strings = "NaN") alluviumThicknessColumnNames = colnames(alluviumThicknessRaw) alluviumThickness = matrix(NA,nrow=nrow(alluviumThicknessRaw),ncol=length(reachIDsToPlot)) for(IDForReachIDToPlot in 1:length(reachIDsToPlot)) { reachIDToPlot = reachIDsToPlot[IDForReachIDToPlot] columnIDToPlot = grep(paste("Reach",reachIDToPlot,"\\>",sep=""),alluviumThicknessColumnNames) if(length(columnIDToPlot) > 0) { alluviumThickness[,IDForReachIDToPlot] = alluviumThicknessRaw[,columnIDToPlot[1]] } rm(columnIDToPlot) rm(reachIDToPlot) } rm(IDForReachIDToPlot) rm(alluviumThicknessColumnNames) rm(alluviumThicknessRaw) initialAlluviumThickness = alluviumThickness[1,] rm(alluviumThickness) variablesToSave = c(variablesToSave,"initialAlluviumThickness") } if( (!(exists("initialActiveWidth"))) && nchar(activeWidthFileName) > 0 ) { activeWidthRaw = read.table(activeWidthFileName, header=TRUE, na.strings = "NaN") activeWidthColumnNames = colnames(activeWidthRaw) activeWidth = matrix(NA,nrow=nrow(activeWidthRaw),ncol=length(reachIDsToPlot)) for(IDForReachIDToPlot in 1:length(reachIDsToPlot)) { reachIDToPlot = reachIDsToPlot[IDForReachIDToPlot] columnIDToPlot = grep(paste("Reach",reachIDToPlot,"\\>",sep=""),activeWidthColumnNames) if(length(columnIDToPlot) > 0) { activeWidth[,IDForReachIDToPlot] = activeWidthRaw[,columnIDToPlot[1]] } rm(columnIDToPlot) rm(reachIDToPlot) } rm(IDForReachIDToPlot) rm(activeWidthColumnNames) rm(activeWidthRaw) initialActiveWidth = activeWidth[1,] rm(activeWidth) variablesToSave = c(variablesToSave,"initialActiveWidth") } save(list=variablesToSave,file=rDataFile) rm(variablesToSave) rm(reachIDsToPlot) } rm(rDataFile) if( !exists("comparisonData") ) { Kilometrage = kilometrage ABTOverallVolume = BedElevationChange = rep(NA,length(kilometrage)) comparisonData = data.frame(Kilometrage,ABTOverallVolume,BedElevationChange) rm(Kilometrage,ABTOverallVolume,BedElevationChange) } if(imageFileExtension == "ps") {setPS()} if(imageFileExtension == "eps") {setEPS()} imageArguments = list(height = imageHeightInCM, width = imageWidthInCM) if((imageFunction == "postscript") || (imageFunction == "pdf")) { imageArguments = c(imageArguments, file = paste(outputName,imageFileExtension,sep="."), paper="special") } else { imageArguments = c(imageArguments, filename = paste(outputName,imageFileExtension,sep="."), units = "cm", res = resolution) } do.call(imageFunction, args = imageArguments) par(cex=plotFontSize) lineTypes = lineWidths = legendColours = pointCharacters = legendLabels = vector() if( (sum(!is.na(comparisonData$ABTOverallVolume)) + sum(!is.na(comparisonData$BedElevationChange))) > 0 ) { lineTypes = c(lineTypes,referenceLTY) lineWidths = c(lineWidths,referenceLWD) legendColours = c(legendColours,referenceCOL) pointCharacters = c(pointCharacters,"") legendLabels = c(legendLabels,referenceLabel) } lineTypes = c(lineTypes,simulationLTY) lineWidths = c(lineWidths,simulationLWD) legendColours = c(legendColours,simulationCOL) pointCharacters = c(pointCharacters,"") legendLabels = c(legendLabels,simulationLabel) if(length(positionsOfVerticalLinesInKM) == 0) {positionsOfVerticalLinesInKM = positionsOfVerticalLinesInKMDerivedFromBranchesNotBelongingToMainChannel} if(displayNoTributaries) {positionsOfVerticalLinesInKM = vector(mode="numeric")} if(length(positionsOfVerticalLinesInKM) > 0) { lineTypes = c(lineTypes,tributaryLTY) lineWidths = c(lineWidths,tributaryLWD) legendColours = c(legendColours,tributaryCOL) pointCharacters = c(pointCharacters,"") legendLabels = c(legendLabels,tributaryLabel) } if(length(locations) > 0) { lineTypes = c(lineTypes,locationLTY) lineWidths = c(lineWidths,locationLWD) legendColours = c(legendColours,locationCOL) pointCharacters = c(pointCharacters,"") legendLabels = c(legendLabels,locationLabel) } if(length(positionsOfSillsInKM) > 0) { lineTypes = c(lineTypes,"blank") lineWidths = c(lineWidths,simulationLWD) legendColours = c(legendColours,sillCOL) pointCharacters = c(pointCharacters,"|") legendLabels = c(legendLabels,sillLabel) } if(drawIndividualPlots) { par(mfrow=c(length(orderOfPlots),1),cex=plotFontSize) myTempPlottingFunction = function(currentPlotID,plotProperty,referenceKilometrageValues,simulationKilometrageValues,referenceValues,simulationValues,labelValue) { plotID = which( orderOfPlots == plotProperty, arr.ind=TRUE) if( length(plotID) == 1 && currentPlotID == plotID) { par(mar=(c(distanceBetweenPlotsInLines,4,0,2)+0.1)) if(plotID == 1) { par(mar=(c(distanceBetweenPlotsInLines,4,2,2)+0.1)) } if(plotID == length(orderOfPlots)) { par(mar=(c(5,4,0,2)+0.1)) } plot(simulationKilometrageValues,simulationValues,type="n",xlim=rev(range(simulationKilometrageValues)),ylim=range(unlist(c(referenceValues,simulationValues)),na.rm=TRUE),main="",axes=FALSE,xlab="",ylab="") if(printPanelLabels){text(par("usr")[1],par("usr")[4],labels=bquote(bold(.(letters[plotID]))),adj=c(-1.5,2.5))} abline(v = positionsOfVerticalLinesInKM, lty=tributaryLTY, lwd=tributaryLWD, col=tributaryCOL) abline(v = locations, lty=locationLTY, lwd=locationLWD, col=locationCOL) abline(v = positionsOfOtherVerticalLinesInKM, lty=otherVerticalLineLTY, lwd=otherVerticalLineLWD, col=otherVerticalLineCOL) if(plotProperty == "eroDepo") { lines(range(kilometrage),rep(0.0,2),lty="dotted",lwd=tributaryLWD,col="black") points(positionsOfSillsInKM,rep(min(unlist(c(referenceValues,simulationValues)),na.rm=TRUE),length(positionsOfSillsInKM)),pch="|",col=sillCOL) } if(currentPlotID == 1) { if(length(legendPosition) > 1) { legend(legendPosition[1],legendPosition[2],col=legendColours,lty=lineTypes,lwd=lineWidths,pch=pointCharacters,legend=legendLabels,bg="white",box.lty="blank") } else { legend(legendPosition,col=legendColours,lty=lineTypes,lwd=lineWidths,pch=pointCharacters,legend=legendLabels,bg="white",box.lty="blank") } } box(bty="l") kilometrageLabels = pretty(referenceKilometrageValues) kilometrageTicks = seq(from = min(kilometrageLabels), to = max(kilometrageLabels), by = kilometrageTickInterval) axis(1,at=kilometrageTicks,tcl=(-0.5*relativeLengthOfSubordinateTicks),labels=FALSE);axis(1,at=kilometrageLabels,tcl=-0.5);axis(2) par(xpd=NA) title(ylab=labelValue,line=2.5) par(xpd=F) if(currentPlotID == length(orderOfPlots)) { title(xlab=abscissaLabel) } lines(referenceKilometrageValues,referenceValues,lwd=referenceLWD,lty=referenceLTY,col=referenceCOL) if(plotProperty != "channelWidth") { lines(simulationKilometrageValues,simulationValues,lwd=simulationLWD,lty=simulationLTY,col=simulationCOL) } } } for(currentPlotID in 1:length(orderOfPlots)) { myTempPlottingFunction(currentPlotID,"ABT",comparisonData$Kilometrage,kilometrage,comparisonData$ABTOverallVolume,finalABT,ABTLabel) myTempPlottingFunction(currentPlotID,"slope",kilometrage,kilometrage,initialSlopeInPercent,finalSlopeInPercent,slopeLabel) myTempPlottingFunction(currentPlotID,"eroDepo",comparisonData$Kilometrage,kilometrageForElevationDifference,comparisonData$BedElevationChange,elevationDifference,bedElevationChangeLabel) myTempPlottingFunction(currentPlotID,"firstGS",kilometrage,kilometrage,initialFirstGrainSize,finalFirstGrainSize,firstGrainSizeLabel) myTempPlottingFunction(currentPlotID,"secondGS",kilometrage,kilometrage,initialSecondGrainSize,finalSecondGrainSize,secondGrainSizeLabel) myTempPlottingFunction(currentPlotID,"channelWidth",kilometrage,kilometrage,initialActiveWidth,initialActiveWidth,channelWidthLabel) } rm(finalABT,initialSlopeInPercent,finalSlopeInPercent,elevationDifference,initialFirstGrainSize,finalFirstGrainSize,initialSecondGrainSize,finalSecondGrainSize,initialActiveWidth) } else { xLimForPlots = c( ( max(kilometrage,na.rm=TRUE) + (max(kilometrage,na.rm=TRUE)-min(kilometrage,na.rm=TRUE)) * plotPortionForOrdinates/(1.0-plotPortionForOrdinates) ) ,min(kilometrage,na.rm=TRUE)) par(mar=(c(5,4,2,2)+0.1)) plot(kilometrage,kilometrage,type="n",xlim=xLimForPlots,main="",axes=FALSE,xlab=abscissaLabel,ylab="") abline(v = positionsOfVerticalLinesInKM, lty=tributaryLTY, lwd=tributaryLWD, col=tributaryCOL) abline(v = locations, lty=locationLTY, lwd=locationLWD, col=locationCOL) abline(v = positionsOfOtherVerticalLinesInKM, lty=otherVerticalLineLTY, lwd=otherVerticalLineLWD, col=otherVerticalLineCOL) if(legendPosition == "topleft") { legendPosition = c(max(pretty(kilometrage)),par('usr')[4]) } if(length(legendPosition) > 1) { legend(legendPosition[1],legendPosition[2],col=legendColours,lty=lineTypes,lwd=lineWidths,pch=pointCharacters,legend=legendLabels,bg="white",box.lty="blank") } else { legend(legendPosition,col=legendColours,lty=lineTypes,lwd=lineWidths,pch=pointCharacters,legend=legendLabels,bg="white",box.lty="blank") } rm(legendColours,lineTypes,lineWidths,pointCharacters,legendLabels) axis(1,at=pretty(kilometrage)) outerOrdinatePosition = par('usr')[1] innerOrdinatePosition = outerOrdinatePosition - relativePositionOfSecondOrdinate * ( outerOrdinatePosition - max(kilometrage) ) ordinatePositions = c(innerOrdinatePosition,outerOrdinatePosition) myTempPlottingFunction = function(plotProperty,referenceKilometrageValues,simulationKilometrageValues,referenceValues,simulationValues,labelValue) { plotID = which( orderOfPlots == plotProperty, arr.ind=TRUE) if( length(plotID) == 1 ) { par(new=TRUE) currentOrdinateRange = range(unlist(c(referenceValues,simulationValues)),na.rm=TRUE) currentOrdinateDistance = max(currentOrdinateRange,na.rm=TRUE) - min(currentOrdinateRange,na.rm=TRUE) currentTotalOrdinateRange = c( ( min(currentOrdinateRange,na.rm=TRUE) - ( (length(orderOfPlots) - plotID) * currentOrdinateDistance) ), ( max(currentOrdinateRange,na.rm=TRUE) + ( (plotID - 1) * currentOrdinateDistance) ) ) plot(referenceKilometrageValues,referenceValues,type="n",xlim=xLimForPlots,ylim=currentTotalOrdinateRange,main="",axes=FALSE,xlab="",ylab="") currentOrdinatePosition = ordinatePositions[(1+(plotID%%2))] if(plotProperty == "eroDepo") { lines(range(kilometrage),rep(0.0,2),lty="dotted",lwd=tributaryLWD,col="black") points(positionsOfSillsInKM,rep(min(currentOrdinateRange,na.rm=TRUE),length(positionsOfSillsInKM)),pch="|",col=sillCOL) } if(plotID%%2) { currentMtextLine = primaryOrdinateLabelLine } else { currentMtextLine = secondaryOrdinateLabelLine } axis(2,at=pretty(currentOrdinateRange),pos=currentOrdinatePosition) mtext(labelValue,side=2,line=currentMtextLine,at=median(pretty(currentOrdinateRange)),adj=0.5,cex=plotFontSize) lines(referenceKilometrageValues,referenceValues,lwd=referenceLWD,lty=referenceLTY,col=referenceCOL) if(plotProperty != "channelWidth") { lines(simulationKilometrageValues,simulationValues,lwd=simulationLWD,lty=simulationLTY,col=simulationCOL) } } } myTempPlottingFunction("ABT",comparisonData$Kilometrage,kilometrage,comparisonData$ABTOverallVolume,finalABT,ABTLabel) rm(finalABT) myTempPlottingFunction("slope",kilometrage,kilometrage,initialSlopeInPercent,finalSlopeInPercent,slopeLabel) rm(initialSlopeInPercent,finalSlopeInPercent) myTempPlottingFunction("eroDepo",comparisonData$Kilometrage,kilometrageForElevationDifference,comparisonData$BedElevationChange,elevationDifference,bedElevationChangeLabel) rm(elevationDifference) myTempPlottingFunction("firstGS",kilometrage,kilometrage,initialFirstGrainSize,finalFirstGrainSize,firstGrainSizeLabel) rm(initialFirstGrainSize,finalFirstGrainSize) myTempPlottingFunction("secondGS",kilometrage,kilometrage,initialSecondGrainSize,finalSecondGrainSize,secondGrainSizeLabel) rm(initialSecondGrainSize,finalSecondGrainSize) myTempPlottingFunction("channelWidth",kilometrage,kilometrage,initialActiveWidth,initialActiveWidth,channelWidthLabel) rm(initialActiveWidth) } dev.off() rm(kilometrage) rm(positionsOfSillsInKM) } )# This is the end of the startButton handler enabled(startButton) = TRUE