Question

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

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

问题在于，从浏览器复制数据时，数据是“固定宽度数据”，因此并不是我期望的数据帧。我希望它只是mtcar行的子集（在示例中），因此其结构应为

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

Answer 1

这是使用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)

将输入从闪亮的brushedPoints（）转换为数据框

1 个答案: