Skip to content

Commit 434fb89

Browse files
mcwimmmcwimm
committed
[uncert] update error handling
1 parent e16cbb5 commit 434fb89

File tree

3 files changed

+112
-62
lines changed

3 files changed

+112
-62
lines changed

‎R_scripts/functions/fun_graphics.R

+23-28
Original file line numberDiff line numberDiff line change
@@ -979,37 +979,32 @@ plot.twu.radialprofile = function(data, ui.input){
979979

980980
######## UNCERTAINTY ########
981981

982-
983982
plot.uncertainty = function(data, ui.input, absolute = T){
984-
985-
if (nrow(data) == 0 | sum(data$y) == 0){
986-
p = plot.emptyMessage("Plot not available.")
983+
data = data %>%
984+
mutate(error_x = (param.value-1)*100) %>%
985+
mutate(parameter = factor(parameter,
986+
levels = c("D", "Z", "L", "k"),
987+
labels = c("Dnom", "Zax/Ztg", "Lsw", "k")))
988+
if (!absolute){
989+
data$y = data$y_ref
990+
y_lab = paste("Error in", ui.input$uncert_y, "(%)", sep = " ")
987991
} else {
988-
data = data %>%
989-
mutate(error_x = (param.value-1)*100) %>%
990-
mutate(parameter = factor(parameter,
991-
levels = c("D", "Z", "L", "k"),
992-
labels = c("Dnom", "Zax/Ztg", "Lsw", "k")))
993-
if (!absolute){
994-
data$y = data$y_ref
995-
y_lab = paste("Error in", ui.input$uncert_y, "(%)", sep = " ")
996-
} else {
997-
y_lab = labels[[ui.input$uncert_y]]
998-
}
999-
p = data %>%
1000-
ggplot(., aes(x = error_x, y = y,
1001-
shape = parameter, linetype = parameter,
1002-
group = parameter, col = parameter)) +
1003-
geom_hline(yintercept = 0, alpha = 0.5) +
1004-
geom_vline(xintercept = 0, alpha = 0.5) +
1005-
geom_point(size = 2) +
1006-
geom_line() +
1007-
labs(x = "Error in parameter (%)",
1008-
y = y_lab,
1009-
col = "Parameter",
1010-
shape = "Parameter",
1011-
linetype = "Parameter")
992+
y_lab = labels[[ui.input$uncert_y]]
1012993
}
994+
p = data %>%
995+
ggplot(., aes(x = error_x, y = y,
996+
shape = parameter, linetype = parameter,
997+
group = parameter, col = parameter)) +
998+
geom_hline(yintercept = 0, alpha = 0.5) +
999+
geom_vline(xintercept = 0, alpha = 0.5) +
1000+
geom_point(size = 2) +
1001+
geom_line() +
1002+
labs(x = "Error in parameter (%)",
1003+
y = y_lab,
1004+
col = "Parameter",
1005+
shape = "Parameter",
1006+
linetype = "Parameter")
1007+
10131008
return(p)
10141009
}
10151010

‎R_scripts/functions/fun_uncertainty.R

+9-3
Original file line numberDiff line numberDiff line change
@@ -111,18 +111,22 @@ get.uncertainty = function(data, depths, ui.input){
111111
df_uncert = df_uncert %>%
112112
mutate(y_ref = (y - ref[[1]])/ref[[1]] * 100)
113113

114-
115-
return(df_uncert)
114+
if (sum(df_uncert$y == 0) | nrow(df_uncert) == 0){
115+
return(NULL)
116+
} else {
117+
return(df_uncert)
118+
}
116119
}
117120

118121

119122
get.uncertTable <- function(values, uncertaintyValues, absolute=T){
120-
if (!is.null(values$kvalues)){
123+
if (!is.null(uncertaintyValues)){
121124
uncert = uncertaintyValues
122125
if (!absolute){
123126
uncert$y = uncert$y_ref
124127
}
125128
uncert$y_ref = NULL
129+
126130
if (nrow(uncert) > 0 & sum(uncert$y) != 0){
127131
if ("L" %in% uncert$parameter){
128132
return(uncert %>%
@@ -146,6 +150,8 @@ get.uncertTable <- function(values, uncertaintyValues, absolute=T){
146150
)
147151
}
148152
}
153+
} else {
154+
return(NULL)
149155
}
150156
}
151157

‎server.R

+80-31
Original file line numberDiff line numberDiff line change
@@ -1383,12 +1383,21 @@ shinyServer(function(input, output, session) {
13831383

13841384

13851385
uncertaintyValues <- reactive({
1386-
data = sapFlowDens()
1387-
return(get.uncertainty(
1388-
data = data,
1389-
depths = depths(),
1390-
ui.input = input
1391-
))
1386+
tryCatch({
1387+
data = sapFlowDens()
1388+
return(get.uncertainty(
1389+
data = data,
1390+
depths = depths(),
1391+
ui.input = input
1392+
))
1393+
},
1394+
error = function(e) {
1395+
an.error.occured <<- TRUE
1396+
})
1397+
1398+
if (an.error.occured) {
1399+
return(NULL)
1400+
}
13921401
})
13931402

13941403

@@ -1397,12 +1406,18 @@ shinyServer(function(input, output, session) {
13971406
#' Reactive variable holding the plot showing customized
13981407
#' temperature visualizations
13991408
uncertaintyPlot <- function(absolute){
1400-
if (is.null(values$kvalues)){
1401-
plot.emptyMessage("Plot not available.")
1409+
data = uncertaintyValues()
1410+
1411+
if (is.null(data)){
1412+
plot.emptyMessage(message.no.preview)
14021413
} else {
1403-
plot.uncertainty(data = uncertaintyValues(),
1404-
ui.input = input,
1405-
absolute = absolute)
1414+
if (nrow(data) == 0 | sum(data$y) == 0){
1415+
p = plot.emptyMessage(message.no.preview)
1416+
} else {
1417+
plot.uncertainty(data = data,
1418+
ui.input = input,
1419+
absolute = absolute)
1420+
}
14061421
}
14071422
}
14081423

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

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

14551470
output$uncertaintyOutputs <- DT::renderDataTable(rownames = FALSE, {
1456-
get.uncertTable(values, uncertaintyValues())
1471+
tab = get.uncertTable(values, uncertaintyValues())
1472+
1473+
if (is.null(tab)){
1474+
tab.with.message(message = message.no.preview)
1475+
} else {
1476+
tab
1477+
}
14571478
}, options = list(dom = "t"))
14581479

14591480

14601481
output$uncertaintyOutputsRel <- DT::renderDataTable(rownames = FALSE, {
1461-
get.uncertTable(values, uncertaintyValues(), absolute = F)
1482+
tab = get.uncertTable(values = values,
1483+
uncertaintyValues = uncertaintyValues(),
1484+
absolute = F)
1485+
if (is.null(tab)){
1486+
tab.with.message(message = message.no.preview)
1487+
} else {
1488+
tab
1489+
}
14621490
}, options = list(dom = "t"))
14631491

14641492

@@ -1524,29 +1552,50 @@ shinyServer(function(input, output, session) {
15241552
#### Variables ####
15251553

15261554
uncertaintyValuesCumSF <- function(){
1527-
data = sapFlowDens()
1528-
data = get.uncertaintyCumSF(
1529-
data = data,
1530-
depths = depths(),
1531-
ui.input = input
1532-
)
1533-
return(data)
1555+
tryCatch({
1556+
data = sapFlowDens()
1557+
data = get.uncertaintyCumSF(
1558+
data = data,
1559+
depths = depths(),
1560+
ui.input = input
1561+
)
1562+
if (sum(data$y) == 0){
1563+
return(NULL)
1564+
} else {
1565+
return(data)
1566+
}
1567+
},
1568+
error = function(e) {
1569+
an.error.occured <<- TRUE
1570+
})
1571+
if (an.error.occured) {
1572+
return(NULL)
1573+
}
15341574
}
15351575

15361576
uncertaintyValuesCumTWU <- function(){
1537-
df_uncert = uncertaintyValuesCumSF()
1538-
data = get.uncertaintyCumTWU(df_uncert = df_uncert)
1539-
return(data)
1577+
tryCatch({
1578+
df_uncert = uncertaintyValuesCumSF()
1579+
data = get.uncertaintyCumTWU(df_uncert = df_uncert)
1580+
return(data)
1581+
},
1582+
error = function(e) {
1583+
an.error.occured <<- TRUE
1584+
})
1585+
if (an.error.occured) {
1586+
return(NULL)
1587+
}
15401588
}
15411589
#### Graphics ####
15421590

15431591
#' Reactive variable holding the plot showing customized
15441592
#' temperature visualizations
15451593
uncertaintyPlotCumSF <- function(){
1546-
if (is.null(values$kvalues)){
1547-
plot.emptyMessage("Plot not available.")
1594+
uncertaintyValuesCumSF = uncertaintyValuesCumSF()
1595+
if (is.null(uncertaintyValuesCumSF)){
1596+
plot.emptyMessage(message.no.preview)
15481597
} else {
1549-
plot.uncertaintyCumSF(data = uncertaintyValuesCumSF())
1598+
plot.uncertaintyCumSF(data = uncertaintyValuesCumSF)
15501599
}
15511600
}
15521601

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

15571606

15581607
uncertaintyPlotCumTWU <- function(){
1559-
if (is.null(values$kvalues)){
1560-
plot.emptyMessage("Plot not available.")
1608+
uncertaintyValuesCumTWU = uncertaintyValuesCumTWU()
1609+
if (is.null(uncertaintyValuesCumTWU)){
1610+
plot.emptyMessage(message.no.preview)
15611611
} else {
1562-
data = uncertaintyValuesCumTWU()
1563-
plot.uncertaintyCumTWU(data = data)
1612+
plot.uncertaintyCumTWU(data = uncertaintyValuesCumTWU)
15641613
}
15651614
}
15661615

0 commit comments

Comments
 (0)