Question

我正在编写一个Shiny应用程序，用于调整情节中的散布量。数据是通过rnorm()生成的。我用ggplot2显示图。我想根据复选框的值显示或隐藏回归线。一切正常。

但是，每当我显示或隐藏回归线（不更改误差量）时，都会重新生成数据，这是我不希望的。我将数据包含在响应函数中，希望可以解决问题，但不能解决问题。

我尝试同时使用geom_smooth和geom_abline（在代码中注释），但是两者都导致重新生成数据。

问题：是否可以在不更改数据的情况下添加/删除回归线？也就是说，仅在更改滑块而不是复选框的情况下，点的位置才应该更改。

library(shiny)
library(ggplot2)

set.seed(42)

ui <- fluidPage(

  sidebarLayout(
    sidebarPanel(
      sliderInput("stdev",
                  "Amount of error:",
                  min = 0,
                  max = 0.8,
                  value = 0.34),
      checkboxInput("showLM", "Show regression line?",
                    value = TRUE)
    ),

    mainPanel(
      plotOutput("regrPlot")
    )
  )
)

# Define server logic required to draw a histogram
server <- function(input, output) {

  output$regrPlot <- renderPlot({

    regrData <- reactive({
      pl <- rnorm(50, mean = 4.3, sd = 0.44)
      error <- rnorm(length(pl), 0, input$stdev)
      sl <- 2.41 + (0.828 * pl) + error

      tibble(pl, sl)

    })

    # For use with abline
    coefs <- lm(sl ~ pl, data = regrData())$coefficients

    p1 <- ggplot(data = regrData(), aes(x = pl, y = sl)) + 
      geom_point()

    # Try with geom_abline
    # p2 <- {if (input$showLM) p1 + 
    #     geom_abline(slope = coefs[2],
    #                 intercept = coefs[1]) 
    #   else p1}

   p2 <- {if (input$showLM)
     p1 + geom_smooth(method = "lm",
                      se = FALSE)
     else p1}

    print(p2)
  })
}

# Run the application 
shinyApp(ui = ui, server = server)

^{由reprex package（v0.2.1）于2019-01-23创建}

Answer 1

这里的问题是将reactive放入renderPlot内，以便每次renderPlot无效时重新运行代码。

相反，您应该将reactive移到主要的server函数中。然后，只有在input$stdev中的更改导致其值无效时，它才会运行。

但是，当您添加回归线时，始终将必须重新渲染ggplot。据我所知，没有办法在不重新渲染整个图的情况下向ggplot添加一行。

Answer 2

就像我在评论中写道的那样，另一种方法是在反应函数中设置set.seed()。

您的反应式功能内部是一个不同的环境。您的种子不再在那里定义了，...如果将种子放入反应性函数中，它将起作用。可以在以下位置找到有关范围界定的高级详细信息：https://shiny.rstudio.com/articles/scoping.html。

一个更好理解的例子：

library(shiny)
set.seed(1)
print("set seed outside server function:")
print(rnorm(1))
ui <- fluidPage(

)

server <- function(input, output, session) {
  observe({
    print("new environment seed not valid")
    print(rnorm(1))
  })

  observe({
    print("new environment but set seed here as well")
    set.seed(1)
    print(rnorm(1))
  })
}

shinyApp(ui, server)

闪亮：添加回归线而不更改数据

2 个答案: