条件面板结合闪亮的反应性

问题描述 投票:0回答:2

我正在编写一个闪亮的应用程序来实现以下效果:

每当我选择categoryname包含的变量时,web都会生成滑块(这里我使用条件面板),它提供了一个分隔符。它将所选变量分为两组,并形成一个添加到原始数据集的新列。

现在可以生成网页。我的问题是:

  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)

有任何想法吗?感谢你们!

r shiny
2个回答
1
投票

有几个错误。

id_arm不是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'"

1
投票

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)

Update

  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())

  }
© www.soinside.com 2019 - 2024. All rights reserved.