简体   繁体   中英

Updating reactive values in Shiny

I am creating a Shiny application with a data frame containing three variables (A, B, and C). At the top of the application, I draw a plotly scatterplot of the first two variables (A and B). The user can use the box-select to select one or more points from the scatterplot.

My goal is to then create a parallel coordinate plot (line plot) that contains one line for each point that the user selected with its values for all three variables (A, B, and C). In order to create this plot, as is shown below, the original data frame must go through some transformations (including melting).

In the application below, I have a second plot that shows a parallel coordinate plot (line plot) for all 100 data points in the data frame. However, I have tentative work toward making the third plot (my real goal plot) that would also be a parallel coordinate plot (line plot) - but only containing lines for the points the user selected in the top scatterplot.

This is where I am stuck. Basically, I am having difficulty transforming the original data frame into what is needed for this third plot. My dat_long2() object is not in the same format as my dat_long object. Hence, some of the data transformation is different because, in the second case, I am not using a static variable; I am using the reactive event_data plotly value of what the user selects (below represented with the variable called sel()).

I would be happy to hear any ideas! Thank you for your input!

library(shiny)
library(plotly)
library(data.table)
library(reshape2)

ui <- fluidPage(
  plotlyOutput("plot"),
  verbatimTextOutput("select"),
  plotlyOutput("plot2"),
  plotlyOutput("plot3")
)

server <- function(input, output, session) {

  # Create data
  set.seed(50)
  data <- data.frame(ID = paste0("Obsvn",1:100), A=rnorm(100), B=rnorm(100), C=rnorm(100))

  output$plot <- renderPlotly({
    plot <- qplot(A, B, data=data)
    ggplotly(plot)
  })

  sel <- reactive(event_data("plotly_selected"))

  output$select <- renderPrint({
    if (is.null(sel())){
      "Row of data corresponding to selected point(s)"
    }
    else{
      sel()$pointNumber+1
    }
  })

  # Reorganzing the original data structure into dat_long format to be plotted in line plot.
  datt <- data.frame(t(data))
  data.frame(t(data[,-c(ncol(data), ncol(data)-1)]))
  names(datt) <- as.matrix(datt[1, ])
  datt <- datt[-1, ]
  datt[] <- lapply(datt, function(x) type.convert(as.character(x)))
  setDT(datt, keep.rownames = TRUE)[]
  dat_long <- melt(datt, id.vars ="rn" )

  output$plot2 <- renderPlotly({
    plot_ly(dat_long, x= ~rn, y= ~value, type = 'scatter', mode = 'lines+markers', color = ~variable)  %>% layout(dragmode="box", showlegend = FALSE)
  })

  # Plot2 had too many lines (because all rows in the original dataset were used, and each line represents a row). I would like to only plot lines for the rows that correspond to points selected by the user. Hence, I would like to reorganize the original data structure that is subsetted by the rows selected by the user (data[sel()$pointsNumber+1,]) into dat_long format to be plotted in line plot
  datt <- reactive(data.frame(t(data[sel()$pointsNumber+1,])))
  reactive(data.frame(t(data[,-c(ncol(data), ncol(data)-1)])))
  reactive(names(datt()) <- as.matrix(datt()[1, ]))
  reactive(datt() <- datt()[-1, ])
  reactive(datt()[] <- lapply(datt(), function(x) type.convert(as.character(x))))
  reactive(setDT(datt(), keep.rownames = TRUE)[])
  dat_long2 <- reactive(melt(datt(), id.vars ="rn" ))

  output$plot3 <- renderPlotly({
    plot_ly(dat_long2(), x= ~rn, y= ~value, type = 'scatter', mode = 'lines+markers', color = ~variable)  %>% layout(dragmode="box", showlegend = FALSE)
  })

}

shinyApp(ui, server)

Maybe this is something like what you want. I used shiny, parcoords, and ggplot2. You have to install the parcoords package from github. To install the parcoords stuff use this: devtools::install_github("timelyportfolio/parcoords")

Also, when I used the brushedPoints function, I didn't have to specify the x and y variables I used to build the plot because I created it with ggplot. For more on brushed points, check out this link: brushed points link

Then I wrote this:

library(shiny)
library(parcoords)
library(ggplot2)
ui <- basicPage(
  plotOutput("plot1", brush = "plot_brush"),
  verbatimTextOutput("info"),
  parcoordsOutput("parcoords")
)

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

  output$info <- renderPrint({
    # With base graphics, need to tell it what the x and y variables are.
    pts<- brushedPoints(mtcars, input$plot_brush)
    pts
  })


  output$parcoords<- renderParcoords(parcoords(brushedPoints(mtcars, input$plot_brush)))

}

shinyApp(ui, server) 

Are you looking for something like this? Just select some points in the top graphic and the third plot will be displayed.

ui <- fluidPage(
  plotlyOutput("plot"),
  verbatimTextOutput("select"),
  plotlyOutput("plot2"),
  plotlyOutput("plot3")
)

server <- function(input, output, session) {

  # Create data
  set.seed(50)
  data <- data.frame(ID = paste0("Obsvn",1:100), A=rnorm(100), B=rnorm(100), C=rnorm(100))

  output$plot <- renderPlotly({
    plot <- qplot(A, B, data=data)
    ggplotly(plot, source = "subset") %>% layout(dragmode = "select")
  })



  # Reorganzing the original data structure into dat_long format to be plotted in line plot.
  datt <- data.frame(t(data))
  data.frame(t(data[,-c(ncol(data), ncol(data)-1)]))
  names(datt) <- as.matrix(datt[1, ])
  datt <- datt[-1, ]
  datt[] <- lapply(datt, function(x) type.convert(as.character(x)))
  setDT(datt, keep.rownames = TRUE)[]
  dat_long <- melt(datt, id.vars ="rn" )

    output$plot2 <- renderPlotly({
     plot_ly(dat_long, x= ~rn, y= ~value, type = 'scatter', mode = 'lines+markers', color = ~variable)  %>% layout(dragmode="box", showlegend = FALSE)
  })


  output$plot3 <- renderPlotly({

    d <- event_data("plotly_selected",source="subset")
    if (is.null(d)) "Click and drag events (i.e., select/lasso) appear here (double-click to clear)" else d


    temp <- subset(data)[subset(d, curveNumber == 0)$pointNumber + 1,]
    temp

    dattb <- data.frame(t(temp))
    data.frame(t(temp[,-c(ncol(temp), ncol(temp)-1)]))
    names(dattb) <- as.matrix(dattb[1, ])
    dattb <- dattb[-1, ]
    dattb[] <- lapply(dattb, function(x) type.convert(as.character(x)))
    setDT(dattb, keep.rownames = TRUE)[]
    dat_long <- melt(dattb, id.vars ="rn" )
    dat_long
    #dat_long2 <- melt(temp, id.vars ="rn" )
    #dat_long2

    plot_ly(dat_long, x= ~rn, y= ~value, type = 'scatter', mode = 'lines+markers', color = ~variable)  %>% layout(dragmode="box", showlegend = FALSE)
  })


}


shinyApp(ui, server)

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM