簡體   English   中英

有條件的面板結合了光澤的反應性

[英]conditional panel combined with reactivity in shiny

我正在編寫一個閃亮的應用程序,以實現以下效果:

每當我選擇categoryname包含的變量時,網絡都會生成提供分隔符的滑塊(在這里我使用條件面板)。 它將選定的變量分為2組,並形成一個添加到原始數據集的新列。

該網頁現在可以生成。 我的問題是:

  1. 當我沒有在categoryname選擇變量時,應該將滑塊隱藏起來,但是它總是出現。

  2. 每當我在categoryname選擇變量時,頁面都會退出。

錯誤顯示:

Warning in max(MT_EG$id_arm) :
  no non-missing arguments to max; returning -Inf
Warning in input$divider$max <- max(MT_EG$id_arm) :
  Coercing LHS to a list
Warning: Error in $<-.reactivevalues: Attempted to assign value to a read-only reactivevalues object
  75: stop
  74: $<-.reactivevalues
  72: observeEventHandler [/opt/bee_tools/shiny/3.5.1/users/denga2/teal.modules.km/testapp/app.R#75]
   1: runApp

那么,改變滑塊最大最小值的嘗試並不是唯一的原因。 當我將其設置為固定時,頁面也會退出。

在代碼中,我只是使用mtcars數據集,以便所有人都可以訪問。

library(shiny)

categoryname = c("mpg_group", "disp_group")
MT_EG = mtcars[,1:5]

# Define UI for application that draws a histogram
ui <- fluidPage(

   # Application title
   titlePanel("Mtcars Data"),

   # Sidebar with a slider input for number of bins 
   sidebarLayout(
      sidebarPanel(

         selectInput(inputId = "arm",
                     label = "ARM VARIABLE",
                     choices = c("mpg_group", "cyl", "disp_group", "hp", "drat"),
                     selected = "cyl"),

         conditionalPanel(
           condition = "categoryname.includes(input.arm)",
           #condition = "categoryname == input.arm",

           #optionalSliderInputValMinMax("divider", "divide slider", c(50,0,100), ticks = FALSE)
           sliderInput("divider", "divide slider", 0, 100, 50)
         )
      ),

      # Show a plot of the generated distribution
      mainPanel(
         uiOutput("data")
      )
   )
)

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

   observeEvent(
     input$arm,
     {
     if (input$arm %in% categoryname){
       # start over and remove the former column if exists
       MT_EG = MT_EG[, !(colnames(MT_EG) %in% input$arm)]

       id_arm_var <- input$arm
       id_arm <- unlist(str_split(id_arm_var,'_'))[1]

       # change the range of the slider
       input$divider$max = max(MT_EG$id_arm)
       input$divider$min = min(MT_EG$id_arm)

       # generate a new column and bind
       divi <- data.frame(id_arm_var = MT_EG$id_arm>input$divider)
       divi$id_arm_var[divi$id_arm_var==TRUE] <- paste0(id_arm_var, " Larger")
       divi$id_arm_var[divi$id_arm_var==FALSE] <- paste0(id_arm_var, " Smaller")
       MT_EG <- cbind(MT_EG,divi)
     }

   output$data=renderTable(MT_EG)
   })
}

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

有任何想法嗎? 感謝大伙們!

有幾個錯誤。

id_arm不是MT_EG列的MT_EG 此變量包含一個字符串,並且此字符串是MT_EG列的MT_EG 因此,您必須執行MT_EG[[id_arm]]而不是MT_EG$id_arm

您無法通過執行input$divider$max = max(MT_EG$id_arm)來更新滑塊。 請參閱?updateSliderInput以更新滑塊。

condition = "categoryname.includes(input.arm)"不正確。 JavaScript端沒有變量categoryname 相反,您可以執行以下操作:

condition = "input.arm == 'mpg_group' || input.arm = 'disp_group'"

MT_EG$id_arm是無效的R語法,尤其是id_arm變量包含列名,使用MT_EG[[id_arm]]MT_EG[,id_arm]進行此類調用。 MT_EG[,id_arm]小心drop = FASLE和drop = TRUE。 在更新期間,使用updateSliderInput更新Sliderinput。

library(shiny)

  categoryname = c("mpg_group", "disp_group")
  MT_EG = mtcars[,1:5]

  # Define UI for application that draws a histogram
  ui <- fluidPage(

    # Application title
    titlePanel("Mtcars Data"),

    # Sidebar with a slider input for number of bins 
    sidebarLayout(
      sidebarPanel(
        sliderInput("bins",
                    "Number of bins:",
                    min = 1,
                    max = 50,
                    value = 30),

        selectInput(inputId = "arm",
                    label = "ARM VARIABLE",
                    choices = c("mpg_group", "cyl", "disp_group", "hp", "drat"),
                    selected = "cyl"),
        conditionalPanel(
          #condition = "categoryname.includes(input.arm)",
          condition = "input.arm == 'disp_group' | input.arm == 'mpg_group'",

          sliderInput("divider", "divide slider", 0, 100, 50)
        )
      ),

      # Show a plot of the generated distribution
      mainPanel(
        plotOutput("distPlot"),
        uiOutput("data")
      )
    )
  )

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

    output$distPlot <- renderPlot({
      # generate bins based on input$bins from ui.R
      x    <- MT_EG[, 1] 
      bins <- seq(min(x), max(x), length.out = input$bins + 1)

      # draw the histogram with the specified number of bins
      hist(x, breaks = bins, col = 'darkgray', border = 'white')
    })

    observeEvent(
      input$arm,
      {
        if (input$arm %in% categoryname){
          #browser()
          # start over and remove the former column if exists
          MT_EG = MT_EG[, !(colnames(MT_EG) %in% input$arm)]

          id_arm_var <- input$arm
          id_arm <- unlist(str_split(id_arm_var,'_'))[1]

          # change the range of the slider
          #input$divider$max = max(MT_EG$id_arm)
          val <- input$divider
          mx = max(MT_EG[[id_arm]])
          mn = min(MT_EG[[id_arm]])
          updateSliderInput(session, inputId = "divider", min=floor(mn/2),max = mx + 4,step = 1,value = (mn+1)%%2 + 1)
          #input$divider$min = min(MT_EG$id_arm)

          # generate a new column and bind
          #divi <- data.frame(id_arm_var = MT_EG$id_arm>input$divider)
          divi <- data.frame(id_arm_var = MT_EG[[id_arm]]>input$divider)
          divi$id_arm_var[divi$id_arm_var==TRUE] <- paste0(id_arm_var, " Larger")
          divi$id_arm_var[divi$id_arm_var==FALSE] <- paste0(id_arm_var, " Smaller")
          MT_EG <- cbind(MT_EG,divi)
        }

        output$data=renderTable(MT_EG)
      })
  }

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

更新資料

  server <- function(input, output, session) {

    output$distPlot <- renderPlot({
      # generate bins based on input$bins from ui.R
      x    <- MT_EG[, 1] 
      bins <- seq(min(x), max(x), length.out = input$bins + 1)

      # draw the histogram with the specified number of bins
      hist(x, breaks = bins, col = 'darkgray', border = 'white')
    })

    data <- reactiveValues()

    observeEvent(
      input$arm,
      {
        if (input$arm %in% categoryname){
          #browser()
          # start over and remove the former column if exists
          MT_EG = MT_EG[, !(colnames(MT_EG) %in% input$arm)]

          id_arm_var <- input$arm
          id_arm <- unlist(str_split(id_arm_var,'_'))[1]

          data$armv <- id_arm_var
          data$arm <- id_arm
          # change the range of the slider
          #input$divider$max = max(MT_EG$id_arm)
          val <- input$divider
          mx = max(MT_EG[[id_arm]])
          mn = min(MT_EG[[id_arm]])
          updateSliderInput(session, inputId = "divider", min=floor(mn/2),max = mx + 4,step = 1,value = (mn+1)%%2 + 1)
          #input$divider$min = min(MT_EG$id_arm)

          # generate a new column and bind
          #divi <- data.frame(id_arm_var = MT_EG$id_arm>input$divider)

        }
      })

  df_final <- reactive({
    req(data$armv, data$arm) #Do not start process data$armv and data$arm unless they are available. To prevent unnecessary Error messages
    id_arm_var <- data$armv
    id_arm <- data$arm
      divi <- data.frame(id_arm_var = MT_EG[[id_arm]]>input$divider)
      divi$id_arm_var[divi$id_arm_var==TRUE] <- paste0(id_arm_var, " Larger")
      divi$id_arm_var[divi$id_arm_var==FALSE] <- paste0(id_arm_var, " Smaller")
      MT_EG <- cbind(MT_EG,divi)
    })

    output$data=renderTable(df_final())

  }

暫無
暫無

聲明:本站的技術帖子網頁,遵循CC BY-SA 4.0協議,如果您需要轉載,請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.

 
粵ICP備18138465號  © 2020-2024 STACKOOM.COM