在Shiny中更新无功值

Question

我正在创建一个包含三个变量（A，B和C）的数据框架的Shiny应用程序。 在应用程序的顶部，我绘制了前两个变量（A和B）的散点图。 用户可以使用选择框从散点图中选择一个或多个点。

我的目标是创建一个平行坐标图（折线图），该坐标图包含用户选择的每个点的一条线以及所有三个变量（A，B和C）的值。 为了创建该图，如下所示，原始数据帧必须经过一些转换（包括熔化）。

在下面的应用程序中，我有第二个图，它显示了数据框中所有100个数据点的平行坐标图（线图）。 但是，我正在尝试制作第三个图（我的真实目标图），它也将是平行坐标图（线图）-但只包含用户在顶部散点图中选择的点的线。

这就是我卡住的地方。 基本上，我很难将原始数据帧转换为第三幅图所需的数据。 我的dat_long2（）对象的格式与我的dat_long对象的格式不同。 因此，某些数据转换是不同的，因为在第二种情况下，我没有使用静态变量。 我正在使用用户选择的反应性event_data plotly值（下面用称为sel（）的变量表示）。

我很高兴听到任何想法！ 谢谢您的意见！

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)

Answer 1

也许这是您想要的东西。 我使用了闪亮的，parcoords和ggplot2。 您必须从github安装parcoords软件包。 要安装parcoords东西，请使用以下命令： devtools::install_github("timelyportfolio/parcoords")

另外，当我使用brushedPoints函数时，不必指定用于构建图的x和y变量，因为我是使用ggplot创建的。 有关刷点的更多信息，请查看此链接： 刷点链接

然后我写了这个：

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) 

Answer 2

您是否正在寻找这样的东西？ 只需在顶部图形中选择一些点，就会显示第三个图。

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)