更新

Question

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

每当我选择categoryname包含的变量时，Web都会生成提供分隔符的滑块（此处使用条件面板）。它将选定的变量分为2组，并形成一个添加到原始数据集的新列。

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

当我没有在categoryname中选择变量时，应该隐藏该滑块，但是它总是出现。
只要我在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)

有什么想法吗？谢谢你们！

Answer 1

有几个错误。

this.submitData = () => { let temporalDataModel = { ...this.state.dataModel, SessionId: this.state.customer.SessionId, customerId: this.state.customer.CustomerId }; //// This is the logic to send the the data back to my API let postUrl = "https://myAPI.com/OfferUpdate"; axios .post(postUrl, temporalDataModel) .then(response => { console.log(response); }) .catch(err => { console.error(err); }); console.log("This is your data...sending...NOW", temporalDataModel); };不是id_arm列的名称。此变量包含一个字符串，并且此字符串是MT_EG的列的名称。因此，您必须执行MT_EG而不是MT_EG[[id_arm]]。

您无法通过执行MT_EG$id_arm来更新滑块。请参见input$divider$max = max(MT_EG$id_arm)更新滑块。

?updateSliderInput不正确。 JavaScript端没有变量condition = "categoryname.includes(input.arm)"。相反，您可以执行以下操作：

categoryname

Answer 2

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

  }

有条件的面板结合了光泽的反应性

2 个答案:

更新