Change formatting of table cell based on condition in shiny

Question

I have a shiny app that produces a table of test statistics. I'd like to bold cells that are less than a user supplied critical value. In the example below I've put a * next to the significant values. I'd like to have that number bolded instead. I'm not sure the best way to go about this. Maybe DT:: datatable() is up to the job?

library(shiny)
library(ggplot2)
# Define UI for application that draws a histogram
ui <- fluidPage(

   # Sidebar with a slider input for number of bins 
   sidebarLayout(
      sidebarPanel(
        numericInput(inputId="pcrit", label="P crit", 
                     value=0.05,min=0,max=1,step=0.001)
      ),

      mainPanel(
         plotOutput("datPlot"),
         tableOutput("sigTable")
      )
   )
)

server <- function(input, output) {

  doDat <- reactive({
    n <- 5e2
    nTrials <- 10

    dat <- data.frame(x = rnorm(n),
                      w = seq(0.01,0.5,length.out = nTrials),
                      trial = 1:nTrials)

    dat$y <- dat$x * dat$w + rnorm(n)
    dat
  })
    doCorr <- reactive({
    dat <- doDat()
    res <- data.frame(trial=1:nTrials,corr=NA,pVal=NA)
    for(i in 1:nTrials){
      tmp <- cor.test(formula=~y+x,data=dat[dat$trial==i,])
      res$corr[i] <-tmp$estimate
      res$pVal[i] <-tmp$p.value
    }
    res  
  })

   output$datPlot <- renderPlot({
     dat <- doDat()
     p <- ggplot(data = dat,aes(x=x,y=y))
     p <- p + geom_point()
     p <- p + facet_wrap(~trial)
     p
   })
   #change this to produce bolded numbers rather than use the clunky *
   output$sigTable <- renderTable({
     res <- doCorr()
     res$corr <- round(res$corr,3)
     pcrit <- input$pcrit
     res$corr[res$pVal <= pcrit] <- paste(res$corr[res$pVal <= pcrit],
                                          "*",sep="")  
     res
   })
}

shinyApp(ui = ui, server = server)

Answer 1

Can you try the below the code....

library(shiny)
library(ggplot2)
library(DT)
# Define UI for application that draws a histogram
ui <- fluidPage(

  # Sidebar with a slider input for number of bins 
  sidebarLayout(
    sidebarPanel(
      numericInput(inputId="pcrit", label="P crit", 
                   value=0.05,min=0,max=1,step=0.001)
    ),

    mainPanel(
      plotOutput("datPlot"),
      DTOutput("sigTable")
    )
  )
)

server <- function(input, output) {

  doDat <- reactive({
    n <- 5e2
    nTrials <<- 10

    dat <- data.frame(x = rnorm(n),
                      w = seq(0.01,0.5,length.out = nTrials),
                      trial = 1:nTrials)

    dat$y <- dat$x * dat$w + rnorm(n)
    dat
  })
  doCorr <- reactive({
    dat <- doDat()
    res <- data.frame(trial=1:nTrials,corr=NA,pVal=NA)
    for(i in 1:nTrials){
      tmp <- cor.test(formula=~y+x,data=dat[dat$trial==i,])
      res$corr[i] <-tmp$estimate
      res$pVal[i] <-tmp$p.value
    }
    res  
  })

  output$datPlot <- renderPlot({
    dat <- doDat()
    p <- ggplot(data = dat,aes(x=x,y=y))
    p <- p + geom_point()
    p <- p + facet_wrap(~trial)
    p
  })
  #change this to produce bolded numbers rather than use the clunky *
  output$sigTable <- renderDT({
    res <- doCorr()
    res$corr <- round(res$corr,3)
    pcrit <- input$pcrit
    res$corr[res$pVal <= pcrit] <- paste(res$corr[res$pVal <= pcrit],
                                         "*",sep="")  
    datatable(res,rownames = FALSE) %>% 
      formatStyle('corr', fontWeight = styleInterval(input$pcrit, c('normal', 'bold'))) 
  })
}

shinyApp(ui = ui, server = server)

Please refer to this Document for detailed information: https://rstudio.github.io/DT/