从 html 中的交互式 table 更新情节

Question

我想做的是 在 html[= 中过滤后，根据 (DT-)table 的输出更新绘图31=].

例如 - 这是 html 中针对 maz 筛选的 table 的屏幕截图：

我希望散点图更新为仅显示过滤后的值 table。

这可能吗？我知道我可以使用 shiny web app 来实现类似的目的，但是是否可以将一些闪亮的代码嵌入 html 来实现这一点？（我使用 shiny/html 的经验非常有限，所以我将不胜感激任何 pointers/ideas）。

我正在使用 R-markdown（和 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 ```

Answer 1

与我的第一个评估相反，这实际上是可能的。您的代码有多个添加项。我将按时间顺序浏览它们：

您需要在 yaml-header 中添加 runtime: shiny 才能在任何 R-markdown 文件中开始发光
可选：我添加了一些 css 样式，以防您需要调整闪亮的应用程序以适应特定屏幕尺寸
Shiny-documents 包含一个 UI-part，您可以在其中配置用户界面。通常你只需要使用 fluidPage 函数即可
下一部分是 server.r 部分，有趣的事情发生了：
- 我们将您的 DT::datatable 分配给 output-object（通常是一个列表）
- 对于每个赋值，我们需要设置一个shinyID，我们在ui.r中配置，然后添加，即output$mytable
- 我添加了一个 element 来显示选择了哪些行进行调试
- 所有变化的核心是 input$mytable_rows_all。我们在 ui.r 中设置的所有控件都可以在 render 函数中调用。在这种特殊情况下，mytable 指的是我在 UI-part 中为 DT::datatable 设置的 shinyID 并且 rows_all 告诉 shiny 获取显示的 table。
- 这样我们就可以使用 mtcars[input$mytable_rows_all,]

要学习 shiny 我推荐 Rstudio's tutorial. After learning and forgetting everything again I advise you to use the wonderful cheatsheet provided by Rstudio

整个修改后的代码如下所示：

---
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
})
```

从 html 中的交互式 table 更新情节

Update plot from interactive table in html

css

r

shiny

plotly

r-plotly