Question

下面的代码创建一个骨架闪亮的UI。当“颜色调色板”下拉菜单更改时。 R控制台显示输入$ colour_pal和输出$ make_shape的watchEvent均被调用。

那是因为我要更改cvec并且有光泽的自动运行输出$ make_shape，所以它不会过时吗？

我希望“颜色调色板”下拉列表仅激活input $ colour_pal输入的observeEvent。我以为可以使用隔离来完成此操作，但我认为做错了。

请告知。

library(shiny)
library(tidyverse)

# Define UI for slider demo app ----
ui <- fluidPage(

  # App title ----
  titlePanel("Knobs and Dials"),

  # Sidebar layout with input and output definitions ----
  sidebarLayout(

    # Sidebar to demonstrate various slider options ----
    sidebarPanel(

      # Input: make_shape parameters - a
      sliderInput("aa", "a",
                  min = -2, max = 2,
                  value = 0, step = 0.01),

      # Input: make_shape parameters - b
      sliderInput("bb", "b",
                  min = -2, max = 2,
                  value = 0, step = 0.01),

      # Input: Colour Palette
      selectInput("colour_pal", "Colour Palette",
                  list(`Monochrome` = c("Orange", "Yellow", "Blue", "Grey"),
                       `Mixed` = c("Dark Green with Blue Streaks", 
                                   "Dark Green with Yellow Streaks"
                       )
                  )
      )
    ),

    # Main panel for displaying outputs ----
    mainPanel(
      textOutput("make_shape")
    )
  )
)

# Define server logic for slider examples ----
server <- function(input, output, session) {

  # Reactive expression to create data frame of all input values ----
  sliderValues <- reactive({

    data.frame(
      Name = c("a", "b"),
      Value = as.character(c(input$a,
                             input$b)),
      stringsAsFactors = FALSE)

  })

  # Show the values in an HTML table ----
  output$values <- renderTable({
    sliderValues()
  })


  set_colour <- function(){
    if (input$colour_pal == "Orange") {
      cvec <- heat.colors(2048)
    } else if (input$colour_pal == "Yellow") {
      cvec <- rainbow(2048, s = 1, v = 1, start = 0.03, end = 0.19, alpha = 1.0)
    } else if (input$colour_pal == "Blue") {
      cvec <- rainbow(2048, s = 1, v = 1, start = 0.48, end = 0.866, alpha = 1.0)
    } else if (input$colour_pal == "Grey") {
      cvec <- grey(seq(0, 1, length = 50))
    } else if (input$colour_pal == "Dark Green with Blue Streaks") {
      cvec <- rainbow(2048, s = 1, v = 0.4, start = 0.333, end = 0.7, alpha = 1.0)
    } else if (input$colour_pal == "Dark Green with Yellow Streaks") {
      yellow <- rainbow(2048, s = 1, v = 1, start = 0.03, end = 0.19, alpha = 1.0)
      dgb <- rainbow(2048, s = 1, v = 0.4, start = 0.333, end = 0.7, alpha = 1.0)
      dgb[1400: 2048] <- yellow[1400: 2048]
      cvec <- dgb
    }  
  }


  # Look for slider movement 
  observeEvent({
    input$aa
    input$bb
  }, {
    print("slider")
  }, ignoreInit = TRUE) 

  # Look for colour dropdown
  observeEvent({
    input$colour_pal
  }, {
    print("colour")
    cvec <- isolate(set_colour())
  })

  output$make_shape <- renderText({
    cvec <- set_colour()
    print("make_shape")
  })

}  
# Create Shiny app ----
shinyApp(ui, server)

Answer 1

是因为我要更换cvec [...]？

对于此特定示例，cvec不执行任何操作（您可能已经意识到这一点）：

它是set_colour中的局部变量，其值由该函数以偶然的机会返回（对于所有cvec分支，最后的赋值始终是if）；如果您的函数/表达式显式以cvec结尾，那么它会有所帮助。
在observeEvent({input$colour_pal中，cvec的值在观察者执行结束时丢失；如果要在全局范围内使用<<-或将cvec设为reactiveValues()。
在renderText中，print语句将接管输出。

是因为闪亮的自动运行输出$ make_shape，所以它不是过时的吗？

Shiny运行output$make_shape是因为它调用依赖于set_colour的{{1}}

我希望“颜色调色板”下拉列表仅激活输入$ colour_pal的observeEvent。

如果要保留它作为函数（我的偏爱），我不会在内部使用input$colour_pal，而是将函数拉到Shiny之外并传递input$作为参数。

如果要保留colour_pal，请将其转换为反应式：

input$

新问题是您没有指出set_colour <- reactive({ if (input$colour_pal == "Orange") { cvec <- heat.colors(2048) } else if (input$colour_pal == "Yellow") { cvec <- rainbow(2048, s = 1, v = 1, start = 0.03, end = 0.19, alpha = 1.0) } else if (input$colour_pal == "Blue") { cvec <- rainbow(2048, s = 1, v = 1, start = 0.48, end = 0.866, alpha = 1.0) } else if (input$colour_pal == "Grey") { cvec <- grey(seq(0, 1, length = 50)) } else if (input$colour_pal == "Dark Green with Blue Streaks") { cvec <- rainbow(2048, s = 1, v = 0.4, start = 0.333, end = 0.7, alpha = 1.0) } else if (input$colour_pal == "Dark Green with Yellow Streaks") { yellow <- rainbow(2048, s = 1, v = 1, start = 0.03, end = 0.19, alpha = 1.0) dgb <- rainbow(2048, s = 1, v = 0.4, start = 0.333, end = 0.7, alpha = 1.0) dgb[1400: 2048] <- yellow[1400: 2048] cvec <- dgb } cvec }) # Look for colour dropdown observeEvent({ input$colour_pal }, { print("colour") cvec <- set_colour() }) output$make_shape <- renderText({ print("make_shape") isolate(set_colour()) })会发生什么（即对什么有反应？）。我在上面使用了output$make_shape，但这使它毫无用处。

使用隔离带光泽

1 个答案: