блестящий слайдер будет вынужден вернуться к первоначальному

Question

Я пишу блестящее приложение, чтобы реализовать следующие эффекты:

Всякий раз, когда я выбираю переменную, включаемую по имени категории, в сети будет создаваться ползунок (здесь я использую условную панель), который обеспечивает разделитель. Он делит выбранную переменную на 2 группы и формирует новый столбец, добавленный к исходному набору данных.

Моя проблема:

Всякий раз, когда я выбираю переменную в categoryname и пытаюсь изменить ползунок, ползунок будет принудительно переведен в начальную точку, что означает, что я не могу изменить выходной набор данных с помощью ползунка.

Здесь, в коде, я просто использую набор данных mtcars, чтобы вы все могли получить к нему доступ.

library(shiny)
library(stringr)

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 = "input.arm == 'disp_group' | input.arm == 'mpg_group'",

        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,
    observe(
      {
        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)

Есть идеи? Спасибо, ребята!

Answer 1

Проблема в том, что вы постоянно обновляете значение в вашем делителе Попробуйте это:

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

  observeEvent(
    input$arm,
    observe(
      {
        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 = input$divider)
          #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)

По updateSliderInput(session, inputId = "divider", min=floor(mn/2),max = mx + 4,step = 1,value = input$divider), где value = input$divider вы заверяете себя, что сохраняете значение делителя при каждом обновлении, чтобы видеть свои результаты.