时间戳

首页 > 解决方案 > 将来自闪亮的 BrushedPoints() 的输入转换为数据框

r - 将来自闪亮的 BrushedPoints() 的输入转换为数据框

问题描述

我在此页面 https://shiny.rstudio.com/gallery/plot-interaction-selecting-points.html中使用闪亮的交互。然后，我将“刷”结果时生成的表格复制到剪贴板中，并像这样使用 read.table 。

subsectionDT=read.table("clipboard", sep = ",",header=FALSE)

问题是当从浏览器复制数据时，数据是“固定宽度数据”，所以它并不是我所期望的数据框。我希望它只是 mtcars 行的一个子集（在示例中），因此它的结构应该是

> str(mtcars)
'data.frame':   32 obs. of  11 variables:
 $ mpg : num  21 21 22.8 21.4 18.7 18.1 14.3 24.4 22.8 19.2 ...
 $ cyl : num  6 6 4 6 8 6 8 4 4 6 ...
 $ disp: num  160 160 108 258 360 ...
 $ hp  : num  110 110 93 110 175 105 245 62 95 123 ...
 $ drat: num  3.9 3.9 3.85 3.08 3.15 2.76 3.21 3.69 3.92 3.92 ...
 $ wt  : num  2.62 2.88 2.32 3.21 3.44 ...
 $ qsec: num  16.5 17 18.6 19.4 17 ...
 $ vs  : num  0 0 1 1 0 1 0 1 1 1 ...
 $ am  : num  1 1 1 0 0 0 0 0 0 0 ...
 $ gear: num  4 4 4 3 3 3 3 4 4 4 ...
 $ carb: num  4 4 1 1 2 1 4 2 2 4 ...

但事实并非如此。这是

str(subsectionDT)
'data.frame':   16 obs. of  1 variable:
 $ V1: Factor w/ 16 levels "Datsun 710        22.8   4 108.0  93 2.320  1    4",..: 5 6 1 3 4 15 8 7 9 10 ...

有没有人知道我可以对 subsectionDT 做些什么来转换它，使其具有与原始数据（mtcars）相同的列？我知道第一个标题丢失了，但也许可以在之后修复。我也尝试过使用sep=""，但这给出了一个错误。该页面的代码是

library(ggplot2)
library(Cairo)   # For nicer ggplot2 output when deployed on Linux

# We'll use a subset of the mtcars data set, with fewer columns
# so that it prints nicely
mtcars2 <- mtcars[, c("mpg", "cyl", "disp", "hp", "wt", "am", "gear")]


ui <- fluidPage(
  fluidRow(
    column(width = 4,
      plotOutput("plot1", height = 300,
        # Equivalent to: click = clickOpts(id = "plot_click")
        click = "plot1_click",
        brush = brushOpts(
          id = "plot1_brush"
        )
      )
    )
  ),
  fluidRow(
    column(width = 6,
      h4("Points near click"),
      verbatimTextOutput("click_info")
    ),
    column(width = 6,
      h4("Brushed points"),
      verbatimTextOutput("brush_info")
    )
  )
)

server <- function(input, output) {
  output$plot1 <- renderPlot({
    ggplot(mtcars2, aes(wt, mpg)) + geom_point()
  })

  output$click_info <- renderPrint({
    # Because it's a ggplot2, we don't need to supply xvar or yvar; if this
    # were a base graphics plot, we'd need those.
    nearPoints(mtcars2, input$plot1_click, addDist = TRUE)
  })

  output$brush_info <- renderPrint({
    brushedPoints(mtcars2, input$plot1_brush)
  })
}

shinyApp(ui, server)

标签： rshiny

解决方案

这是使用该clipr软件包的一种方式。

添加“复制”按钮：

actionButton("copy", "Copy")

和一个observeEvent：

  observeEvent(input$copy, {
    write_clip(brushedPoints(mtcars2, input$plot1_brush), object_type = "table")
  })

然后，当您按下“复制”按钮时，表格将复制到剪贴板中。您可以通过执行以下操作在 R 中阅读它：

read.table(text = read_clip(), header = TRUE, sep = "\t", row.names = 1)

完整的应用程序：

library(shiny)
library(ggplot2)
library(Cairo)   # For nicer ggplot2 output when deployed on Linux
library(clipr)

mtcars2 <- mtcars[, c("mpg", "cyl", "disp", "hp", "wt", "am", "gear")]

ui <- fluidPage(
  fluidRow(
    column(width = 4,
           plotOutput("plot1", height = 300,
                      click = "plot1_click",
                      brush = brushOpts(
                        id = "plot1_brush"
                      )
           )
    )
  ),
  fluidRow(
    column(width = 6,
           h4("Points near click"),
           verbatimTextOutput("click_info")
    ),
    column(width = 6,
           h4("Brushed points"),
           verbatimTextOutput("brush_info"),
           br(),
           actionButton("copy", "Copy")
    )
  )
)

server <- function(input, output) {
  output$plot1 <- renderPlot({
    ggplot(mtcars2, aes(wt, mpg)) + geom_point()
  })

  output$click_info <- renderPrint({
    # Because it's a ggplot2, we don't need to supply xvar or yvar; if this
    # were a base graphics plot, we'd need those.
    nearPoints(mtcars2, input$plot1_click, addDist = TRUE)
  })

  output$brush_info <- renderPrint({
    brushedPoints(mtcars2, input$plot1_brush)
  })

  observeEvent(input$copy, {
    write_clip(brushedPoints(mtcars2, input$plot1_brush), object_type = "table")
  })
}

shinyApp(ui, server)

推荐阅读