Reputation: 811
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)
Upvotes: 0
Views: 381
Reputation: 978
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/
Upvotes: 1