Using a ShinyR and data table we can create an interactive plot. When a user select a row in the data table it displayed with specific color and shape in the graph. When we un-select the row, point gain normal conditions.
Example modified from (Shiny apps).
Additionally, we can identify particular points (we are interested in) on the graph (Using nearPoints)
I would like a user to be able un-select the row by clicking on particular point on the graph. Once user clicked the point on the graph it will gain normal appearance.
However, I can’t find function to make it work.
There is a proxy and selectRows function in new DT library (the DT-package)(but for Mac it is unavailable). Example
Another option would be to write and option javascript code in callback, however my knowledge is limited in that area.
Will be thankful for any comments and suggestions.
UI
library(shiny)
library(DT)
fluidPage(
title = 'Select Table Rows',
fluidRow(
column(6, DT::dataTableOutput('x1')),
column(6, plotOutput('x2', height = 500,click = "plot_click"),
verbatimTextOutput("info"))
)
)
Server
shinyServer(function(input, output, session) {
output$x1 = DT::renderDataTable(cars, server = FALSE)
# highlight selected rows in the scatterplot
output$x2 = renderPlot({
s = input$x1_rows_selected
par(mar = c(4, 4, 1, .1))
plot(cars)
if (length(s)) points(cars[s, , drop = FALSE], pch = 19, cex = 2)
})
output$info <- renderPrint({
paste("Selected point row.name - ", row.names(nearPoints(cars, input$plot_click, xvar = "speed", yvar = "dist")), sep="")
})
})
With a new version of DT it works perfect with proxy
proxy = dataTableProxy('x1')
observeEvent(input$plot_click, {
removeRow <- as.numeric(row.names(nearPoints(cars, input$plot_click, xvar = "speed", yvar = "dist")))
selectRows(proxy, input$x1_rows_selected[!input$x1_rows_selected %in% removeRow])
})
Related
I want to export a table displayed in a shiny app using datatable to a PDF. For this purpose, I am using the export button provided by datatable, see the code below.
However, I want to make a little modification to the table shown in the PDF. I want to add some space to the left of the first column and to the right of the last column.
I couldn't find a datatable option to control this. It seems, I have to use the pdfmake library to specify this via the customize argument. You can see something I tried in the code below, however commented out, as it does not work. I tried a lot of other stuff but nothing worked. Unfortunately, I have almost no experience with JavaScript, that's why I hope someone can help me here.
library(shiny)
library(DT)
words <- c("water", "apple", "house", "family", "basket")
set.seed(42)
data <- data.frame(column1 = sample(words, 10, TRUE),
column2 = sample(words, 10, TRUE),
column3 = sample(words, 10, TRUE))
ui <- fluidPage(
DTOutput("dtable")
)
server <- function(input, output, session) {
output$dtable <- renderDT({
datatable(data,
rownames = FALSE,
extensions = "Buttons",
options = list(
dom = "Bfrtip",
buttons = list(
list(
extend = "pdf",
exportOptions = list(orthogonal = "export"),
filename = "Filename",
title = "Title",
# customize = JS("function(doc) { doc.content.table.margin = [50, 0, 50, 0]; }")
orientation = "landscape")
)
)
)
})
}
shinyApp(ui, server)
Hello I am new to RShiny, and I'm trying to build an application for a project.
I have 5 images in my UserInterface I would like to make them clickable : When you click on image, it displays a subset of the dataframe in the mainPanel.
My Dataframe contains a column called "Mood",and there are 5 moods ("Party and Dance", "Rap","Happy vibes" , "Sunday Chillout" and "Roadtrip music"). Each image should display rows of one of the moods.
This is the code I have used for now :
UI.R
shinyUI(
fluidPage( useShinyjs(),
headerPanel(
h1(img(src="logo.png",height = 70, width = 70),"Quelle est votre humeur du moment ?",
style = "font-weight: 500; color: #FFFFFF;")),
dashboardSidebar(
fluidRow(
column(width=11.9, align="center",
selectInput("Mood", label= "Choose your Mood : ",
choices = test$Mood),
img(id="my_img1",src="party.jfif",width="19.5%",style="cursor:pointer;"),
img(id="my_img2",src="cluster 2.jpg",width="19.5%",style="cursor:pointer;"),
img(id="my_img3",src="roadtrip.jpg",width="19.5%",style="cursor:pointer;"),
img(id="my_img4",src="rap.jfif",width="19.5%",style="cursor:pointer;"),
img(id="my_img5",src="sunday.jpg",width="19.5%",style="cursor:pointer;")),
column(11.2, align="center",
mainPanel(br(),br(),DT::dataTableOutput("dynamic"), width = "100%"))
))))
Server.R
For now I have just managed to link the Select box to the subset dataframe, but I would like to get rid of it and only use the images instead.
shinyServer(function(input,output){
output$dynamic<- DT::renderDataTable({
data <- DT::datatable(test[test$Mood ==input$Mood, c("Song","Artist","Mood","Listen to song"), drop = FALSE], escape = FALSE)
data
})
})
I have tried lots of combinations but all of them failed, because I don't have basic skills of how Shinyjs works.
My last attempt: (I thought about doing this manually for each image but it's not working of course)
shinyServer(function(input,output){
onclick("my_img1", { print(datatable(test[test$Mood =="Party and dance", c("Song","Artist","Mood","Listen to song"), drop = FALSE], escape = FALSE))})
})
Any feedback would be much appreciated !! Thank you !
This is what my interface looks like
It has been a while since I used Shiny so I may be a bit rusty. But here is a possible approach to tackling your issue: You could use a reactiveValue to keep track of which mood is selected, and update that variable whenever one of the images is clicked. Then use that reactiveValue in subsetting your dataframe, as shown below. Hope this helps!
library(shiny)
library(shinyjs)
df = data.frame(mood = c('mood1','mood1','mood1','mood2','mood2','mood2'),
example = c('dog',' cat','bunny','elephant','t-rex','not dog'))
ui <- shinyUI(
fluidPage(
useShinyjs(),
img(id="my_img1",src="img1.png",width="19.5%",style="cursor:pointer;"),
img(id="my_img2",src="img1.png",width="19.5%",style="cursor:pointer;"),
DT::dataTableOutput("dynamic")
)
)
server <- shinyServer(function(input,output){
selected_mood <- reactiveVal()
shinyjs::onclick("my_img1", selected_mood('mood1'))
shinyjs::onclick("my_img2", selected_mood('mood2'))
output$dynamic<- DT::renderDataTable({
req(selected_mood())
df[df$mood == selected_mood(),]
})
})
shinyApp(ui, server)
I created a simple app which includes a selectInput widget and a bar plot in rCharts. What I want to accomplish is to create the plot with a legend with all three books but by default show only a book which is chosen by the widget. So when I change from Book1 to Book2 the plot will show initially only info about Book2 but legend plot will include Book1 and Book3 (both disabled by default) - if I want to I could choose Book1 or Book3 anytime. I believe it is JS problem so I tried to solve it but nothing changed. Any ideas how to handle it? Thanks.
library(shiny)
library(rCharts)
books <- c('Book1','Book2','Book3')
df <- data.frame(book = rep(books, each = 10),
year = rep(2000:2009,3),
sale = sample(100:1000, 30, replace = T))
ui <- shinyUI(
fluidPage(
HTML("
<script>
$( document ).ready(function() {
if ( $(\"select#book div.selectize-dropdown div[data-value='Book1']\").hasClass('selected')) {
console.log('true');
$('#nvd3Plot .nv-legend g.nv-series').eq(1).addClass('disabled');
$('#nvd3Plot .nv-legend g.nv-series').eq(2).addClass('disabled');
}
else {
console.log('false');
}
});
</script>"),
selectInput('book', 'Select a book', choices = books, selected = 'Book1'),
showOutput("nvd3Plot", "nvd3")
)
)
server <- function(input, output, session) {
output$nvd3Plot <- renderChart2({
chartObject <- nPlot(sale ~ year, group = "book", data = df, type = "multiBarChart")
chartObject$chart(
showControls = FALSE
)
return(chartObject)
})
}
shinyApp(ui, server)
Update
I found this solution but actually I don't have any idea how to implement it in R.
Using the answer from here, you could use a custom message handler to programatically click on the legend.
You could add, in your ui.R:
tags$script('
Shiny.addCustomMessageHandler("change_selected_book",
function(book) {
d3.select("g.nv-legendWrap").selectAll("g.nv-series.disabled")
.each(function(d) {
this.dispatchEvent(new Event("click"));
});
d3.select("g.nv-legendWrap").selectAll("g.nv-series").filter(
function(d) { return d.key != book; })
.each(function(d) {
this.dispatchEvent(new Event("click"));
});
});
')
and in your server.R:
observe({
session$sendCustomMessage(type = "change_selected_book", input$book)
})
The code clicks on all of the disabled series, and once all series are enabled, it clicks on the legend of all the books except the one the user has selected to disable them.
One drawback is that the selectInput element is created before the graph so it initially displays all three books until the user selects one.
Is there any way to click an element in a dataTableOutput and then jump to a different tabPanel?
I know using escape = FALSE could add url to the table element. But how to add "jumping to a different tab" to a dataTableOutput element? And passing values?
Please take a look at my reproducible example. Thanks.
library(shiny)
server <- function(input, output) {
X = data.frame(
ID = c(
"<a href = 'http://www.google.com'> google </a>",
"Click here then Jump to tab2 and pass x=2 and y=2 to tab2",
"Click here then Jump to tab2 and pass x=3 and y=4 to tab2"
),
x = c(1, 2, 3),
y = c(10, 2, 4)
)
output$datatable = renderDataTable({X}, escape = FALSE,
options = list(
paging = FALSE,
searching = FALSE,
filtering = FALSE,
ordering = FALSE
))
output$text = renderText(paste("X = ", "Y = "))
}
ui <- fluidPage(tabsetPanel(
tabPanel("tab1", dataTableOutput("datatable")),
tabPanel("tab2", textOutput("text"))
))
shinyApp(ui = ui, server = server)
Luckily, there is no need for JS, or jQuery, since all those things can be done on Shinyserver side.
Okay, where do we start... DT has an inbuild callback feature to acess which rows/columns/cells were clicked by the user. See example here. Then there is no reason to "send" this information to tab2, but we can just do with this information what we wanted to. Like setting the text in tab2 appropriately. In order to change tabs, shiny has the updateTabsetPanel function that lets you change tabs without any hyperlinks.
Kind of a changelog:
insertet the observeEvent for functionality.
added selected and server attribute to get a single row callback
added Id to tabsetPanel to enable communication.
got rid of the google link and escape.
Code:
library(shiny)
library(DT)
server <- function(input, output, session) {
X = data.frame(
ID = c("Click here then Jump to tab2 and pass x=1 and y=10 to tab2",
"Click here then Jump to tab2 and pass x=2 and y=2 to tab2",
"Click here then Jump to tab2 and pass x=3 and y=4 to tab2"),
x = c(1,2,3),
y = c(10,2,4)
)
output$datatable = renderDataTable({X}, selection = "single", server = FALSE,
options = list(paging=FALSE,
searching=FALSE,
filtering=FALSE,
ordering=FALSE)
)
observeEvent(input$datatable_rows_selected, {
row <- input$datatable_rows_selected
output$text <- renderText({paste("X =", X[row, "x"], "Y =", X[row, "y"])})
updateTabsetPanel(session, "mainPanel", selected = "tab2")
})
}
ui <- fluidPage(
tabsetPanel(id = "mainPanel",
tabPanel("tab1",dataTableOutput("datatable")),
tabPanel("tab2",textOutput("text"))
)
)
shinyApp(ui = ui, server = server)
I was pretty sure that there is an answer already out there to my question,
but no matter how hard I searched I couldn't find any solution that could work in this case. So if this is considered to be trivial, please don't shoot.
Now here's the problem:
Assuming we are rendering a dataTable with Shiny, I would like to grab the id of every cell (rowID+columnID) when I hover over over the cell and present dynamically output from the underlying datasets.
I know that there are already solutions for mouseovers, such as shinyBS or this example here:
#server.R:
shinyServer(function(input, output) {
dat <- list(iris,cars)
output$tabset <- renderUI({
tabs <- list()
for(i in c(1,2)){
id <- paste("id",i, sep="")
tabs[[i]] <- tabPanel(title=id,DT::dataTableOutput(outputId=id)) #dynamic panels
}
do.call(tabsetPanel,c(tabs, id='Panel'))
})
lapply(1:2,function(i){
id <- paste("id",i, sep="")
output[[id]] <- DT::renderDataTable({
dat[[i]]},
extensions = c('Scroller'),
options=list(deferRender=TRUE, dom='T<"clear">fitrS', scrollY=540, searchHighlight = TRUE,
scrollCollapse=TRUE, autoWidth = TRUE,
columnDefs = list(list(width = '60%', targets = '_all',
render = JS("function(data, type, row, meta) {",
"return type === 'display' && data.length > 5 ?",
"'<span title=\"' + data + '\">' + data.substr(0, 5) + '...</span>' : data;",
"}"
)))),
callback = JS('table.page(3).draw(false);'),
escape=FALSE, rownames=TRUE,class = 'table-condensed', server=TRUE)
})
})
And the ui.R
#ui.R:
library(shiny)
library(DT)
ui <- fluidPage(
uiOutput('tabset')
)
There is a mouseover that trims a cell if its length is 5 or more. What I would like to do now is to see if it the highlighted cell comes from panel with 'id1', is from column Sepal.Length and the mouseover should show data from panel 'id2', that had the same rowId as in Sepal.Length and should show the data from column dist.
Basically I want don't want to present static content or just modify the string that is already in that cell, but rather dynamically present additional content depending on what cell has been hovered over.
Is that possible with Shiny and JavaScript?
Thanks for any input.