Is it possible in Rstudio DT datatable to add a hyperlink in the caption argument? I have tried and tried but I can't seem to get anything working. I tried the w3schools fiddle for html caption and I can get a hyperlink to work in the caption of the table but I don't know how to translate this to the DT datatable. I have tried calling it via htmltools:: but I can only get it to render as text for example:
datatable(tble
,caption =
htmltools::tags$caption(
style = 'caption-side: top; text-align: left; color:blue; font-size: 12px;',
,htmltools::p('<!DOCTYPE html>
<html><body>RStudio</body>
</html>'))
,escape = FALSE
)
I know this is a little old but since I had a similar issue today and figured out an answer, I figured I would share. The way I did this was to use the HTML function from Shiny to encode the html correctly, which will take care of the necessary escaping. An example can be seen here:
DT::datatable(
get(input$dataInput),
caption = htmltools::tags$caption(
style = 'caption-side: top; text-align: Left;',
htmltools::withTags(
div(HTML('Here is a link to RStudio'))
)
)
)
A full example of this in a simple Shiny application:
library(shiny)
library(DT)
data("mtcars")
data("iris")
ui <- fluidPage(
titlePanel("Example Datatable with Link in Caption"),
selectInput('dataInput', 'Select a Dataset',
c('mtcars', 'iris')),
DT::dataTableOutput('example1')
)
server <- function(input, output, session){
output$example1 <- DT::renderDataTable({
# Output datatable
DT::datatable(
get(input$dataInput),
caption = htmltools::tags$caption(
style = 'caption-side: top; text-align: Left;',
htmltools::withTags(
div(HTML('Here is a link to RStudio'))
)
)
)
})
}
shinyApp(ui = ui, server = server)
Related
I am building a Shiny app where I want to add some italic text in the navbarPage at the right side. According to the question: Shiny NavBar add additional info I wrote the following code, but it doesn't work out for me:
This is some demo code I have now:
ui <- fluidPage(
navbarPage(theme = shinytheme("flatly"), collapsible = TRUE,
HTML('<a style="text-decoration:none;cursor:default;color:#FFFFFF;" class="active" href="#">Dashboard</a>'), id="nav",
navbarMenu('Graphs', icon = icon('chart-area'),
tabPanel('One country'),
tabPanel('Two countries')),
tabPanel('Tables'),
tags$script(HTML("var header = $('.navbar> .container-fluid');
header.append('<div style=\"float:right\"><h5>Some very important text</h5></div>');
console.log(header)"))
))
server <- function(input, output, session) {}
shinyApp(ui = ui, server = server)
This results in:
the following warning message: Warning message:
Navigation containers expect a collection of bslib::nav()/shiny::tabPanel()s and/or bslib::nav_menu()/shiny::navbarMenu()s. Consider using header or footer if you wish to place content above (or below) every panel's contents.
not the desired output. Because, the text is not visible, because it has the same colour as the background, the text is under the Dashboard, Graphs en tables text, but I want them to be on the same line. The text is not in italic.
Output now
This is what I want:
Desired output
After the answer from lz100 it looks very nice on a big screen, but the text is still under the Dashboard, Graphs en tables text. And when I change the format of the Rshiny dashboard to my very small laptopscreen, the output becomes likes this:
Output after answer from lz100
library(shiny)
library(shinythemes)
ui <- fluidPage(
navbarPage(theme = shinytheme("flatly"), collapsible = TRUE,
HTML('<a style="text-decoration:none;cursor:default;color:#FFFFFF;" class="active" href="#">Dashboard</a>'), id="nav",
navbarMenu('Graphs', icon = icon('chart-area'),
tabPanel('One country',
tags$script(HTML(
"
var header = $('.navbar> .container-fluid');
header.append('<div id=\"my-title\">Some very important text</div>');
")),
tags$style(HTML(
'
.navbar-collapse.collapse {display: inline-block !important;}
#my-title {
float:right;
display: flex;
color: white;
align-items: flex-end;
justify-content: flex-end;
height: 60px;
font-style: italic;
}
'
))
),
tabPanel('Two countries')),
tabPanel('Tables')
)
)
server <- function(input, output, session) {}
shinyApp(ui = ui, server = server)
The reason you have warnings is because you put tags$script under navbarPage. Not a big deal to me, but I relocate your script inside the first tabPanel, warnings are gone.
Some CSS and JS added to create your desired output
Search/Read here if you don't know how these CSS work: https://www.w3schools.com/css/default.asp
I am attempting to arrange the following outputs so that each number pair is aligned perfectly.
Is there a way to change the spacing of a table beyond the options avaible e.g 'l'?
Following this, how could I vertically align the table with the bucketlist?
library(shiny)
library(sortable)
ui <- fluidPage(column(width =1,tableOutput("table")), column(width =1,
uiOutput("numbers"))
)
server <- function(input, output, session) {
output$table = renderTable( spacing = 'l',as.matrix(c(1:30)))
output$numbers <- renderUI({
bucket_list(
header = h4("Numbers", align = "center"),
group_name = "rank_Bedspace_Acuity",
orientation = "horizontal",
add_rank_list(
text = h5("Numbers", align = "center",style="color: #fff; background-color: #4080C9"),
input_id = "numbers",
labels = c(1:30)
))
})
}
shinyApp(ui, server)
Help appreciated.
Spacing of table - You will have to tweak the .css on your own.
I took your code and made the following updates to .css
Set table
width: auto; - Deleted this
padding-top: 15px; - Added this
.tr { padding-bottom: 1px }
(this is to match with the sortable height of 42px. Alternatively, you could also update the row height directly.
I assume by vertical alignment, you want the table to appear right next to the sortable widget so that you get a reference between old table vs the updated one. Applying the above .css tweaks, I get the following
Is this what you were looking for?
I want to style a shiny input from dqshiny package in my Shiny app as below -
library(shiny)
library(dqshiny)
opts <- sapply(1:100000, function(i) paste0(sample(letters, 9), collapse=""))
shinyApp(
ui = fluidPage(
autocomplete_input("auto1", "Unnamed:", opts, max_options = 1000)
),
server = function(input, output, session) {
}
)
I want to 2 things to achieve -
Want to change the highlight color in the suggestion field from yellowish to green
Also want to change the distance between the input field and the suggestion container with let say 10px.
I have a few other Widgets in my App, so above modified styling should not impact other widgets.
Is there any way to achieve this?
Any pointer will be highly appreciated.
Easiest way is just adding the CSS directly into the header. There's a really useful article about styling Shiny apps here.
library(shiny)
library(dqshiny)
opts <- sapply(1:100000, function(i) paste0(sample(letters, 9), collapse=""))
shinyApp(
ui = fluidPage(
tags$head(
tags$style(
HTML(
'
.autocomplete-items div:hover {
background-color: green;
}
#auto1autocomplete-list {
margin-top: 10px;
}
'
)
)
),
autocomplete_input("auto1", "Unnamed:", opts, max_options = 1000)
),
server = function(input, output, session) {
}
)
I am building a table using the DT package in a Shiny Dashboard. The table has several columns and I used DT's ColVis functionality to allow users to hide/show only the columns they're interested in.
My question is - is it possible to change the color of those buttons once the Column visibility button is clicked on? As of right now, the colors aren't different enough and its hard to tell which columns are visible and which ones aren't without navigating to the table. I've included a screenshot that shows what I mean. The Site_ID column is not visible in the table, while the Participant_ID column is.
I used inspect element in google chrome to find out the objects name and it looked to be: a.dt-buttons.buttons-columnVisibility, and was under body.skin-blue, div.dt-button-collection.
Using this info I added the following line to my ui.R code:
tags$head(tags$style(HTML(".skin-blue .dt-button-collection .buttons-columnVisibility .active a{background-color: #4d4d4d}")))
But this didn't appear to do anything. Any help on implementing this custom CSS/HTML into my dashboard would be appreciated.
Based on this answer, it looks like the button color needs to be set with background. I also used !important to override the DT button style, although this may not be the best practice.
Here's a small working example:
library(DT)
library(shiny)
ui <- basicPage(
tags$head(
tags$style(
HTML(
".dt-button.buttons-columnVisibility {
background: #FF0000 !important;
color: white !important;
opacity: 0.5;
}
.dt-button.buttons-columnVisibility.active {
background: black !important;
color: white !important;
opacity: 1;
}"
)
)
),
h2("The iris data"),
DT::dataTableOutput("mytable")
)
server <- function(input, output) {
output$mytable = DT::renderDataTable({
datatable(
iris, rownames = FALSE,
extensions = 'Buttons',
options = list(dom = 'Bfrtip', buttons = I('colvis'))
)
})
}
shinyApp(ui, server)
I'm creating a Shiny app in which I want to have a large (h1) formatted title and an action button right next to it, which when clicked on pops up a window with additional details and some other information. I got the button set up and working well (not included in the code). My problem is with the formatting of this line. Despite my best efforts the icon (an action button) gets pushed to a new row, even though it's in the same column as the dynamic text, and in the same h1 format as well. How could I achieve what I want?
library(shiny)
ui <- fluidRow(column(12, tags$h1(textOutput("chosen_date_fact"),
actionButton("scoping2",
label = icon("info-circle"),
style = "color: #000000; background-color: #ffffff; border-color: #ffffff"))))
server = function(input, output){
last_fact_date = '2017-07-16'
output$chosen_date_fact = renderText ({
date = as.Date(last_fact_date)
paste0('Details of', ' ', format(date,"%B"),' ', '(as of: ', date,')')
})
}
shinyApp(ui = ui, server = server)
Picture of the result: https://i.stack.imgur.com/gmhNM.jpg
Thank you in advance!
Something like this? Fore more examples visit another question i answered How to display widgets inline in shiny
library(shiny)
ui <- fluidRow(column(12, div(style="display: inline-block;",tags$h1(textOutput("chosen_date_fact"))),
actionButton("scoping2", label = icon("info-circle"), style = " color: #000000; background-color: #ffffff; border-color: #ffffff")
))
server = function(input, output){
last_fact_date = '2017-07-16'
output$chosen_date_fact = renderText ({
date = as.Date(last_fact_date)
paste0('Details of', ' ', format(date,"%B"),' ', '(as of: ', date,')')
})
}
shinyApp(ui = ui, server = server)