I have a table in Shiny and want to add only one tooltip for the column "Species", i.e. the other columns should not have a tooltip.
I managed to add a tooltip for all of them, but don't know how I can set the content for specific columns.
shinyApp(
ui = fluidPage(
fluidRow(
column(12,
dataTableOutput('table')
)
)
),
server = function(input, output) {
output$table <- renderDataTable(iris, options = list(
pageLength = 5,
initComplete = I("function(settings, json) {
$('th').each( function(){this.setAttribute( 'title', 'TEST' );});
$('th').tooltip();
}")))
}
)
I have modified your code to get the tooltip for only the 4th column name ie "Species".
library(shiny)
shinyApp(
ui = fluidPage(
fluidRow(
column(12,
dataTableOutput('table')
)
)
),
server = function(input, output) {
output$table <- renderDataTable(iris, options = list(
pageLength = 5,
initComplete = I("function(settings, json) {
$('th:eq(4)').each( function(){this.setAttribute( 'title', 'TEST' );});
$('th').tooltip();
}")))
}
)
Hope this helps!
Related
The toy app in the example below contains an R/Shiny actionGroupButtons element. I am looking for guidance please on how to start the actionGroupButtons with button ‘btn_edit’ disabled, which can then become enabled on a click of the button ‘btn_enable’.
Button ‘btn_duplicate’ should remain enabled at all times.
#DeanAttali mentions the use of the ‘disabled’ attribute here (Shiny: how to start application with action button disabled?), though I think that it is one of the inputs that it doesn’t work with.
Any ideas please? TIA
library(shiny)
library(shinyWidgets)
library(shinyjs)
ui <- fluidPage(
useShinyjs(),
fluidRow(
actionGroupButtons(
inputIds = c("btn_edit", "btn_duplicate"),
labels = list("Edit", "Duplicate")
)
),
br(),
fluidRow(
actionButton('btn_enable', 'enable edit')
),
br(),
fluidRow(
verbatimTextOutput('btns')
),
br(),
fluidRow(
verbatimTextOutput('btn_enable')
)
)
server <- function(input, output) {
observeEvent((input$btn_edit|input$btn_duplicate),{
output$btns <- renderPrint({paste(input$btn_edit, 'and', input$btn_duplicate)})
})
observeEvent(input$btn_enable,{
output$btn_enable <- renderPrint({input$btn_enable})
if(input$btn_enable > 0) {
shinyjs::enable("btn_edit")
} else {
shinyjs::disable("btn_edit")
}
}, ignoreInit = TRUE)
}
shinyApp(ui = ui, server = server)
You need to set ignoreNULL = FALSE in your observeEvent call, otherwise it will run only after btn_enable was pressed:
library(shiny)
library(shinyWidgets)
library(shinyjs)
ui <- fluidPage(
useShinyjs(),
fluidRow(
actionGroupButtons(
inputIds = c("btn_edit", "btn_duplicate"),
labels = list("Edit", "Duplicate")
)
),
br(),
fluidRow(
actionButton('btn_enable', 'enable edit')
),
br(),
fluidRow(
verbatimTextOutput('btns')
),
br(),
fluidRow(
verbatimTextOutput('btn_enable')
)
)
server <- function(input, output, session) {
observeEvent((input$btn_edit|input$btn_duplicate),{
output$btns <- renderPrint({paste(input$btn_edit, 'and', input$btn_duplicate)})
})
observeEvent(input$btn_enable, {
output$btn_enable <- renderPrint({input$btn_enable})
if(input$btn_enable > 0) {
shinyjs::enable("btn_edit")
} else {
shinyjs::disable("btn_edit")
}
}, ignoreInit = FALSE, ignoreNULL = FALSE)
}
shinyApp(ui = ui, server = server)
Another approach would be to disable the button outside of the observer:
library(shiny)
library(shinyWidgets)
library(shinyjs)
ui <- fluidPage(
useShinyjs(),
fluidRow(
actionGroupButtons(
inputIds = c("btn_edit", "btn_duplicate"),
labels = list("Edit", "Duplicate")
)
),
br(),
fluidRow(
actionButton('btn_enable', 'enable edit')
),
br(),
fluidRow(
verbatimTextOutput('btns')
),
br(),
fluidRow(
verbatimTextOutput('btn_enable')
)
)
server <- function(input, output, session) {
shinyjs::disable("btn_edit")
observeEvent((input$btn_edit|input$btn_duplicate),{
output$btns <- renderPrint({paste(input$btn_edit, 'and', input$btn_duplicate)})
})
observeEvent(input$btn_enable, {
output$btn_enable <- renderPrint({input$btn_enable})
shinyjs::enable("btn_edit")
})
}
shinyApp(ui = ui, server = server)
How can I increase the size of the WellPanel to have my table completely inside the "grey" box?
image here
(I'm new in Shiny and edited the table due to confidential data).
I tried
wellPanel(
fluidRow(
fluidPage(
and only
wellPanel(
fluidRow(
None of then works
wellPanel(
fluidRow(
fluidPage(
headerPanel(""),
column(12, align="center",
output$dataprint_controles <- DT::renderDataTable({
datatable(data,
rownames = FALSE,
options = list(paging = TRUE,
scrollX = TRUE,
searching = TRUE,
ordering = FALSE,
autoWidth = FALSE,
names = TRUE,
columnDefs = list(list(visible = FALSE, targets = esconder),
list(className = 'dt-center', targets = "_all")
),
dom = '<"sep">',
headerCallback = DT::JS(stringr::str_glue(
"function(thead) {{",
" $(thead).closest('thead').find('th').css('border-top', '2px solid black');",
" $(thead).closest('thead').find('th').css('border-left', '0px solid black');",
" $(thead).closest('thead').find('th').css('background', '#D9D9D9');",
" $(thead).closest('thead').find('th').css('color', 'black');",
" $(thead).closest('thead').find('th').css('text-align', 'center');",
"}}"
))
)
)
}),
),
)
), # fecha fluid
), # fecha well panel
fluidPage should be the most outer element of the UI, and column must be contained in fluidRow. The wellPanel does not go beyond a width of 100%, so you have to add the CSS propert width: fit-content;.
library(shiny)
library(DT)
mat <- matrix(rnorm(5*14), nrow = 5, ncol = 14)
ui <- fluidPage(
fluidRow(
column(
12,
wellPanel(
style = "width: fit-content;",
DTOutput("dtable")
)
)
)
)
server <- function(input, output, session) {
output$dtable <- renderDT({
datatable(mat)
})
}
shinyApp(ui, server)
I wish to have a popout modal within a shiny app that depending on the user's action within the modal,
it would show or hide certain fields.
For example, the Modal includes a button that when pressed, another button would apear\disappear.
sadly, although the observeEvent detects a change in the hide\show button, shinyjs::toggle(), shinyjs::hide()
and shinyjs::show() fail to work
example script:
library(shiny)
ui <- fluidPage(
actionButton("show_modal", "show modal"),
)
server <- function(input, output) {
observeEvent(input$show_modal, {
showModal(
modalDialog(footer = NULL,easyClose = T,
tagList(
fluidRow(
box(status = "primary", width = 6, style = "direction: ltr",
actionButton("toggle_btn", "show or hide second button")
)),
fluidRow(
box(status = "success", width = 6, style = "direction: ltr",
actionButton("box_btn", "Box!")
))
)
))
})
observeEvent(input$toggle_btn, {
shinyjs::toggle("box_btn")
cat("\npresentation button pressed\n")
})
}
shinyApp(ui, server)
You can do it without shinyjs by using conditionalPanel():
library(shiny)
ui <- fluidPage(
actionButton("show_modal", "show modal"),
)
server <- function(input, output) {
rv <- reactiveValues(show_btn = FALSE)
observeEvent(input$toggle_btn, {
rv$show_btn <- !rv$show_btn
})
output$show_btn <- reactive({rv$show_btn})
outputOptions(output, "show_btn", suspendWhenHidden = FALSE)
observeEvent(input$show_modal, {
# add_path_to_existing_offers_DB(user = user)
showModal(
modalDialog(
footer = NULL,
easyClose = T,
tagList(
fluidRow(
actionButton("toggle_btn", "show or hide second button")
),
conditionalPanel(
condition = "output.show_btn == true",
fluidRow(
actionButton("box_btn", "Box!")
)
)
)
)
)
})
}
shinyApp(ui, server)
Turns out as Dean Attali the author of shinyjs pointed out kindly,
that I failed to call useShinyjs() function.
library(shiny)
library(shinyjs)
ui <- fluidPage(
**useShinyjs(),**
actionButton("show_modal", "show modal"),
)
server <- function(input, output) {
observeEvent(input$show_modal, {
showModal(
modalDialog(footer = NULL,easyClose = T,
tagList(
fluidRow(
box(status = "primary", width = 6, style = "direction: ltr",
actionButton("toggle_btn", "show or hide second button")
)),
fluidRow(
box(status = "success", width = 6, style = "direction: ltr",
actionButton("box_btn", "Box!")
))
)
))
})
observeEvent(input$toggle_btn, {
shinyjs::toggle("box_btn")
cat("\npresentation button pressed\n")
})
}
shinyApp(ui, server)
I am currently developing a shiny app and I face an issue with the dynamic alignment of the data table.
The code used is
ui.R
shinyUI(fluidPage(
dashboardPage(
dashboardBody(
tabItems(
tabItem(tabName = "view_id",
sidebarLayout(
sidebarPanel(width = 2, checkboxGroupInput("sidebar", "People Viewer",
sidebar_content)
),
mainPanel(width=10,style ="background-color:RGB(255,255,255); border-color:RGB(255,255,255);align:left;",
wellPanel(DTOutput("tab") )
)
)
)
)
)))
server.R
shinyServer(function(input, output) {
output$tab <- {
renderDT(datatable(pep_view[ ,input$sidebar, drop = FALSE ], filter = 'top', extensions = 'FixedColumns',
options = list(scrollX = TRUE,scrollY = "400px" ,fixedColumns = TRUE, pageLength = 10, autoWidth = TRUE
), class = 'cell-border stripe')
)
}
})
The output obtained is
Can anyone resolve this issue? Thanks in advance!!
I need to change the value of an input every time that the user changes the page of a dataset pagination.
I've tried to use the observeEvent, but it doesn't work.
UI
fluidRow(
column(10,
""
),
column(2,
textInput("inText", "Input text 2", value = "Default text")
),
column(12,
dataTableOutput('table')
)
)
Server
observeEvent(input$table, {
updateTextInput(session, "inText", value = paste("New text",0))
})
Hope you can help me.
Assuming your table id is table as given in your example, you can use:
input$table_state$start / input$table_state$length + 1.
In the following a complete example:
library(DT)
library(shiny)
app <- shinyApp(
ui = fluidPage(
tags$head(
# hides the default search functionality
tags$style(
HTML(".dataTables_filter, .dataTables_info { display: none; }")
)
),
fluidRow(
column(10,
""
),
column(2,
# adding new page filter
uiOutput("pageFilter")
),
column(12,
dataTableOutput('table')
)
)
),
server = function(input, output) {
output$pageFilter <- renderUI({
val <- input$table_state$start / input$table_state$length + 1
numericInput("page", "Page", val, min = 1)
})
output$table <- DT::renderDataTable({
iris
}, options = list(pageLength = 5, stateSave = TRUE))
# using new page filter
observeEvent(input$page, {
dataTableProxy("table") %>% selectPage(input$page)
})
}
)
runApp(app, launch.browser = TRUE)