Calculating eucledian distance inside reactive dataframe in shiny - r

Question

I am trying to do some transformation to the reactive dataframe in shiny. I want to use the function euc.dist to the reactive dataframe bathy_new() in the code below.
Here is the reproducible example:
library(shiny)
ui <- fluidRow(
numericInput(inputId = "n", "Group ", value = 1),
plotOutput(outputId = "plot")
)
server <- function(input, output){
bathy <- structure(list(`Corrected Time` = structure(c(
1512040500, 1512040500,
1512040501, 1512040502, 1512040502, 1512040503
), class = c(
"POSIXct",
"POSIXt"
), tzone = "UTC"), Longitude = c(
-87.169858, -87.169858,
-87.1698618, -87.1698652, -87.1698652, -87.16986785
), Latitude = c(
33.7578743,
33.7578743, 33.75788237, 33.75789018, 33.75789018, 33.75789717
), `Depth (m)` = c(
3.95096, 3.82296, 3.63096, 3.57096, 3.48096,
3.32096
), easting = c(
484269.60819222, 484269.60819222, 484269.257751374,
484268.944306767, 484268.944306767, 484268.700169299
), northing = c(
3735323.04565401,
3735323.04565401, 3735323.94098565, 3735324.80742908, 3735324.80742908,
3735325.58284154
), diff = c(0, 0, 0, 0, 0, 0), group = c(
1, 1,
1, 2, 2, 2
)), .Names = c(
"Corrected Time", "Longitude", "Latitude",
"Depth (m)", "easting", "northing", "diff", "group"
), row.names = c(
NA,
-6L
), class = c("tbl_df", "tbl", "data.frame"))
euc.dist <- function(x1, y1, x2, y2){
distance <- sqrt((x2-x1)^2 + (y2-y1)^2)
return(distance)
}
#
bathy_new <- reactive({
bathy %>% dplyr::filter(group == input$n)
})
test <- bathy_new()
dist <- NULL
for (i in 1:nrow(test)){
dist <- euc.dist(x1 = test[i, "easting"] %>% .$easting,
y1 = test[i, "northing"] %>% .$northing,
x2 = test[i+1, 'easting'] %>% .$easting,
y2 = test[i+1, 'northing'] %>% .$northing)
}
test$dist <- dist
output$plot <- renderPlot(
qplot(cumsum(test$dist), bathy_new()$`Depth (m)`)
)
}
shinyApp(ui, server)
The data here is very small data compared to my original set. But the goal is to find eucledian distance between points in each group. In this small dataset, I have 2 groups ; 1 and 2.
I keep getting the following error
Error in .getReactiveEnvironment()$currentContext() :
Operation not allowed without an active reactive context. (You tried to do something that can only be done from inside a reactive expression or observer.)
I can run this code outside of shiny just fine but not sure how to deal with reactive data.
This is the chunk of code where there is error:
test <- bathy_new()
dist <- NULL
for (i in 1:nrow(test)){
dist <- euc.dist(x1 = test[i, "easting"] %>% .$easting,
y1 = test[i, "northing"] %>% .$northing,
x2 = test[i+1, 'easting'] %>% .$easting,
y2 = test[i+1, 'northing'] %>% .$northing)
}
test$dist <- dist
Eventually, I want to plot cumulative distance cum(dist) and depth Depth (m).

Answer 1

The reason you're getting that error is because you actually tried to assign a reactive to the variable test. This can only be done from inside a reactive expression or observer.
So what you need to do is to place that code inside of a reactive expression, such as renderPlot.
output$plot <- renderPlot({
test <- bathy_new()
dist <- NULL
for (i in 1:(nrow(test) - 1)){
dist <- euc.dist(x1 = test[i, "easting"] %>% .$easting,
y1 = test[i, "northing"] %>% .$northing,
x2 = test[i+1, 'easting'] %>% .$easting,
y2 = test[i+1, 'northing'] %>% .$northing)
}
test$dist <- dist
qplot(cumsum(test$dist), bathy_new()$`Depth (m)`)
})
This should get rid of the error, however I think you may have some trouble with your for loop as well. You iterate through 1:nrow(test) but you calculate with i+1 inside the loop. Because of this dist is going to be NA and thus your plot will not show anything.
I modified your loop to iterate through 1:(nrow(test) - 1) in order to get valid results.
I would also like to point out the way Shiny works. Shiny runs code outside of the server function once per R process, then runs code inside the server function once per connection. And then there are reactives which run every time their dependency changes.
See this topic for more help
So it is better to define data and functions outside of the server function, since they only need to run once. If they are inside the server function they are ran every single time a new user is connected to the app which works but it is not efficient.
Full code:
library(shiny)
library(magrittr)
library(ggplot2)
bathy <- structure(list(`Corrected Time` = structure(c(
1512040500, 1512040500,
1512040501, 1512040502, 1512040502, 1512040503
), class = c(
"POSIXct",
"POSIXt"
), tzone = "UTC"), Longitude = c(
-87.169858, -87.169858,
-87.1698618, -87.1698652, -87.1698652, -87.16986785
), Latitude = c(
33.7578743,
33.7578743, 33.75788237, 33.75789018, 33.75789018, 33.75789717
), `Depth (m)` = c(
3.95096, 3.82296, 3.63096, 3.57096, 3.48096,
3.32096
), easting = c(
484269.60819222, 484269.60819222, 484269.257751374,
484268.944306767, 484268.944306767, 484268.700169299
), northing = c(
3735323.04565401,
3735323.04565401, 3735323.94098565, 3735324.80742908, 3735324.80742908,
3735325.58284154
), diff = c(0, 0, 0, 0, 0, 0), group = c(
1, 1,
1, 2, 2, 2
)), .Names = c(
"Corrected Time", "Longitude", "Latitude",
"Depth (m)", "easting", "northing", "diff", "group"
), row.names = c(
NA,
-6L
), class = c("tbl_df", "tbl", "data.frame"))
euc.dist <- function(x1, y1, x2, y2){
distance <- sqrt((x2-x1)^2 + (y2-y1)^2)
return(distance)
}
ui <- fluidRow(
numericInput(inputId = "n", "Group ", value = 1),
plotOutput(outputId = "plot")
)
server <- function(input, output){
bathy_new <- reactive({
bathy %>% dplyr::filter(group == input$n)
})
output$plot <- renderPlot({
test <- bathy_new()
dist <- NULL
for (i in 1:(nrow(test) - 1)){
dist <- euc.dist(x1 = test[i, "easting"] %>% .$easting,
y1 = test[i, "northing"] %>% .$northing,
x2 = test[i+1, 'easting'] %>% .$easting,
y2 = test[i+1, 'northing'] %>% .$northing)
}
test$dist <- dist
qplot(cumsum(test$dist), bathy_new()$`Depth (m)`)
})
}
shinyApp(ui, server)