I am trying to create an R shiny app using the DT package. I would like to add information about the column header when the user toggles over it. Example: In "mtcars" data set, if a user toggles over 'mpg'column, they should be able to see a one-line definition for it. I searched for solutions online but could not find any. I would genuinely be grateful to you for helping me with this.
Also, I would appreciate it if anyone could send me links to some beautiful DT related apps.
You can do:
library(DT)
headerCallback <- c(
"function(thead, data, start, end, display){",
" var tooltips = ['tooltip1','tooltip2','tooltip3','tooltip4','tooltip5'];",
" for(var i=0; i<5; i++){",
" $('th:eq('+i+')',thead).attr('title', tooltips[i]);",
" }",
"}"
)
datatable(iris, rownames = FALSE,
options = list(
headerCallback = JS(headerCallback)
)
)
Related
I've been working for some days with Handsontable in Shiny and I got stuck in what I guess will be a very dumb question but I have not this much idea how to solve.
I have a Handsontable that has a custom function that allows searching and it works. It works but is not intuitive enough because you have to right-click on the table to pop the search option.
Because of this, I decided that I would like to have a textInput that does the same function but in a prettier way. I know that it should be related with an observeEvent of the input variable (input$searchId) but I have no idea of how to do it due to my lack of experience with Shiny and Handsontable.
This is the code from server.R that prints the table and that has a custom function that allows the user to search.
output$hot <-renderRHandsontable({rhandsontable(Dataset(),height = 600)%>%
hot_table( columnSorting = TRUE,highlightCol = TRUE, highlightRow = TRUE, search = TRUE) %>%
hot_context_menu(
customOpts = list(
search = list(name = "Search",
callback = htmlwidgets::JS(
"function (key, options) {
var aux = document.getElementById('searchId').value;
var srch = prompt(Search);
this.search.query(srch);
this.render();
}")))) })
And what I would like is to archive the same result but without having to right-click on the table and create a prompt.
Thank you so much,
Well I've been able to solve my problem. I've been inspired by this post
and then I got with something like:
js_search <- "
$(document).ready(setTimeout(function() {
document.getElementById('searchId').onchange = function(e){
var hot_instance = HTMLWidgets.getInstance(hot).hot
console.log('hola')
var aux = document.getElementById('searchId').value;
hot_instance.search.query(aux);
hot_instance.render();
}
}))
"
that has to be included in your ui.R with a tags$head(tags$script(HTML(js_search)))
That's all the problem I was having is that I ahd no idea of how to get the "this" from the custom operation in the server side I had before. Once you know that is hot_instance. where hot is the name of my table, I think is easy.
The DT package within R provides an amazing set of functions to create interactive tables within your Rmarkdown documents or Shiny Apps. The vignette / help page is very informative and will help with most problems. See here
However, when it comes down to changing the color of the stripes, I'm struggling to find a straightforward solution.
Based on the answer here, I came with the following to change the color of the stripes:
markets_list <- c("GC=F","SI=F","PL=F","CL=F","BZ=F","^TNX","^TYX","^VIX")
Now_Quotes <- getQuote(markets_list) %>%
dplyr::mutate(names = c("Gold","Silver","Platinum","Oil","Brent","Treas10Y","Treas30Y","VIX"))
datatable(Now_Quotes[,c(9,2)],
rownames = FALSE,
colnames = "",
options = list(dom = 't',bSort=FALSE,
columnDefs = list(list(className = 'dt-center', targets = c(0,1))),
rowCallback=JS('function(row,data) {if($(row)["0"]["_DT_RowIndex"] % 2 == 1) $(row).css("background","#737373")}'),
initComplete = JS("function(settings, json) {$(this.api().table().header()).css({'background-color': '#252525', 'color': '#fff'});}")))
Clearly this does not seem to be the right way, as it should be possible to change the colors based on simple css rules. Can someone please provide the right way. Thanks
I have data I wish to show in a flexdashboard in R. I build the datatable with DT::renderDataTable({DT::datatable(data(), options=list(scrollX=TRUE))})
This works just fine when showing something like 10 entries, but when I select the option to show 25 entries, I cannot scroll down to the bottom of the page and click on the second page button, next button, etc. I cannot scroll vertically like I could previously. I have tried the sScrollY = "300px" options, but this doesn't let the data table expand to fill the full page on my flexdashboard. The problem is rows of observations being cut off and inaccessible when I try to scroll in the y-direction.
I am wondering what I need to do to make datatables expand and fill as expected, as shown in https://shiny.rstudio.com/gallery/datatables-options.html
From the example, you can see how it is still possible to scroll up and down when you change the number of rows shown. I cannot do this in the new version of datatable. As of right now, I am limiting the number of rows displayed to 10...however, this is not a long term solution.
Any ideas are greatly appreciated. Thank you. Best, NF
I haven't been able to find a solution I am satisfied with yet, but for the interim, I am using the sScrollY = '75vh' arguement and building the datatable like this:
DT::renderDataTable({
DT::datatable(plot_data(), options = list(scrollX = TRUE, sScrollY = '75vh', scrollCollapse = TRUE), extensions = list("Scroller"))
})
At least this way the pagination is visible. If anyone has additional ideas, I'd love to hear them. Cheers for now. --Nate
I had the same problem, I could'nt make datatables expand. The problem was that all the datatables have the option autoWidth = FALSE by default, so you need to change that to autoWidth = TRUE.
Try something like this:
DT::renderDataTable({DT::datatable(data(), options=list(autoWidth = TRUE,scrollX=TRUE))})
After that you should fine with the Width manipulation.
Here is an example.
library(shiny)
library(shinydashboard)
library(DT)
ui <- dashboardPage(
dashboardHeader(title="Data Table"),
dashboardSidebar(
menuItem(text="Menu",icon=icon("bars"),
menuSubItem(text="Show datatable",tabName="ShowData", icon=icon("search")))
),
dashboardBody(
tabItems(
tabItem(tabName="ShowData",
box(DT::dataTableOutput("Data"),width = 12)))))
server <- shinyServer(function(input, output) {
output$Data<-DT::renderDataTable({DT::datatable(data(),options = list(autoWidth = TRUE,scrollX = TRUE))})
})
shinyApp(ui = ui, server = server)
Thanks for reporting this. As I've answered at rstudio/DT#818, the issue can be resolved by adding an option fillContainer = TRUE to DT::datatable().
I mean changing the chunck like below will be enough.
### renderDataTable (reactive)
```{r}
DT::renderDataTable(datatable(mydataset(), rownames = TRUE,
options = list(bPaginate = FALSE, searching = FALSE, info = FALSE),
fillContainer = TRUE))
```
The reason that using static data(DT::datatable()) works is fillContainer will be enabled by FlexDashBoard. However, under shiny mode, this feature fails to perform.
You may use: option = list(scrollY = 300, scrollCollapse = TRUE). I tried this in R Notebook and it works for me.
Inside the dashboardHeader, how can you programatically generate dropdown menu items?
dropdownMenu(
type = "notifications",
notificationItem(
text = "message",
icon = icon("welcome"),
status = "warning"
),
notificationItem(
text = "message",
icon = icon("welcome"),
status = "warning"
),
... #Generate lots more messages
What is the general method in R to generate messages, say from another function that takes in an argument which is the number of messages:
GenerateMessages <- function(number.of.messages) {
#Code to generate messages
}
What would be the code, would it be written in the UI or the Server functions in shiny, dashboard header?
I'll answer my own question since it goes beyond the basic dynamic tutorial. I really like this solution because my notifications and logic can go outside of my code, it shortened my app.R by hundreds of lines.
The general form is:
Code inside the UI function:
# Code to create outputs goes in dashboardHeader
dropdownMenuOutput("messages.type"),
dropdownMenuOutput("notifications.type"),
dropdownMenuOutput("tasks.type")
Code inside Server function:
# Code to generate headers
output$messages.type <- renderMenu(
dropdownMenu(type = "messages", .list = MessageGenerator())
)
output$notifications.type <- renderMenu(
dropdownMenu(type = "notifications", .list = NotificationsGenerator())
)
output$tasks.type <- renderMenu(
dropdownMenu(type = "tasks", .list = TasksGenerator())
)
The main logic is in the MessageGenerator() function. These functions generate a list required to render in the output. The data structure is from a data.frame containing the message information with the proper headers.
This solution scales to generate messages of the three types Messages, Tasks, and Notifications using three functions MessageGenerator(), TasksGenerator(), NotificationsGenerator().
error
sqlQuery(con,"insert into samp values('",input$text1,"',",input$text2,")");
Error in sqlQuery(con, "insert into samp values('", input$text1, "',", :
object 'input' not found
ui.R
library(shiny)
shinyUI(fluidPage(mainPanel(textInput("text1"," ",value = " "),
numericInput("text2"," ",value = " "), actionButton("b1", label = "select"),
tableOutput("txt1"))))
server.R
shinyServer(function(input,output){output$txt1<-renderTable({input$b1
if(input$b1==0 )return()isolate({con<-odbcConnect("sample",uid="amma",pwd ="amma")sqlTables(con)sqlQuery(con,"insertintosampvalues('",input$text1,"',",input$text2,")");sqlQuery(con,"select * from samp"); })})})
how to write the insert query by receving values from an interface?
Okay, I added your code to a gist so it's more readable and runnable via shiny.
It can be run via:
shiny::runGist("https://gist.github.com/corynissen/d52bdca7b7a8a1a8512a")
I added a library(RODBC) call at the top and paste0 around the strings you were trying to concatenate. See if that helps... I can't really test it without the db.