当使用闪亮的reactiveTimer 无效时，随着文本值的变化而改变文本输出的颜色

Question

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)

Answer 1

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)