преобразование входных данных из блестящих brushedPoints () в кадр данных

Question

Я использую взаимодействие в блестящей с этой страницы https://shiny.rstudio.com/gallery/plot-interaction-selecting-points.html. Затем я скопировал в буфер обмена таблицу, которая генерируется при «bru sh» результатах, и использовал 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 ...

Кто-нибудь имеет представление о том, что я мог бы сделать для подраздела DT, чтобы преобразовать его так, чтобы он имел те же столбцы, что и исходные данные (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)