the

the

关注
发信
关注(28)粉丝(399)

从html中的交互表更新图

本文介绍了从html中的交互表更新图的处理方法，对大家解决问题具有一定的参考价值，需要的朋友们下面随着小编来一起学习吧！

问题描述

我想做的是在html过滤后根据(DT-)表的输出来更新绘图.

例如-这是html中为maz过滤的表的屏幕截图:

For example - here is a screenshot of the table filtered for maz in the html:

我希望将散点图更新为仅显示过滤后的表格中显示的值.

这可能吗?我知道我可以使用闪亮的网络应用来实现类似的目的，但是有可能将一些闪亮的代码嵌入到其中的HTML来实现这一点? (我对使用Shiny/html的经验非常有限，因此请感谢任何指针/想法).

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).

我正在使用R-markdown(和这是所产生的html的链接):

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

推荐答案

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

Contrary to my first assessment, it is actually possible. There are multiple additions to your code. I will go through them chronologically:

  1. 您需要在yaml标头中添加runtime: shiny，以在任何R-markdown文件中开始闪亮
  2. 可选:我添加了一些CSS样式，以防您需要调整闪亮的应用程序以适合特定的屏幕尺寸
  3. 发光的文档包含一个UI部分，您可以在其中配置用户界面.通常，您只需为此使用fluidPage函数
  4. 下一部分是server.r部分，其中发生了有趣的事情:
    • 我们将您的DT::datatable分配给output对象(通常是列表)
    • 对于每个分配，我们需要设置一个shinyID，在ui.r中进行配置，然后添加output$mytable
    • 我添加了element，其中显示了选择要调试的行
    • 所有更改的核心是input$mytable_rows_all.我们在ui.r函数中可以调用在ui.r中设置的所有控件.在这种特殊情况下，mytable指的是我在UI部分中为DT::datatable设置的shinyID，而rows_all告诉Shiny接受所示表中的所有行号.
    • 这样，我们就可以使用mtcars[input$mytable_rows_all,]
      • 来对数据进行子集化
  1. You need to add runtime: shiny in the yaml-header to start shiny in any R-markdown file
  2. Optional: I added some css style in case you need to adjust your shiny application to fit into certain screen sizes
  3. Shiny-documents contain an UI-part, where you configure the user interface. Usually you just use a fluidPage function for that
  4. The next part is the server.r-part where the interesting stuff happens:
    • We assign, i.e., your DT::datatable to an output-object (usually a list)
    • For each assignment we need to set a shinyID which we configure in ui.r and then add, i.e, output$mytable
    • I added an element which 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 the ui.r can be called inside the render-functions. In this particular case mytable refers to the shinyID I set for the DT::datatable in the UI-part and rows_all tells shiny to take all the rownumbers inside the shown table.
    • That way we just subset the data using mtcars[input$mytable_rows_all,]

要学习光泽，我建议 Rstudio的教程.学习并忘记所有内容后，我建议您使用Rstudio提供的出色的备忘单

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

这篇关于从html中的交互表更新图的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持！

09-27 16:48
Powered by LMLPHP ©2024 the 0.002093