Question

是否可以通过修改R Shiny interactive example来绘制其他参数的至少一个或多个交互式图，例如wt与hp或wt与cyl。如果可能，绘制交互式剂量响应曲线图非常有用，用户可以选择动态移除外围点并绘制曲线拟合。我目前正在测试这种可能性。一旦成功，将在此处发布答案。同时，如果有人提出建设性意见，请提供建议。

Answer 1

我试图根据@HubertL的建议绘制多个交互式图，但它确实有效。我提供下面的演示代码，对我这样的人有用。

library(ggplot2)


ui <- fluidPage(
  fluidRow(
    column(width = 6,
           plotOutput("plot1", height = 350,
                      click = "plot1_click",
                      brush = brushOpts(
                        id = "plot1_brush"
                      )
           ),
           actionButton("exclude_toggle", "Toggle points"),
           actionButton("exclude_reset", "Reset"),
           plotOutput("plot2", height = 350,
                      click = "plot2_click",
                      brush = brushOpts(
                        id = "plot2_brush"
                      )
           ),
           actionButton("exclude_toggle2", "Toggle points2"),
           actionButton("exclude_reset2", "Reset")
    )
  )
)

server <- function(input, output) {
  # For storing which rows have been excluded
  vals <- reactiveValues(
    keeprows = rep(TRUE, nrow(mtcars)),
    keeprows1 = rep(TRUE, nrow(mtcars))
  )

  output$plot1 <- renderPlot({
    # Plot the kept and excluded points as two separate data sets
    keep    <- mtcars[ vals$keeprows, , drop = FALSE]
    exclude <- mtcars[!vals$keeprows, , drop = FALSE]

    ggplot(keep, aes(wt, mpg)) + geom_point() +
      geom_smooth(method = lm, fullrange = TRUE, color = "black") +
      geom_point(data = exclude, shape = 21, fill = NA, color = "black", alpha = 0.25) 
  })


  output$plot2 <- renderPlot({
    # Plot the kept and excluded points as two separate data sets
    keep    <- mtcars[ vals$keeprows1, , drop = FALSE]
    exclude <- mtcars[!vals$keeprows1, , drop = FALSE]

    ggplot(keep, aes(wt, hp)) + geom_point() +
      geom_smooth(method = lm, fullrange = TRUE, color = "black") +
      geom_point(data = exclude, shape = 21, fill = NA, color = "black", alpha = 0.25) 
  })
  # Toggle points that are clicked on plot 1
  observeEvent(input$plot1_click, {
    res <- nearPoints(mtcars, input$plot1_click, allRows = TRUE)

    vals$keeprows <- xor(vals$keeprows, res$selected_)
  })

  # Toggle points that are brushed, when button is clicked on plot 1
  observeEvent(input$exclude_toggle, {
    res <- brushedPoints(mtcars, input$plot1_brush, allRows = TRUE)
    vals$keeprows <- xor(vals$keeprows, res$selected_)
  })

  # Reset all points for plot 1
  observeEvent(input$exclude_reset, {
    vals$keeprows <- rep(TRUE, nrow(mtcars))
  })

  # Toggle points that are clicked on plot 2
  observeEvent(input$plot2_click, {
    res <- nearPoints(mtcars, input$plot2_click, allRows = TRUE)

    vals$keeprows1 <- xor(vals$keeprows1, res$selected_)
  })

  # Toggle points that are brushed, when button is clicked on plot 2
  observeEvent(input$exclude_toggle2, {
    res <- brushedPoints(mtcars, input$plot2_brush, allRows = TRUE)
    vals$keeprows1 <- xor(vals$keeprows1, res$selected_)
  })

  # Reset all points for plot 2
  observeEvent(input$exclude_reset2, {
    vals$keeprows1 <- rep(TRUE, nrow(mtcars))
  })

}

shinyApp(ui, server)

R闪亮的交互式绘图，排除异常值

1 个答案: