2017-02-27 13 views
0

?如果可能的话,绘制交互式剂量反应曲线图是非常有用的,用户可以选择动态去除外围点并绘制曲线拟合。我目前正在测试这种可能性。一旦成功,将在这里发布答案。同时,如果有人有建设性的意见来实现这一点,请咨询。R通过修改<a href="https://shiny.rstudio.com/gallery/plot-interaction-exclude.html" rel="nofollow noreferrer">R Shiny interactive example</a>可以绘制至少一个其他参数的交互式图形,例如wt与hp或wt与cyl的交互作用图表。

+0

为什么不只是复制情节和观察事件? – HubertL

+0

感谢您的建议。有效。 – RanonKahn

回答

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)