implement uncertainty choice

dataPreparation.R

-#### Excel-Manipulation function ####
+##--##################--##
+#### Data preparation ####
+##--##################--##
 
-library(readxl)
-library(tidyverse)
+# Tue Oct 13 15:41:41 2020 ------------------------------
 
 
+#' Preparation of the data for the robust optimization
+#'
+#'
+#' @param dat Untransformed data table as shown in the example.
+#' @param uncertainty Indicates whether the uncertainty shall be repesented by SE or SD. Please be aware that the respective chosen uncertainty must be included in the data. Best would be to consider the format of the exemplary data (database.xlsx) in the GitLab.
+#' @return An initialized landUse object ready for initScenario.
+
+
+#' @import dplyr
+
+#' @export
 dataPreparation <- function(dat, uncertainty = "SE", expVAL = "mean"){   #added expected value
-  
-  ## Convert input Data to dat.final ## 
-  ## Filter all Rows with only NA ##
-  dat.final <- dat[rowSums(is.na(dat)) != ncol(dat), ] 
-  if(any(is.na(dat.final[, 1]))){dat.final <- dat.final[-1, ]}
-  
-  ## Create column names ##
-  colnames(dat.final) <- dat.final[1, ]
-  dat.final <- dat.final[-1, ]
-  
-  ## rename duplicated Columnnames ##
-  names(dat.final) <- make.unique(colnames(dat.final))
-  
-  ## detect and set classes of a dat.final
-  dat.final <- lapply(dat.final, type.convert) %>% bind_cols()
-  
-  ## rename first columns for initScenario function and define data structure ##
-  chtr.cols <- unlist(lapply(dat.final[1,],is.numeric))
-  chtr.cols <- length(chtr.cols[chtr.cols == FALSE])
-  dat.final[, (chtr.cols+1):ncol(dat.final)][is.na(dat.final[, (chtr.cols+1):ncol(dat.final)])] <- 0
-  
-  ## warn and delete factor rows with NA ##
-  if(any(is.na(dat.final[, 1:chtr.cols]))){warning("Some Indicators have missing value, rows got deleted")}
-  # which(is.na(dat.final[, 1:chtr.cols]), arr.ind = TRUE)
-  dat.final <- na.omit(dat.final)
-  
-  ## select landUse names ##
-  landUse <- dat[1, ]
-  landUse <- landUse[, colSums(is.na(landUse)) != nrow(landUse)]
-  colnames(landUse) <- landUse[1, ]
-  landUse <- landUse[-1, ]
-  landUse <- names(landUse)
-  
-  ## select mean values, rename columns and gather ##
-  importValues <- dat.final %>% select((1:chtr.cols), starts_with(expVAL))
-  colnames(importValues)[grepl(expVAL, colnames(importValues))] <- landUse
-  importValues <- importValues %>%  gather(key = "landUse", value = "indicatorValue", landUse[1]:landUse[length(landUse)])
-  
-  ## select uncertainty, rename columns and gather ##
-  importUnc <- dat.final %>% select((1:chtr.cols), starts_with(uncertainty))
-  colnames(importUnc)[grepl(uncertainty, colnames(importUnc))] <- landUse
-  importUnc <- importUnc %>%  gather(key = "landUse", value = "indicatorUncertainty", landUse[1]:landUse[length(landUse)])
-  
-  ## combine mean and uncertainty ##
-  dataSource <- left_join(importValues, importUnc, by = c(names(dat.final)[1:chtr.cols], "landUse"))
-  return(dataSource)
-}
 
+    ## Convert input Data to dat.final ## 
+    ## Filter all Rows with only NA ##
+    dat.final <- dat[rowSums(is.na(dat)) != ncol(dat), ] 
+    if(any(is.na(dat.final[, 1]))){dat.final <- dat.final[-1, ]}
+    
+    ## Create column names ##
+    colnames(dat.final) <- dat.final[1, ]
+    dat.final <- dat.final[-1, ]
+    
+    ## rename duplicated Columnnames ##
+    names(dat.final) <- make.unique(colnames(dat.final))
+    
+    ## detect and set classes of a dat.final
+    dat.final <- lapply(dat.final, type.convert) %>% bind_cols()
+    
+    ## rename first columns for initScenario function and define data structure ##
+    chtr.cols <- unlist(lapply(dat.final[1,],is.numeric))
+    chtr.cols <- length(chtr.cols[chtr.cols == FALSE])
+    dat.final[, (chtr.cols+1):ncol(dat.final)][is.na(dat.final[, (chtr.cols+1):ncol(dat.final)])] <- 0
+    
+    ## warn and delete factor rows with NA ##
+    if(any(is.na(dat.final[, 1:chtr.cols]))){warning("Some Indicators have missing value, rows got deleted")}
+    # which(is.na(dat.final[, 1:chtr.cols]), arr.ind = TRUE)
+    dat.final <- na.omit(dat.final)
+    
+    ## select landUse names ##
+    landUse <- dat[1, ]
+    landUse <- landUse[, colSums(is.na(landUse)) != nrow(landUse)]
+    colnames(landUse) <- landUse[1, ]
+    landUse <- landUse[-1, ]
+    landUse <- names(landUse)
+
+    ## select mean values, rename columns and gather ##
+    importValues <- dat.final %>% select((1:chtr.cols), starts_with(expVAL))
+    colnames(importValues)[grepl(expVAL, colnames(importValues))] <- landUse
+    importValues <- importValues %>%  gather(key = "landUse", value = "indicatorValue", landUse[1]:landUse[length(landUse)])
 
+    ## select uncertainty, rename columns and gather ##
+    importUnc <- dat.final %>% select((1:chtr.cols), starts_with(uncertainty))
+    colnames(importUnc)[grepl(uncertainty, colnames(importUnc))] <- landUse
+    importUnc <- importUnc %>%  gather(key = "landUse", value = "indicatorUncertainty", landUse[1]:landUse[length(landUse)])
 
+    ## combine mean and uncertainty ##
+    dataSource <- left_join(importValues, importUnc, by = c(names(dat.final)[1:chtr.cols], "landUse"))
+  return(dataSource)
+}

rsconnect/shinyapps.io/vongross/optimlanduse_shiny.dcf

@@ -5,6 +5,6 @@ account: vongross
 server: shinyapps.io
 hostUrl: https://api.shinyapps.io/v1
 appId: 3090351
-bundleId: 3788788
+bundleId: 3837173
 url: https://vongross.shinyapps.io/optimlanduse_shiny/
-when: 1603821594.65331
+when: 1604919755.14113

server.R

@@ -35,9 +35,7 @@ server <- function(input, output, session) {
     
     df <- read_excel(inFile$datapath, col_names = input$colnames)
     
-    df <- dataPreparation(df, uncertainty = "sd")
-    
-    df <- df %>% filter(branch == "Ecology" | branch == "Economics")
+    df <- dataPreparation(df, uncertainty = input$uncertainty)
     
     updateCheckboxGroupInput(session, inputId = "IndicatorGroups", label = "IndicatorGroups", unique(df$indicatorGroup),
                       selected = unique(df$indicatorGroup[1]))

ui.R

@@ -127,6 +127,8 @@ ui <- navbarPage(title = img(src="Logo_TUM_GOE.jpg", height = "40px", width = "2
                               fileInput("file1", "Choose xlsx file", accept = ".xlsx"),
                               tags$br(),
                               checkboxInput('colnames', 'Colnames (experimental)', FALSE),
+                              selectInput("uncertainty", "Choose your uncertainty",
+                                          choices = c("sd", "SE")),
                               h5("The file used for upload must be of type xlsx. This file must also correspond to a certain structure 
                                  for further processing. You can find an example data named database.xlsx by clicking the following link:"),
                               tags$a(h5("ExampleData"), href = "https://gitlab.gwdg.de/forest_economics_goettingen/optimlanduse_shiny")