Skip to content

Commit

Permalink
[uncert] update error handling
Browse files Browse the repository at this point in the history
  • Loading branch information
@mcwimm
mcwimm committed Nov 17, 2023
1 parent e16cbb5 commit 434fb89
Show file tree
Hide file tree
Showing 3 changed files with 112 additions and 62 deletions.
51 changes: 23 additions & 28 deletions R_scripts/functions/fun_graphics.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -979,37 +979,32 @@ plot.twu.radialprofile = function(data, ui.input){

######## UNCERTAINTY ########


plot.uncertainty = function(data, ui.input, absolute = T){

if (nrow(data) == 0 | sum(data$y) == 0){
p = plot.emptyMessage("Plot not available.")
data = data %>%
mutate(error_x = (param.value-1)*100) %>%
mutate(parameter = factor(parameter,
levels = c("D", "Z", "L", "k"),
labels = c("Dnom", "Zax/Ztg", "Lsw", "k")))
if (!absolute){
data$y = data$y_ref
y_lab = paste("Error in", ui.input$uncert_y, "(%)", sep = " ")
} else {
data = data %>%
mutate(error_x = (param.value-1)*100) %>%
mutate(parameter = factor(parameter,
levels = c("D", "Z", "L", "k"),
labels = c("Dnom", "Zax/Ztg", "Lsw", "k")))
if (!absolute){
data$y = data$y_ref
y_lab = paste("Error in", ui.input$uncert_y, "(%)", sep = " ")
} else {
y_lab = labels[[ui.input$uncert_y]]
}
p = data %>%
ggplot(., aes(x = error_x, y = y,
shape = parameter, linetype = parameter,
group = parameter, col = parameter)) +
geom_hline(yintercept = 0, alpha = 0.5) +
geom_vline(xintercept = 0, alpha = 0.5) +
geom_point(size = 2) +
geom_line() +
labs(x = "Error in parameter (%)",
y = y_lab,
col = "Parameter",
shape = "Parameter",
linetype = "Parameter")
y_lab = labels[[ui.input$uncert_y]]
}
p = data %>%
ggplot(., aes(x = error_x, y = y,
shape = parameter, linetype = parameter,
group = parameter, col = parameter)) +
geom_hline(yintercept = 0, alpha = 0.5) +
geom_vline(xintercept = 0, alpha = 0.5) +
geom_point(size = 2) +
geom_line() +
labs(x = "Error in parameter (%)",
y = y_lab,
col = "Parameter",
shape = "Parameter",
linetype = "Parameter")

return(p)
}

Expand Down
12 changes: 9 additions & 3 deletions R_scripts/functions/fun_uncertainty.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -111,18 +111,22 @@ get.uncertainty = function(data, depths, ui.input){
df_uncert = df_uncert %>%
mutate(y_ref = (y - ref[[1]])/ref[[1]] * 100)


return(df_uncert)
if (sum(df_uncert$y == 0) | nrow(df_uncert) == 0){
return(NULL)
} else {
return(df_uncert)
}
}


get.uncertTable <- function(values, uncertaintyValues, absolute=T){
if (!is.null(values$kvalues)){
if (!is.null(uncertaintyValues)){
uncert = uncertaintyValues
if (!absolute){
uncert$y = uncert$y_ref
}
uncert$y_ref = NULL

if (nrow(uncert) > 0 & sum(uncert$y) != 0){
if ("L" %in% uncert$parameter){
return(uncert %>%
Expand All @@ -146,6 +150,8 @@ get.uncertTable <- function(values, uncertaintyValues, absolute=T){
)
}
}
} else {
return(NULL)
}
}

Expand Down
111 changes: 80 additions & 31 deletions server.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -1383,12 +1383,21 @@ shinyServer(function(input, output, session) {


uncertaintyValues <- reactive({
data = sapFlowDens()
return(get.uncertainty(
data = data,
depths = depths(),
ui.input = input
))
tryCatch({
data = sapFlowDens()
return(get.uncertainty(
data = data,
depths = depths(),
ui.input = input
))
},
error = function(e) {
an.error.occured <<- TRUE
})

if (an.error.occured) {
return(NULL)
}
})


Expand All @@ -1397,12 +1406,18 @@ shinyServer(function(input, output, session) {
#' Reactive variable holding the plot showing customized
#' temperature visualizations
uncertaintyPlot <- function(absolute){
if (is.null(values$kvalues)){
plot.emptyMessage("Plot not available.")
data = uncertaintyValues()

if (is.null(data)){
plot.emptyMessage(message.no.preview)
} else {
plot.uncertainty(data = uncertaintyValues(),
ui.input = input,
absolute = absolute)
if (nrow(data) == 0 | sum(data$y) == 0){
p = plot.emptyMessage(message.no.preview)
} else {
plot.uncertainty(data = data,
ui.input = input,
absolute = absolute)
}
}
}

Expand All @@ -1419,7 +1434,7 @@ shinyServer(function(input, output, session) {
#### Text #####

output$uncertaintyInputs <- renderText({
if (!is.null(values$kvalues)){
if (!is.null(values$kvalues) & all(!is.na(values$kvalues$k))){
data = sapFlowDens()
if ("SFDsw" %in% colnames(data)){
data$swd = data$SFS / data$SFDsw
Expand Down Expand Up @@ -1453,12 +1468,25 @@ shinyServer(function(input, output, session) {
#### Table #####

output$uncertaintyOutputs <- DT::renderDataTable(rownames = FALSE, {
get.uncertTable(values, uncertaintyValues())
tab = get.uncertTable(values, uncertaintyValues())

if (is.null(tab)){
tab.with.message(message = message.no.preview)
} else {
tab
}
}, options = list(dom = "t"))


output$uncertaintyOutputsRel <- DT::renderDataTable(rownames = FALSE, {
get.uncertTable(values, uncertaintyValues(), absolute = F)
tab = get.uncertTable(values = values,
uncertaintyValues = uncertaintyValues(),
absolute = F)
if (is.null(tab)){
tab.with.message(message = message.no.preview)
} else {
tab
}
}, options = list(dom = "t"))


Expand Down Expand Up @@ -1524,29 +1552,50 @@ shinyServer(function(input, output, session) {
#### Variables ####

uncertaintyValuesCumSF <- function(){
data = sapFlowDens()
data = get.uncertaintyCumSF(
data = data,
depths = depths(),
ui.input = input
)
return(data)
tryCatch({
data = sapFlowDens()
data = get.uncertaintyCumSF(
data = data,
depths = depths(),
ui.input = input
)
if (sum(data$y) == 0){
return(NULL)
} else {
return(data)
}
},
error = function(e) {
an.error.occured <<- TRUE
})
if (an.error.occured) {
return(NULL)
}
}

uncertaintyValuesCumTWU <- function(){
df_uncert = uncertaintyValuesCumSF()
data = get.uncertaintyCumTWU(df_uncert = df_uncert)
return(data)
tryCatch({
df_uncert = uncertaintyValuesCumSF()
data = get.uncertaintyCumTWU(df_uncert = df_uncert)
return(data)
},
error = function(e) {
an.error.occured <<- TRUE
})
if (an.error.occured) {
return(NULL)
}
}
#### Graphics ####

#' Reactive variable holding the plot showing customized
#' temperature visualizations
uncertaintyPlotCumSF <- function(){
if (is.null(values$kvalues)){
plot.emptyMessage("Plot not available.")
uncertaintyValuesCumSF = uncertaintyValuesCumSF()
if (is.null(uncertaintyValuesCumSF)){
plot.emptyMessage(message.no.preview)
} else {
plot.uncertaintyCumSF(data = uncertaintyValuesCumSF())
plot.uncertaintyCumSF(data = uncertaintyValuesCumSF)
}
}

Expand All @@ -1556,11 +1605,11 @@ shinyServer(function(input, output, session) {


uncertaintyPlotCumTWU <- function(){
if (is.null(values$kvalues)){
plot.emptyMessage("Plot not available.")
uncertaintyValuesCumTWU = uncertaintyValuesCumTWU()
if (is.null(uncertaintyValuesCumTWU)){
plot.emptyMessage(message.no.preview)
} else {
data = uncertaintyValuesCumTWU()
plot.uncertaintyCumTWU(data = data)
plot.uncertaintyCumTWU(data = uncertaintyValuesCumTWU)
}
}

Expand Down

0 comments on commit 434fb89

Please sign in to comment.