Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

converting input from shiny brushedPoints() into a dataframe

Tags:

r

shiny

I am using interaction in shiny from this page https://shiny.rstudio.com/gallery/plot-interaction-selecting-points.html. I then copied into the clipboard the table that is generated when you "brush" the results and used read.table like this.

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

The problem is that when copying from the browser the data is "fixed width data" and so it is not really the dataframe I would expect. I would like it to be just be a subset of the rows of mtcars (in the example) and so its structure should be

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

but it is not. It is

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

Does anyone have an idea on what I could do to subsectionDT to convert it so that it has the same columns as the original data (mtcars)? I know the first header is missing but maybe that can be fixed afterwards. I also tried using sep="" but that gave an error. The code from that page is

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)
like image 861
onyourmark Avatar asked Oct 17 '25 03:10

onyourmark


1 Answers

Here is a way using the clipr package.

Add a "Copy" button:

actionButton("copy", "Copy")

and an observeEvent:

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

Then, when you press the "Copy" button, the table is copied in the clipboard. And you can read it in R by doing:

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

Full app:

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)
like image 137
Stéphane Laurent Avatar answered Oct 18 '25 20:10

Stéphane Laurent