问题
What I would like to be able to do is to update the plot based on the output from the (DT-)table after filtering in the html.
For example - here is a screenshot of the table filtered for maz in the html:
I would like the scatter plot to update to only show the values shown in the filtered table.
Is this possible? I know I could achieve something like this using a shiny web app, but is it possible to embed some shiny code into the html to achieve this? (I have very limited experience using shiny/html so would be grateful for any pointers/ideas).
I am using R-markdown (and here is a link to the html produced):
---
title: "Filter interative plots from table results"
date: "`r format(Sys.time(), '%B %e, %Y')`"
output:
html_notebook:
theme: flatly
toc: yes
toc_float: yes
number_sections: true
df_print: paged
html_document:
theme: flatly
toc: yes
toc_float: yes
number_sections: true
df_print: paged
---
```{r setup, include=FALSE, cache=TRUE}
library(DT)
library(plotly)
library(stringr)
data(mtcars)
```
# Clean data
## Car names and models are now a string: "brand_model" in column 'car'
```{r include=FALSE}
mtcars$car <- rownames(mtcars)
mtcars$car <- stringr::str_replace(mtcars$car, ' ', '_')
rownames(mtcars) <- NULL
```
# Interactive table using DT
```{r rows.print=10}
DT::datatable(mtcars,
filter = list(position = "top"),
selection="none", #turn off row selection
options = list(columnDefs = list(list(visible=FALSE, targets=2)),
searchHighlight=TRUE,
pagingType= "simple",
pageLength = 10, #default length of the above options
server = TRUE, #enable server side processing for better performance
processing = FALSE)) %>%
formatStyle(columns = 'qsec',
background = styleColorBar(range(mtcars$qsec), 'lightblue'),
backgroundSize = '98% 88%',
backgroundRepeat = 'no-repeat',
backgroundPosition = 'center')
```
# Plot disp against mpg using plotly
```{r fig.width=8, fig.height=8}
p <- plot_ly(data = mtcars,
x = ~disp,
y = ~mpg,
type = 'scatter',
mode = 'markers',
text = ~paste("Car: ", car, "\n",
"Mpg: ", mpg, "\n"),
color = ~mpg,
colors = "Spectral",
size = ~-disp
)
p
```
回答1:
Contrary to my first assessment, it is actually possible. There are multiple additions to your code. I will go through them chronologically:
- You need to add
runtime: shinyin the yaml-header to start shiny in any R-markdown file - Optional: I added some css style in case you need to adjust your shiny application to fit into certain screen sizes
- Shiny-documents contain an UI-part, where you configure the user interface. Usually you just use a
fluidPagefunction for that - The next part is the
server.r-part where the interesting stuff happens:- We assign, i.e., your
DT::datatableto anoutput-object (usually a list) - For each assignment we need to set a
shinyIDwhich we configure inui.rand then add, i.e,output$mytable - I added an
elementwhich shows which rows are selected for debugging - The heart of all the changes is
input$mytable_rows_all. All the controls we set up in theui.rcan be called inside therender-functions. In this particular casemytablerefers to theshinyIDI set for theDT::datatablein the UI-part androws_alltells shiny to take all the rownumbers inside the shown table. - That way we just subset the data using
mtcars[input$mytable_rows_all,]
- We assign, i.e., your
To learn shiny I recommend Rstudio's tutorial. After learning and forgetting everything again I advise you to use the wonderful cheatsheet provided by Rstudio
The whole modified code looks like this:
---
title: "Filter interative plots from table results"
date: "`r format(Sys.time(), '%B %e, %Y')`"
runtime: shiny
output:
html_document:
theme: flatly
toc: yes
toc_float: yes
number_sections: true
df_print: paged
html_notebook:
theme: flatly
toc: yes
toc_float: yes
number_sections: true
df_print: paged
---
<style>
body .main-container {
max-width: 1600px !important;
margin-left: auto;
margin-right: auto;
}
</style>
```{r setup, include=FALSE, cache=TRUE}
library(stringr)
data(mtcars)
```
# Clean data
## Car names and models are now a string: "brand_model" in column 'car'
```{r include=FALSE}
mtcars$car <- rownames(mtcars)
mtcars$car <- stringr::str_replace(mtcars$car, ' ', '_')
rownames(mtcars) <- NULL
```
# Plot disp against mpg using plotly
```{r}
library(plotly)
library(DT)
## ui.r
motor_attributes=c('Cylinder( shape): V4','Cylinder( shape): V6','Cylinder( shape): V8','Cylinder( shape): 4,Straight Line','Cylinder( shape): 6,Straight Line','Cylinder( shape): 8,Straight Line','Transmission: manual','Transmission: automatic')
fluidPage(# selectizeInput('cyl','Motor characteristics:',motor_attributes,multiple=TRUE,width='600px'),
downloadLink('downloadData', 'Download'),
DT::dataTableOutput('mytable'),
plotlyOutput("myscatter"),
htmlOutput('Selected_ids'))
### server.r
output$mytable<-DT::renderDataTable({
DT::datatable(mtcars,
filter = list(position = "top"),
selection='none', #list(target='row',selected=1:nrow(mtcars)), #turn off row selection
options = list(columnDefs = list(list(visible=FALSE, targets=2)),
searchHighlight=TRUE,
pagingType= "simple",
pageLength = 10, #default length of the above options
server = TRUE, #enable server side processing for better performance
processing = FALSE)) %>%
formatStyle(columns = 'qsec',
background = styleColorBar(range(mtcars$qsec), 'lightblue'),
backgroundSize = '98% 88%',
backgroundRepeat = 'no-repeat',
backgroundPosition = 'center')
})
output$Selected_ids<-renderText({
if(length(input$mytable_rows_all)<1){
return()
}
selected_rows<-as.numeric(input$mytable_rows_all)
paste('<b> #Cars Selected: </b>',length(selected_rows),'</br> <b> Cars Selected: </b>',
paste(paste('<li>',rownames(mtcars)[selected_rows],'</li>'),collapse = ' '))
})
output$myscatter<-renderPlotly({
selected_rows<-as.numeric(input$mytable_rows_all)
subdata<-mtcars[selected_rows,]
p <- plot_ly(data = subdata,
x = ~disp,
y = ~mpg,
type = 'scatter',
mode = 'markers',
text = ~paste("Car: ", car, "\n",
"Mpg: ", mpg, "\n"),
color = ~mpg,
colors = "Spectral",
size = ~-disp
)
p
})
```
来源：https://stackoverflow.com/questions/50406939/update-plot-from-interactive-table-in-html