'Insert and play audio clips based on a condition in shiny app
Objective
Create a shiny app for navigation on a road network. The app must play voice prompts using the audio clips at specified locations.
Problem
The insertUI and removeUI show the audio clips. But the app sometimes plays the same audio clip repeatedly and do not play other audio clips at all. How can I effectively use insertUI to play only the relevant audio clip and play it only once?
Data, code and audio files
All files are available to download here.
Simulated position data
The actual position data is obtained from a driving simulator. But for the sake of this reproducible example, I am simulating data in the simulate_driving_sim_data.R file. Following is the code:
library(dplyr)
load("pos_df.Rda")
names(pos_df) <- c("frames", "x", "y")
pos_df2 <- pos_df %>%
dplyr::slice(which(row_number() %% 100 == 1))
for (i in 1:nrow(pos_df2)){
dataa <- pos_df2[i,]
print(dataa)
write.csv(dataa, paste0("sampled", gsub("[^0-9]","",Sys.time()),".csv"),
row.names = FALSE)
Sys.sleep(1)
}
Shiny app
As the simulate_driving_sim_data.R file generates the data, I run the shiny app in another Rstudio session. The app code is in dashboard_New_v_demo.R, shown below. The section of the app relevant to this question is under ## Play the navigation audio clip.
library(shinydashboard)
library(ggplot2)
library(dplyr)
# Global------------------------------------------------------------------------
## Load the road network
load("df.Rda")
## Load the complex route
load(file = "pos_df.Rda")
## Load Music files
addResourcePath("Music", "Music")
# audio_file1 <- "Music/l1.mp3"
# audio_file2 <- "Music/l2.mp3"
# audio_file3 <- "Music/l3.mp3"
audio_file_200_TL <- "Music/in 200 m turn left.mp3"
audio_file_200_TR <- "Music/in 200 m turn right.mp3"
audio_file_TL <- "Music/turn left at the intersection.mp3"
audio_file_TR <- "Music/turn right at the intersection.mp3"
# User Interface ---------------------------------------------------------------
ui <- dashboardPage(skin = "black",
dashboardHeader(title = "Dashboard"),
dashboardSidebar(
sidebarMenu(
# menuItem("Music", tabName = "music", icon = icon("music")),
menuItem("Navigation", tabName = "navigation", icon = icon("compass"))
)),
dashboardBody(
tabItems(
# First tab content
tabItem(tabName = "navigation",
fluidRow(
tags$style(type="text/css", ".recalculating {opacity: 1.0;}"),
plotOutput("plot1")
),
fluidRow(
column(width = 8, valueBoxOutput("text"),tags$style("#text {width:600px;}")),
column(width = 2, imageOutput("myImage")),
tags$div(id = "AUDIO_MY")
)
)#,
# Second tab content
# tabItem(tabName = "music",
# h2("Music"),
# fluidRow(
# tags$audio(src = audio_file1, type = "audio/mp3", autoplay = NA, controls = TRUE)
# )
#
# )
)
)
)
# Server -----------------------------------------------------------------------
server <- function(input, output, session) {
## Get the simulated position data
IsThereNewFile=function(){ # cheap function whose values over time will be tested for equality;
# inequality indicates that the underlying value has changed and needs to be
# invalidated and re-read using valueFunc
filenames <- list.files(pattern="*.csv", full.names=TRUE)
length(filenames)
}
ReadAllData=function(){ # A function that calculates the underlying value
filenames <- list.files(pattern="*.csv", full.names=TRUE)
readr::read_csv(filenames[length(filenames)])
}
position <- reactivePoll(300, session,IsThereNewFile, ReadAllData)
## Plot
output$plot1 <- renderPlot({
### Get the zoomed-in surroundings of the position
xl1 <- position()$x - 500
xl2 <- position()$x + 500
yl1 <- position()$y - 300
yl2 <- position()$y + 300
ggplot() +
geom_path(data = df,
aes(x, -y,
group = interaction(elem_idx, path_idx)),
color = "grey50") +
geom_path(data = pos_df, mapping = aes(ED_x, ED_y),
color="skyblue", size = 2, alpha = 0.6) +
geom_point(data = position(),
aes(x, y),
fill = "#4285F4",
color = "white",
size = 5,
pch=21,
stroke = 3) +
coord_equal( xlim = c(xl1, xl2),
ylim = c(yl1, yl2)) +
theme_void()
})
## Generate a message
msg <- reactive({
if (position()$x > 34421.9 & position()$x < 35314.04 & position()$y < -2950 ) {
msg <- "In 200 m Turn left"
} else if (position()$x > 35936 & position()$x < 36004 & position()$y > 300 & position()$y < 986.373 ) {
msg <- "In 200 m Turn right"
} else if (position()$x > 37896 & position()$x < 38615) {
msg <- "Turn left at the intersection"
} else if (position()$x > 39120 & position()$x < 39336 & position()$y > 908 & position()$y < 2282.4727 ) {
msg <- "In 200 m Turn right"
} else if (position()$x > 39915 & position()$x < 40603.00 & position()$y > 2282 & position()$y < 2363) {
msg <- "Turn left at the intersection"
} else if (position()$y > 5530 & position()$y < 6261.8098) {
msg <- "Turn left and park in the parking lot"
} else {
msg <- ""
}
print(msg)
})
## Show the message
output$text <- renderValueBox({
valueBox(
value = tags$p(msg(), style = "font-size: 90%;"),
subtitle = "",
color = "light-blue",
width = NULL
)
})
## Show the image
output$myImage <- renderImage({
if (msg() %in% c("In 200 m Turn right")) {
return(
# Generate the PNG
list(src = "turn_right.png",
width = 100,
height = 100)
)
} else if (msg() %in% c("In 200 m Turn left",
"Turn left at the intersection",
"Turn left and park in the parking lot")) {
return(
# Generate the PNG
list(src = "turn_left.png",
width = 100,
height = 100)
)
} else {
return(
# Generate the PNG
list(src = "continue.png",
width = 100,
height = 100)
)
}
}, deleteFile=FALSE)
## Play the navigation audio clip
observeEvent(position(), {
if (position()$x > 34421.9 & position()$x < 34600) {
insertUI(selector = "#AUDIO_MY",
where = "afterEnd",
ui = tags$audio(src = audio_file_200_TL, type = "audio/mp3", autoplay = TRUE, controls = NA)
, immediate = TRUE)
} else if (position()$x > 35936 & position()$x < 36004 & position()$y > 300 & position()$y < 986.373) {
removeUI(selector = "#AUDIO_MY")
insertUI(selector = "#AUDIO_MY",
where = "afterEnd",
ui = tags$audio(src = audio_file_200_TR, type = "audio/mp3", autoplay = TRUE, controls = NA)
, immediate = TRUE)
} else if (position()$x > 37896 & position()$x < 38615 & position()$y < 935 & position()$y < 370) {
removeUI(selector = "#AUDIO_MY")
insertUI(selector = "#AUDIO_MY",
where = "afterEnd",
ui = tags$audio(src = audio_file_TL, type = "audio/mp3", autoplay = TRUE, controls = NA)
, immediate = TRUE)
} else if (position()$x > 39120 & position()$x < 39336 & position()$y > 908 & position()$y < 2282.4727) {
removeUI(selector = "#AUDIO_MY")
insertUI(selector = "#AUDIO_MY",
where = "afterEnd",
ui = tags$audio(src = audio_file_200_TR, type = "audio/mp3", autoplay = TRUE, controls = NA)
, immediate = TRUE)
} else if (position()$x > 39915 & position()$x < 40603.00 & position()$y > 2282 & position()$y < 2363) {
removeUI(selector = "#AUDIO_MY")
insertUI(selector = "#AUDIO_MY",
where = "afterEnd",
ui = tags$audio(src = audio_file_TL, type = "audio/mp3", autoplay = TRUE, controls = NA)
, immediate = TRUE)
} else if (position()$y > 5530 & position()$y < 6261.8098) {
removeUI(selector = "#AUDIO_MY")
insertUI(selector = "#AUDIO_MY",
where = "afterEnd",
ui = tags$audio(src = audio_file_TL, type = "audio/mp3", autoplay = TRUE, controls = NA)
, immediate = TRUE)
}
})
}
shinyApp(ui, server)
Demo app image
Sources
This article follows the attribution requirements of Stack Overflow and is licensed under CC BY-SA 3.0.
Source: Stack Overflow
| Solution | Source |
|---|