Commit 79a5968c authored by gross47's avatar gross47
Browse files

implement uncertainty choice

parent 8108f5e0
#### 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)
}
No preview for this file type
No preview for this file type
......@@ -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
......@@ -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]))
......
......@@ -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")
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment