2017-02-27 15 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)