R Shiny Sounds Upon Selection

Hello,

I would like to play an mp3 (or wav) file whenever a selection is changed on my Shiny app.
https://flachboard84.shinyapps.io/stockmarketv2/

I've tried using the tags$audio functionality, but nothing seems to play.
https://groups.google.com/g/shiny-discuss/c/zO8hEFCxa0c/m/9B5DlfuVVb8J

Does anyone know if this is possible?

Played around with this before, it might help you.

Hi!
I don't know how you are implementing the reactivitity in your app, but assuming that there's no problem with that, two things come to mind:

  • Is your mp3 file in the app's /www/ folder? If not, try that.

  • You may wanna try Howler, a great JS library for audio that can be plugged into Shiny using shinyjs::runjs.

    • After installing Howler (i.e., having howler.js in your www/ folder), you could have music triggering inside a shiny::observeEvent like this:
      shinyjs::runjs("var music = new Howl({src: ['your_file.mp3']}); music.play();")
    • If you try this, don't forget to add useShinyjs() in your UI (as stated here).

Hope this helps!


This post was published by an Appsilon team member. Our company can help you get the most out of RShiny and Posit/RStudio products.

Check our open positions here.

Appsilon: Building impactful RShiny Dashboards and providing R coding services.
Appsilon_GIFsmall_whitebg

Hello! Thanks for replying. I do have the mp3 file in my www folder.

Will I be able to use the JS Howler package on the R server?

Sure. In fact, in my example above, the observeEvent should be in the server side (did you mean the app server function when you said the R server?).


This post was published by an Appsilon team member. Our company can help you get the most out of RShiny and Posit/RStudio products.

Check our open positions here.

Appsilon: Building impactful RShiny Dashboards and providing R coding services.
Appsilon_GIFsmall_whitebg

I was referring to the public R server.

I am not sure if I understand what you mean.

Nonetheless, if you have the 'howler.js' file (for most basic applications, as just playing a music file, this should suffice) in your app's www/ folder, it should work regardless of where you deploy the app.

One thing I missed earlier is that you should also call shiny::includeScript('www/howler.js) in your UI (aside from the useShinyjs() call).

Good luck!


This post was published by an Appsilon team member. Our company can help you get the most out of RShiny and Posit/RStudio products.

Check our open positions here.

Appsilon: Building impactful RShiny Dashboards and providing R coding services.
Appsilon_GIFsmall_whitebg

I'm not strong in Java, so I apologize for my ignorance there. Do you have a sample code per chance? I'm not getting it to work.

Code below...

#Packages
library(BatchGetSymbols)
library(bslib)
library(dashboardthemes)
library(data.table)
library(DT)
library(forecast)
library(lubridate)
library(pacman)
library(plotly)
library(progress)
library(prophet)
library(qrmdata)
library(quantmod)
library(RCurl)
library(rsconnect)
library(rstan)
library(shiny)
library(shinyjs)
library(shinythemes)
library(sysfonts)
library(thematic)
library(tibble)
library(tidymodels)
library(tidyquant)
library(tidyverse)
library(timeSeries)
library(timetk)
library(tseries)
library(TTR)
library(xts)

#Plotly Colors
blue <- "#1f77b4"
orange <- "#ff7f0e"
green <- "#2ca02c"
red <- "#d62728"
purple <- "#9467bd"
brown <- "#8c564b"

#Pastel Colors
tranquil <- "#E0FEFE"
periwinkle <- "#C7CEEA"
negroni <- "#FFDAC1"
salmon <- "#FF9AA2"
cumulus <- "#FFFFD8"
cruise <- "#B5EAD7"

#Fading Ec*s Palette
fading_palette <- c("#a94a37", "#33434a", "#ebd2c7", "#eeb06d", "#cb794e", "#f4f8f3", "#89ae90")

#Theme
theme <- bs_theme(version=4, bg = fading_palette[2], fg=fading_palette[3], primary = fading_palette[5], secondary = fading_palette[6], base_font = font_google("Montserrat"))
thematic::thematic_shiny(font="auto")

#Read Stocks
batch_symbols <- fread("./Data/stock_list.csv")

#Stock List
stock_list <- batch_symbols$ticker

#Most Recent Business Day
prev_bus_day <- getSymbols("AAPL", from = Sys.Date()-5, to = Sys.Date(), auto.assign = F) %>%
    fortify() %>%
    slice(n()) %>%
    magrittr::extract2("Index")

#Previous Business Day Delta
gain_lose <- fread("./Data/gain_lose.csv")

#Insider Purchases
purch_df <- fread("./Data/purch_df.csv")

#Insider Sales
sales_df <- fread("./Data/sales_df.csv")

#Quarter Over Quarter
net_inc_qtr <- fread("./Data/net_inc_qtr.csv")

############################## User Interface ##############################
ui <- fluidPage(
    #Java
    useShinyjs(),
    shiny::includeScript("www/howler.js")
    #Theme
    theme = theme,
    #Title
    titlePanel("Stock Market"),
    #Tabset
    tabsetPanel(
        #Tab Home
        tabPanel(icon("home"),
            fluidRow(
                p("Thanks for checking out my app. It's pretty bare bones right now, but I'm looking forward to building it out.
                  To do that, I need your help. I would not consider myself a trader. I'm more so a data scientist who is intrigued by the stock market.
                  So if you have any constructive feedback or requests, please email me at flachboard@protonmail.com."
                  ,style="text-align:justify;color:fading_palette[3];padding:15px;border-radius:10px"),
            ),
            hr(),
            h3(p(em("Tool Enhancements in Development"))),
            hr(),
            fluidRow(
                p("-Add Financials"
                  ,style="text-align:justify;color:fading_palette[3];padding:15px;border-radius:10px"),
            ),
            fluidRow(
                p("-Add Target Prices and Ratings"
                  ,style="text-align:justify;color:fading_palette[3];padding:15px;border-radius:10px"),
            ),
            fluidRow(
                p("-Add Moving Average Crossover Alerts"
                  ,style="text-align:justify;color:fading_palette[3];padding:15px;border-radius:10px"),
            ),
            fluidRow(
                p("-Add Predictive Models (Daily/Monthly/Quarterly)"
                  ,style="text-align:justify;color:fading_palette[3];padding:15px;border-radius:10px"),
            ),
            hr(),
            p(em(paste0("Last Refreshed On ", Sys.Date())))
        ),
        #Tab Moving Average
        tabPanel(icon("search-dollar"),
                 #Sidebar
                 sidebarLayout(      
                     
                     #Inputs
                     sidebarPanel(
                         selectInput(inputId = "symbol", label = "Symbol", choices = stock_list),
                         dateRangeInput("date", "Date Range", start = floor_date(Sys.Date()-1000, unit="year"), end = Sys.Date(),min = floor_date(Sys.Date()-2500, unit="year"), max = Sys.Date(),format = "yyyy-mm-dd" ),
                         numericInput("sma1", "SMA (green)", value = 50, min=2, max=365),
                         numericInput("sma2", "SMA (red)", value = 200, min=2, max=365),
                         numericInput("ema1", "EMA (blue)", value = 9, min=2, max=365),
                         numericInput("ema2", "EMA (orange)", value = 20, min=2, max=365)
                     ),
                     #Plot
                     mainPanel(
                         h4(p(em("Moving Averages"))),
                         fluidRow(
                             plotlyOutput("graph")
                         ),
                         hr(),
                         h4(p(em("Forecast - Prophet"))),
                         fluidRow(
                             plotlyOutput("prophet")
                         ),
                         hr(),
                         h4(p(em("Average Delta by Weekday"))),
                         fluidRow(
                             plotlyOutput("weekday")
                         ),
                         hr(),
                         h4(p(em("Insider Purchases/Sales"))),
                         fluidRow(
                             column(6, DTOutput("purch_dt_explore")),
                             column(6, DTOutput("sales_dt_explore"))
                         ),
                         hr()
                     )
                 )
        ),
        #Tab Gainers Losers
        tabPanel(icon("chart-line"),
            h2("Previous Business Day Delta"),
            #Plot
            mainPanel(
                DTOutput("gain_lose") 
            )
        ),
        #Tab Insider Purchases
        tabPanel(icon("user-plus"),
            h2("Aggregate Insider Purchases"),
            #Sidebar
            sidebarLayout(
                #Inputs
                sidebarPanel(
                    dateRangeInput("purch_date", "Date Range", start = floor_date(Sys.Date()-1000, unit="year"), end = Sys.Date(),min = floor_date(Sys.Date()-2500, unit="year"), max = Sys.Date(),format = "yyyy-mm-dd" )
                ),
                #Table
                mainPanel(
                    DTOutput("purch_data")
                )
            )
        ),
        #Tab Insider Sales
        tabPanel(icon("user-minus"),
            h2("Aggregate Insider Sales"),
            #Sidebar
            sidebarLayout(
                #Inputs
                sidebarPanel(
                    dateRangeInput("sales_date", "Date Range", start = floor_date(Sys.Date()-1000, unit="year"), end = Sys.Date(),min = floor_date(Sys.Date()-2500, unit="year"), max = Sys.Date(),format = "yyyy-mm-dd" )
                ),
                #Table
                mainPanel(
                    DTOutput("sales_data")
                )
            )
        ),
        #Tab Qtr/Qtr & Yr/Yr
        tabPanel(icon("glass-cheers"),
            h2("Quarter Over Quarter")
        )
    )
)

########## Server ##########
server <- function(input, output) {
    ### Stock Explorer Data ###
    observeEvent({
        shinyjs::runjs("var music = new Howl({src: ['LevelUp.mp3']}); music.play();")
    })
    #Moving Average
    data <- reactive({
        getSymbols(input$symbol, from = input$date[1], to = input$date[2], auto.assign = F) %>%
            fortify() %>%
            select(contains(c("Index", "Close"))) %>%
            `colnames<-`(c("Date", "Close")) %>%
            mutate(sma1 = SMA(Close, input$sma1), sma2 = SMA(Close, input$sma2), ema1 = EMA(Close, input$ema1), ema2 = SMA(Close, input$ema2)) %>%
            mutate(across(where(is.numeric), round, 2))
    })
    
    output$graph <- renderPlotly({
        plot_ly(data(), x = ~Date, y = ~Close, name = 'Close', type = 'scatter', mode = 'lines', line=list(color="lightgray")) %>%
            add_trace(y = ~sma1, name = 'SMA', mode = 'lines', line=list(color=fading_palette[7])) %>%
            add_trace(y = ~sma2, name = 'SMA', mode = 'lines', line=list(color=fading_palette[1])) %>%
            add_trace(y = ~ema1, name = 'EMA', mode = 'lines', line=list(color=fading_palette[2])) %>%
            add_trace(y = ~ema2, name = 'EMA', mode = 'lines', line=list(color=fading_palette[5])) %>%
            layout(yaxis=list(tickformat="$", title="", gridcolor = fading_palette[6]), xaxis=list(title="", gridcolor = fading_palette[6]), showlegend=F, paper_bgcolor=fading_palette[6], plot_bgcolor=fading_palette[6], font=list(color=fading_palette[2]))
    })
    
    #Insider Purchases
    purch_data_explore <- reactive({
        purch_df %>% dplyr::filter(Symbol == input$symbol, InsiderPurchaseDate >= input$date[1], InsiderPurchaseDate <= input$date[2])
    })
    
    output$purch_dt_explore <- DT::renderDT({
        datatable(purch_data_explore(), rownames = F, extensions = 'Buttons', 
                  options = list(autoWidth=T, dom = 'Brtip', buttons = c('copy', 'csv', 'excel', 'pdf', 'print')), 
                  filter = list(position = 'top', clear = FALSE),
                  caption = "Insider Purchases", escape=F, style = "bootstrap4") %>%
            formatCurrency("Value", digits = 0)
    })
    
    #Insider Sales
    sales_data_explore <- reactive({
        sales_df %>% dplyr::filter(Symbol == input$symbol, InsiderSalesDate >= input$date[1], InsiderSalesDate <= input$date[2])
    })
    
    output$sales_dt_explore <- DT::renderDT({
        datatable(sales_data_explore(), rownames = F, extensions = 'Buttons', 
                  options = list(autoWidth=T, dom = 'Brtip', buttons = c('copy', 'csv', 'excel', 'pdf', 'print')), 
                  filter = list(position = 'top', clear = FALSE),
                  caption = "Insider Sales", escape=F, style = "bootstrap4") %>%
            formatCurrency("Value", digits = 0)
    })
    
    #Prophet
    prophet_fn <- function(Symbol = "AAPL", first.date = Sys.Date() - 1000, last.date = Sys.Date()){
        stocks <- BatchGetSymbols(tickers = Symbol,
                                    first.date = first.date,
                                    last.date = last.date,
                                    freq.data = "daily",
                                    do.cache = FALSE,
                                    thresh.bad.data = 0)
        
        data <- stocks$df.tickers
        data <- na.omit(data)
        ds <- data$ref.date
        y <- data$price.close
        df <- data.frame(ds, y)
        m <- prophet(df)
        future <- make_future_dataframe(m, periods = 30)
        forecast <- predict(m, future)
        pred <- forecast$yhat[1:dim(df)[1]]
        actual <- m$history$y
        prophet_r2 <- summary(lm(pred~actual))$r.squared
        prophet_comp <- prophet_plot_components(m, forecast)
        df <- merge(m$history %>% select(ds,y), forecast %>% select(ds, yhat_lower, yhat_upper, yhat), by="ds", all=T)
        prophet_fig <- plot_ly(df, x = ~ds, y = ~round(yhat_upper, 2), type = 'scatter', mode = 'lines',
                               line = list(color = 'transparent'), showlegend = FALSE, name = 'Forecast_Upper') 
        prophet_fig <- prophet_fig %>% add_trace(y = ~round(yhat_lower, 2), type = 'scatter', mode = 'lines',
                                                 fill = 'tonexty', fillcolor=fading_palette[4], line = list(color = 'transparent'),
                                                 showlegend = FALSE, name = 'Forecast_Lower')
        prophet_fig <- prophet_fig %>% add_trace(x = ~ds, y = ~round(yhat, 2), type = 'scatter', mode = 'lines',
                                                 line = list(color=fading_palette[1]),
                                                 name = 'Forecast')
        prophet_fig <- prophet_fig %>% add_trace(y = ~round(y, 2), name = 'Actual', line = list(color = fading_palette[2], dash = 'dot')) 
        prophet_fig <- prophet_fig %>% layout(title = "", paper_bgcolor=fading_palette[6], plot_bgcolor=fading_palette[6],
                                              xaxis = list(title = "",
                                                           gridcolor = fading_palette[6],
                                                           showgrid = F,
                                                           showline = F,
                                                           zeroline = F),
                                              yaxis = list(title = "",
                                                           gridcolor = fading_palette[6],
                                                           showgrid = F,
                                                           showline = F,
                                                           zeroline = F,
                                                           tickformat = "$"))
        return(prophet_fig)
    }
    
    prophet_plot <- reactive({
        prophet_fn(input$symbol, input$date[1], input$date[2])
    })
    
    output$prophet = renderPlotly({
        prophet_plot()
    })
    
    #Day of Week
    weekday_plotly <- reactive({
        BatchGetSymbols(tickers = input$symbol, first.date = input$date[1], last.date = input$date[2], freq.data = "daily", do.cache = FALSE, thresh.bad.data = 0)$df.tickers %>%
            select(price.open, price.close, ref.date) %>%
            mutate(weekday_ = weekdays(ref.date), price_delta = price.close/price.open-1) %>%
            group_by(weekday_) %>%
            summarise(price_delta = mean(price_delta)) %>%
            mutate(weekday_ = factor(weekday_, levels=c("Monday", "Tuesday", "Wednesday", "Thursday", "Friday"))) %>%
            plot_ly(x=~weekday_, y=~price_delta, marker=list(color=fading_palette[2])) %>% layout(title = "", paper_bgcolor=fading_palette[6], plot_bgcolor=fading_palette[6],
                                                           xaxis = list(title = "",
                                                                        gridcolor = fading_palette[6],
                                                                        showgrid = F,
                                                                        showline = F,
                                                                        zeroline = F),
                                                           yaxis = list(title = "",
                                                                        gridcolor = fading_palette[6],
                                                                        showgrid = F,
                                                                        showline = F,
                                                                        zeroline = F,
                                                                        tickformat = ".2%"))
    })
    
    output$weekday = renderPlotly({
        weekday_plotly()
    })
    
    #Previous Business Day Delta
    output$gain_lose = DT::renderDT({
        datatable(gain_lose, rownames = F, extensions = 'Buttons', 
                  options = list(autoWidth=T, dom = 'Bfrtip', buttons = c('copy', 'csv', 'excel', 'pdf', 'print')), 
                  filter = list(position = 'top', clear = FALSE),
                  caption = "Previous Business Day Delta", escape=F, style = "bootstrap4") %>%
            formatPercentage("Delta", digits = 2)
    })
    
    #Insider Purchases Data
    purch_data <- reactive({
        purch_df %>%
            dplyr::filter(InsiderPurchaseDate >= input$purch_date[1] & InsiderPurchaseDate <= input$purch_date[2]) %>%
            group_by(Symbol) %>%
            summarise(Shares = sum(Shares), Value = sum(Value)) %>%
            arrange(desc(Value))
    })
    
    #Insider Purchases Output
    output$purch_data = DT::renderDT({
        datatable(purch_data(), rownames = F, extensions = 'Buttons', 
                  options = list(autoWidth=T, dom = 'Bfrtip', buttons = c('copy', 'csv', 'excel', 'pdf', 'print')), 
                  filter = list(position = 'top', clear = FALSE),
                  caption = "Aggregate Insider Purchases", escape=F, style = "bootstrap4") %>%
            formatCurrency("Value", digits = 0) %>%
            formatRound("Shares", digits = 0, mark = ",")
    })
    
    #Insider Sales Data
    sales_data <- reactive({
        sales_df %>%
            dplyr::filter(InsiderSalesDate >= input$sales_date[1] & InsiderSalesDate <= input$sales_date[2]) %>%
            group_by(Symbol) %>%
            summarise(Shares = sum(Shares), Value = sum(Value)) %>%
            arrange(Value)
    })
    
    output$sales_data = DT::renderDT({
        datatable(sales_data(), rownames = F, extensions = 'Buttons', 
                  options = list(autoWidth=T, dom = 'Bfrtip', buttons = c('copy', 'csv', 'excel', 'pdf', 'print')), 
                  filter = list(position = 'top', clear = FALSE),
                  caption = "Aggregate Insider Sales", escape=F, style = "bootstrap4") %>%
            formatCurrency("Value", digits = 0) %>%
            formatRound("Shares", digits = 0, mark = ",")
    })
}

# Run the application 
shinyApp(ui = ui, server = server)

Ok, I see. What is missing is the expression argument of the observeEvent. I used that observer as an example of how one might implement triggering a sound upon a change in some reactive input.

So, you should use an expression that works for what you want to do...Do you want sound to play on a change on some specific value? a button click?

Here's a simple -and hopefully reproducible- example, playing a sound from a URL upon a button click. Should work, if the howler.js file is in the www/ folder.

library(shiny)
library(shinyjs)

ui =  fixedPage(
  useShinyjs(),
  includeScript("www/howler.js"),
  br(),
  actionButton(inputId = "playButton", 
               label = "",
               width = "200px",
               icon = icon("play")),
  p("Click the button to get COINS :).")
)

server = function(input, output) {
  observeEvent(
    input$playButton,({
      shinyjs::runjs(
        "var music = new Howl({src:['http://www.sonidosmp3gratis.com/sounds/mario-coin.mp3'],
                               autoplay: true});") # instead of music.play();
    })
  )
}

shinyApp(ui = ui, server = server)

This post was published by an Appsilon team member. Our company can help you get the most out of RShiny and Posit/RStudio products.

Check our open positions here.

Appsilon: Building impactful RShiny Dashboards and providing R coding services.
Appsilon_GIFsmall_whitebg

It works! This is great! Thank you!

1 Like

I have one more follow up question. Is there a way to mute the sound effects upon start up? All my sounds play when I open the app (which I don't want). I only want them to play when an input is changed after it's been opened.

Mmm, I see. I think one thing you may want to try is to set the ignoreInit = FALSE in your observeEvent() call (I am guessing you are using that observer to trigger your sounds). That should supress any inputs from being "observed" on app start-up.

Also, I've been playing a bit more with music-playing implementation with shiny and found a better way to do it than my previous post. The code I posted before creates a new Howler object with every runjs() call inside the shiny observer.

Just for posterity, I leave here a working example that creates a sound object upon app start-up, and then call a method from that object inside an observeEvent() (here, it is the .play method). There surely is room for improvement, but I think this is a better starting point.

library(shiny)
library(shinyjs)

ui =  fixedPage(
  useShinyjs(),
  includeScript("www/howler.js"),

  tags$script("function load_music(){
                var music = new Howl({src:['http://www.sonidosmp3gratis.com/sounds/mario-coin.mp3'],
                                 autoplay: false});
                return music;}"), # return the howler object
  br(),
  actionButton(inputId = "playButton", 
               label = "",
               width = "200px",
               icon = icon("play")),
  p("Click the button to get COINS :).")
)

server = function(input, output) {
  shinyjs::runjs("my_music = load_music()") # load music upon start-up
  observeEvent(
    input$playButton,({
      shinyjs::runjs("my_music.play();") # use a method of the howler object
    } )
  )
}

shinyApp(ui = ui, server = server)


This post was published by an Appsilon team member. Our company can help you get the most out of RShiny and Posit/RStudio products.

Check our open positions here.

Appsilon: Building impactful RShiny Dashboards and providing R coding services.
Appsilon_GIFsmall_whitebg

IgnoreInit worked great! Thanks again!

This topic was automatically closed 7 days after the last reply. New replies are no longer allowed.

If you have a query related to it or one of the replies, start a new topic and refer back with a link.