Используя изолят с блестящей

Question

Приведенный ниже код создает блестящий скелетный интерфейс.При изменении раскрывающегося списка «Цветовая палитра».Консоль R показывает, что вызываются оба элемента наблюдаемого события для входа $ colour_pal И выхода $ make_shape.

Это потому, что я изменяю cvec и глянцевый автоматический запуск, выводит $ make_shape, чтобы он не устарел?

Мне бы хотелось, чтобы раскрывающийся список "Цветовая палитра" активировал только наблюдаемое событие для ввода $colour_pal.Я думал, что смогу сделать это, используя изолят, но я думаю, что делаю это неправильно.

Пожалуйста, посоветуйте.

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 a reactiveValues().
• in renderText оператор print принимает вывод.

Это потому, что [...] блестящий авто запускает вывод $ make_shape, поэтому он не устарел?

Блестящий пробег output$make_shape, потому что он вызывает set_colour, который зависит от input$colour_pal

Мне бы хотелось, чтобы раскрывающийся список "Цветовая палитра" активировал только наблюдение для ввода $ colour_pal.

Если вы хотите сохранить его как функцию (мое предпочтение), я бы не стал использовать input$ внутри, а вытащил функцию за пределы Shiny и передал 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 (т.е. реагируете на что?). Я использовал isolate выше, но это делает его бесполезным.