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)
)
)
I'd like to generate a popup box in R with six inputs.
I prefer to have all the inputs in the same pop-up box because most of the time most will be the default, and I'd like to quickly see at a glance that they are all correct rather than having to click through six popups.
I know dlg_input in the svDialogs package gives a popup box, but I don't see an option to modify it to allow for multiple inputs. Here's the code for dlg_input:
function (message = "Enter a value", default = "", ..., gui = .GUI)
{
if (!guistartUI("dlginput",call=match.call(),default=default,
msg="Displayingamodalinputdialogbox",msg.no.ask="Amodalinputdialogboxwasby−passed"))
return(invisible(gui))
if(!length(message))
message<−"Enter a value"
message<−paste(as.character(message),collapse="\n")
if(is.null(default)){
default<−""
}
else {
default<−as.character(default)[1]
}
gui$setUI(args = list(message = message, default = default))
UseMethod("dlgInput", gui)
}
<environment: namespace:svDialogs>
I assume there's a way to modify this code to give me what I want, but it's lost on me. Any help would be much appreciated.
I am looking to add the custom interaction seen at http://dygraphs.com/gallery/#g/interaction under "Custom interaction model" into my Shiny web app.
As far as I understand it, this requires attaching some JS to the page and setting the interaction model on the graph:
interactionModel : {
'mousedown' : downV3,
'mousemove' : moveV3,
'mouseup' : upV3,
'click' : clickV3,
'dblclick' : dblClickV3,
'mousewheel' : scrollV3
}
However, interactionModel does not seem to be listed as a parameter in the dyOptions function on the R side.
Is there a way to work around this?
Update:
Looking at the source for dyOptions, it seems that options can be modified directly:
g <- dyGraph(series)
g$x$attr$option <- "Value"
However, setting the interactionModel here does not seem to work.
See: https://github.com/rstudio/dygraphs/blob/master/R/options.R
Update:
You can indeed set the options using:
g$x$attrs$option <- "Value" # Note that it is "attrs", not "attr"
This can be used to switch off the interaction mode:
graph$x$attrs$interactionModel <- "{}"
The remaining problem is passing JS function references via JSON to the page.
You can use the JS function to pass JavaScript over JSON to the client.
In ui.R:
tags$head(tags$script(src="interaction.js"))
In server.R:
g <- dygraph(series(), main = "Graph", xlab = "Date", ylab = "Amount") %>%
dySeries(label = "X")
g$x$attrs$interactionModel <- list(
mousedown = JS("downV3"),
mousemove = JS("moveV3"),
mouseup = JS("upV3"),
click = JS("clickV3"),
dblclick = JS("dblClickV3"),
mousewheel = JS("scrollV3"))
I am using R shiny to build web applications, and some of them are leveraging the great leaflet features.
I would like to create a customed and advanced popup, but I do not know how to proceed.
You can see what I can do in the project I created for this post on github, or directly in shinyapp.io here
The more complex the popup is, the weirdest my code is, as I am sort of combining R and html in a strange way (see the way I define my custompopup'i' in server.R)..
Is there a better way to proceed? What are the good practices to build such popups? If I plan to display a chart depending on the marker being clicked, should I build them all in advance, or is that possible to build them 'on the fly'? How can I do that?
Many thanks in advance for your views on this, please do not hesitate to share your answer here or to directly change my github examples!
Regards
I guess this post still has some relevance. So here is my solution on how to add almost any possible interface output to leaflet popups.
We can achieve this doing the following steps:
Insert the popup UI element as character inside the leaflet standard popup field. As character means, it is no shiny.tag, but merely a normal div. E.g. the classic uiOutput("myID") becomes <div id="myID" class="shiny-html-output"><div>.
Popups are inserted to a special div, the leaflet-popup-pane. We add an EventListener to monitor if its content changes. (Note: If the popup disappears, that means all children of this div are removed, so this is no question of visibility, but of existence.)
When a child is appended, i.e. a popup is appearing, we bind all shiny inputs/outputs inside the popup. Thus, the lifeless uiOutput is filled with content like it's supposed to be. (One would've hoped that Shiny does this automatically, but it fails to register this output, since it is filled in by Leaflets backend.)
When the popup is deleted, Shiny also fails to unbind it. Thats problematic, if you open the popup once again, and throws an exception (duplicate ID). Once it is deleted from the document, it cannot be unbound anymore. So we basically clone the deleted element to a disposal-div where it can be unbound properly and then delete it for good.
I created a sample app that (I think) shows the full capabilities of this workaround and I hope it is designed easy enough, that anyone can adapt it. Most of this app is for show, so please forgive that it has irrelevant parts.
library(leaflet)
library(shiny)
runApp(
shinyApp(
ui = shinyUI(
fluidPage(
# Copy this part here for the Script and disposal-div
uiOutput("script"),
tags$div(id = "garbage"),
# End of copy.
leafletOutput("map"),
verbatimTextOutput("Showcase")
)
),
server = function(input, output, session){
# Just for Show
text <- NULL
makeReactiveBinding("text")
output$Showcase <- renderText({text})
output$popup1 <- renderUI({
actionButton("Go1", "Go1")
})
observeEvent(input$Go1, {
text <<- paste0(text, "\n", "Button 1 is fully reactive.")
})
output$popup2 <- renderUI({
actionButton("Go2", "Go2")
})
observeEvent(input$Go2, {
text <<- paste0(text, "\n", "Button 2 is fully reactive.")
})
output$popup3 <- renderUI({
actionButton("Go3", "Go3")
})
observeEvent(input$Go3, {
text <<- paste0(text, "\n", "Button 3 is fully reactive.")
})
# End: Just for show
# Copy this part.
output$script <- renderUI({
tags$script(HTML('
var target = document.querySelector(".leaflet-popup-pane");
var observer = new MutationObserver(function(mutations) {
mutations.forEach(function(mutation) {
if(mutation.addedNodes.length > 0){
Shiny.bindAll(".leaflet-popup-content");
};
if(mutation.removedNodes.length > 0){
var popupNode = mutation.removedNodes[0].childNodes[1].childNodes[0].childNodes[0];
var garbageCan = document.getElementById("garbage");
garbageCan.appendChild(popupNode);
Shiny.unbindAll("#garbage");
garbageCan.innerHTML = "";
};
});
});
var config = {childList: true};
observer.observe(target, config);
'))
})
# End Copy
# Function is just to lighten code. But here you can see how to insert the popup.
popupMaker <- function(id){
as.character(uiOutput(id))
}
output$map <- renderLeaflet({
leaflet() %>%
addTiles() %>%
addMarkers(lat = c(10, 20, 30), lng = c(10, 20, 30), popup = lapply(paste0("popup", 1:3), popupMaker))
})
}
), launch.browser = TRUE
)
Note: One might wonder, why the Script is added from the server side. I encountered, that otherwise, adding the EventListener fails, because the Leaflet map is not initialized yet. I bet with some jQuery knowledge there is no need to do this trick.
Solving this has been a tough job, but I think it was worth the time, now that Leaflet maps got some extra utility. Have fun with this fix and please ask, if there are any questions about it!
The answer from K. Rohde is great, and the edit that #krlmlr mentioned should also be used.
I'd like to offer two small improvements over the code that K. Rohde provided (full credit still goes to K. Rohde for coming up with the hard stuff!). Here is the code, and the explanation of the changes will come after:
library(leaflet)
library(shiny)
ui <- fluidPage(
tags$div(id = "garbage"), # Copy this disposal-div
leafletOutput("map"),
div(id = "Showcase")
)
server <- function(input, output, session) {
# --- Just for Show ---
output$popup1 <- renderUI({
actionButton("Go1", "Go1")
})
observeEvent(input$Go1, {
insertUI("#Showcase", where = "beforeEnd",
div("Button 1 is fully reactive."))
})
output$popup2 <- renderUI({
actionButton("Go2", "Go2")
})
observeEvent(input$Go2, {
insertUI("#Showcase", where = "beforeEnd", div("Button 2 is fully reactive."))
})
output$popup3 <- renderUI({
actionButton("Go3", "Go3")
})
observeEvent(input$Go3, {
insertUI("#Showcase", where = "beforeEnd", div("Button 3 is fully reactive."))
})
# --- End: Just for show ---
# popupMaker is just to lighten code. But here you can see how to insert the popup.
popupMaker <- function(id) {
as.character(uiOutput(id))
}
output$map <- renderLeaflet({
input$aaa
leaflet() %>%
addTiles() %>%
addMarkers(lat = c(10, 20, 30),
lng = c(10, 20, 30),
popup = lapply(paste0("popup", 1:3), popupMaker)) %>%
# Copy this part - it initializes the popups after the map is initialized
htmlwidgets::onRender(
'function(el, x) {
var target = document.querySelector(".leaflet-popup-pane");
var observer = new MutationObserver(function(mutations) {
mutations.forEach(function(mutation) {
if(mutation.addedNodes.length > 0){
Shiny.bindAll(".leaflet-popup-content");
}
if(mutation.removedNodes.length > 0){
var popupNode = mutation.removedNodes[0];
var garbageCan = document.getElementById("garbage");
garbageCan.appendChild(popupNode);
Shiny.unbindAll("#garbage");
garbageCan.innerHTML = "";
}
});
});
var config = {childList: true};
observer.observe(target, config);
}')
})
}
shinyApp(ui, server)
The two main changes:
The original code would only work if the leaflet map is initialized when the app first starts. But if the leaflet map is initialized later, or inside a tab that isn't initially visible, or if the map gets created dynamically (for example, because it uses some reactive value), then the popups code won't work. In order to fix this, the javasript code needs to be run in htmlwidgets:onRender() that gets called on the leaflet map, as you can see in the code above.
This isn't about leaflet, but more of a general good practice: I wouldn't use makeReactiveBinding() + <<- generally. In this case it's being used correctly, but it's easy for people to abuse <<- without understanding what it does so I prefer to stay away from it. An easy almost drop-in replacement for that can be to use text <- reactiveVal(), which would be a better approach in my opinion. But even better than that in this case is instead of using a reactive variable, it's simpler to just use insertUI() like I do above.
Is there anyway to have select row working with dataTables in Shiny?
http://datatables.net/examples/api/select_row.html
This post in shiny-discuss seems to indicate that it is not possible, but it's quite an old post:
https://groups.google.com/forum/#!topic/shiny-discuss/_zNZMR2gHn0
Anyone have a working example in gist or elsewhere?
Maybe the version you are using its a little old. Look at this: http://datatables.net/reference/api/row()
Try this:
.row() function makes it possible to get the data when a particular row is clicked.
shinyServer(function(input, output) {
output$table_data <- DT::renderDataTable({
datatable(df,
escape = FALSE,
callback = JS(
'table.on("click.dt","tr",function() {
var data1 =table.row(this).data();
console.log(data1);
})'
))
})
})