I am creating a dashboard for financial stocks. I have a box with the stock price. The stock price changes every minute. What I want is as the stock price changes, the colour should change briefly to reflect the type of change. For instance, if the last price is below the previous last price, I want the colour of the text to flash red as it changes, but return to the default colour, which is black. This is similar to what happens on Google Finance as the price changes (see google search result for jse:npn for example)
Here is the most stripped out version of my code.
library(quantmod)
library(shiny)
library(shinydashboard)
library(shinydashboardPlus)
library(shinyWidgets)
ui <- dashboardPage(
dashboardHeader(title = "Example"),
dashboardSidebar(
sidebarMenu(
ID = "tabs",
menuItem(text = "Naspers", tabName = "tabNaspers", icon = icon("chart-line"))
)
),
dashboardBody(
tags$head(tags$style(HTML('.fas { font-size: 36px; }
.fas {
vertical-align: middle;
}
#'
))),
tabItems(
tabItem(tabName = "tabNaspers",
fluidRow(
column(
width = 7,
boxPlus(title = span("ALL SHARE", style = "color: rgb(128,128,128); font-size: 22px"),
collapsible = TRUE,
closable = FALSE,
enable_dropdown = TRUE,
dropdown_icon = "NULL",
status = 'success',
valueBoxOutput('npn_price', 12),
valueBoxOutput('npn_day_change', 12),
width = 4
)
)
)
)
)
)
)
npn_close <- 203059.00
server <- function(input, output, session){
autoInvalidate <- reactiveTimer(intervalMs = 60000)
output$npn_price <- renderUI({
autoInvalidate()
npn_last <- getQuote("NPN.JO", what=yahooQF("Last Trade (Price Only)"))[, 2]
npn_change <- round((npn_last - npn_close) / npn_close, 4) * 100
arrow_color <- ifelse(npn_change > 0, 'rgb(15, 157, 88)' ,'rgb(226, 74, 26)')
npn_diff <- npn_last - npn_close
npn_diff <- ifelse(npn_diff < 0, paste0('-', npn_diff), paste0('+', npn_diff))
tags$div(HTML(paste0('<span style="font-size: 24px"><strong>',
npn_last, '</strong></span>', '<span style="color:', arrow_color, '; font-size: 14px">', npn_diff, '</span>')))
})
output$npn_day_change <- renderUI({
autoInvalidate()
npn_last <- getQuote("NPN.JO", what=yahooQF("Last Trade (Price Only)"))[, 2]
npn_change <- round((npn_last - npn_close) / npn_close, 4) * 100
npn_change <- paste0(npn_change, "%")
arrow_color <- ifelse(npn_change > 0, 'rgb(15, 157, 88)' ,'rgb(226, 74, 26)')
arrow_icon <- ifelse(npn_change < 0, '"fas fa-caret-down"', '"fas fa-caret-up"')
tags$div(HTML(paste0('<i class=', arrow_icon, ' style = "color:', arrow_color,
';"></i><span style="color:', arrow_color,'; font-size: 24px"><strong>',
npn_change, '</strong></span>')))
})
}
shinyApp(ui, server)
Sure. In summary we store the price, get the new price, if the price is down make the text red, then we quickly run again to produce the flash effect.
For testing I added buttons to simulate the price going up and down. I also made it check for changes more frequently.
The flash length can be changed at this line: invalidateLater(1200).
library(quantmod)
library(shiny)
library(shinydashboard)
library(shinydashboardPlus)
library(shinyWidgets)
ui <- dashboardPage(
dashboardHeader(title = "Example"),
dashboardSidebar(
sidebarMenu(
ID = "tabs",
menuItem(text = "Naspers", tabName = "tabNaspers", icon = icon("chart-line"))
)
),
dashboardBody(
tags$head(tags$style(HTML('.fas { font-size: 36px; }.fas {vertical-align: middle;} #'))),
tabItems(
tabItem(tabName = "tabNaspers",
fluidRow(
column(
width = 7,
boxPlus(title = span("ALL SHARE", style = "color: rgb(128,128,128); font-size: 22px"),
collapsible = TRUE,
closable = FALSE,
enable_dropdown = TRUE,
dropdown_icon = "NULL",
status = 'success',
valueBoxOutput('npn_price', 12),
valueBoxOutput('npn_day_change', 12),
width = 4
)
)
),
#Buttons to simulate stock going up, so that we don't have to wait for the stock to actually go up or down
actionButton('btn_stockgoesup', 'Simulate Stock Going Up'),
actionButton('btn_stockgoesdown', 'Simulate Stock Going Down')
)
)
)
)
npn_close <- 203059.00
server <- function(input, output, session){
autoInvalidate <- reactiveTimer(intervalMs = 6000)
#Buttons to simulate stock going up, so that we don't have to wait for the stock to actually go up or down
observeEvent(input$btn_stockgoesup, {npn_last_stored <<- 0 ; print('At the next update the stock will simulate going up')})
observeEvent(input$btn_stockgoesdown, {npn_last_stored <<- Inf; print('At the next update the stock will simulate going down')})
output$npn_price <- renderUI({
autoInvalidate()
npn_last <- getQuote("NPN.JO", what=yahooQF("Last Trade (Price Only)"))[, 2]
#Handle when app first starts and there is no stored value to compare against
if(exists('npn_last_stored') == FALSE) {npn_last_stored <<- npn_last}
if(npn_last < npn_last_stored) {
#Stock went down
print('stock went down')
npn_color <- 'rgb(220, 50, 20)'
invalidateLater(1200)
} else {
#Stock went up / not changed
print('stock went up / not changed')
npn_color <- 'rgb(0, 0, 0)'
}
#Update stored value
npn_last_stored <<- npn_last
npn_change <- round((npn_last - npn_close) / npn_close, 4) * 100
arrow_color <- ifelse(npn_change > 0, 'rgb(15, 157, 88)' ,'rgb(226, 74, 26)')
npn_diff <- npn_last - npn_close
npn_diff <- ifelse(npn_diff < 0, paste0('-', npn_diff), paste0('+', npn_diff))
tags$div(HTML(paste0('<span style="color:', npn_color, '; font-size: 24px"><strong>', npn_last, '</strong></span>', '<span style="color:', arrow_color, '; font-size: 14px">', npn_diff, '</span>')))
})
output$npn_day_change <- renderUI({
autoInvalidate()
npn_last <- getQuote("NPN.JO", what=yahooQF("Last Trade (Price Only)"))[, 2]
npn_change <- round((npn_last - npn_close) / npn_close, 4) * 100
npn_change <- paste0(npn_change, "%")
arrow_color <- ifelse(npn_change > 0, 'rgb(15, 157, 88)' ,'rgb(226, 74, 26)')
arrow_icon <- ifelse(npn_change < 0, '"fas fa-caret-down"', '"fas fa-caret-up"')
tags$div(HTML(paste0('<i class=', arrow_icon, ' style = "color:', arrow_color,';"></i><span style="color:', arrow_color,'; font-size: 24px"><strong>',npn_change, '</strong></span>')))
})
}
shinyApp(ui, server)