【问题标题】:is it possible to have a SelectInput that does not have a dropdown arrow?是否可以有一个没有下拉箭头的 SelectInput?
【发布时间】:2020-07-15 20:46:27
【问题描述】:

刚开始使用 Rshiny。我的问题主要考虑下拉栏的外观。 有 2 个数据框,一个有汽车数据,另一个显示距离。下拉栏取决于之前选择的内容。

我想知道我是否可以让“成本”和“以英里为单位的距离”选择输入看起来像没有下拉箭头的普通框?

很抱歉,如果这个问题已经得到解答,也许我的谷歌搜索技能还不是最好的编码东西! 环顾四周,我发现使用 multiple = TRUE 可以摆脱这个箭头,但这意味着人们必须选择我不想要的它,它应该在他们选择了前面的框后自动显示。

第二个想法是改用某种文本输出,但我认为那样我会失去框和副标题的良好格式,现在我没有想法了。而且我不确定如果它不是选择输入,我将如何链接它......那么有人对这个问题有什么建议吗?

image of what I have so far, the red x's showing I do not want drop down arrow

我的代码:

library(shiny)

Df <- data.frame(Manufacturer= c(rep("ford", 4)), 
                                    Model= c(rep("esport",2), rep("fiesta",2)), 
                    transmission= c(1,2,3,4), cost=c(2,4,6,8))

Distance1 <- data.frame(Origin= c("leeds", "London", "Glasgow"), 
                        Destination = c("Bristol", "Cardiff", "London"),
                        Distance= c(12,13,14))

ui <- fluidPage(
  fluidRow(
    column(4, wellPanel(
      selectInput("Select1", "Choose your Manufacturer", sort(Df$Manufacturer),
                  unique(Df$Manufacturer)),
      selectizeInput("Select2", "Choose your Model", sort(Df$Model), 
                     options= list(
                       placeholder = '',
                       onInitialize = I('function() { this.setValue(""); }'))),
      selectizeInput("Select3", "Choose transmission", sort(Df$transmission),
                     options= list(
                       placeholder = '',
                       onInitialize = I('function() { this.setValue(""); }'))),
      selectInput("Select4", "cost", choices= NULL),
      selectizeInput("Select5", "Choose Origin", sort(Distance1$Origin),
                     options= list(
                       placeholder = '',
                       onInitialize = I('function() { this.setValue(""); }'))),
      selectizeInput("Select6", "Choose Destination", sort(Distance1$Distance),
                     options= list(
                       placeholder = '',
                       onInitialize = I('function() { this.setValue(""); }'))),
      selectInput("Select7", "Distance in Miles", choices= NULL),
      textOutput("total1")

    ))))

server <- function(input, output,session) {
  observeEvent(input$Select1,{
    updateSelectInput(session,'Select2',
                      choices=unique(Df$Model[Df$Manufacturer==input$Select1]))
  }) 

  observeEvent(input$Select2,{
    updateSelectInput(session,'Select3',
                      choices=unique(Df$transmission[Df$Manufacturer==input$Select1 & 
                                                         Df$Model==input$Select2]))
  }) 

  observeEvent(input$Select3,{
    updateSelectInput(session,'Select4',
                      choices=unique(Df$cost[Df$Manufacturer==input$Select1 & 
                                                       Df$Model==input$Select2 & 
                                                       Df$transmission==input$Select3]))

  }) 

observeEvent(input$Select5,{
  updateSelectInput(session,'Select6',
                    choices=unique(Distance1$Destination[Distance1$Origin==input$Select5]))
})

  observeEvent(input$Select6,{
    updateSelectInput(session,'Select7',
                      choices=unique(Distance1$Distance[Distance1$Origin==input$Select5 & 
                                                          Distance1$Destination==input$Select6]))
  })

output$total1 <- renderText({as.numeric(input$Select4) * as.numeric(input$Select7)}) 
    }


shinyApp( ui= ui, server= server)

【问题讨论】:

    标签: r shiny selectinput


    【解决方案1】:

    您可以使用CSS 执行此操作。我以答案here 为基础。参数content 与箭头有关(顺便说一下,我所涉及的答案也显示了如何更改箭头的样式)。此外,由于您不想将此更改应用于所有selectizeInputs,因此您需要将要更改的selectizeInputs 包装成tags$div,并在#div_id 部分中指定#div_id

    library(shiny)
    
    ui <- fluidPage(
      tags$head(
        tags$style(
          HTML(
    "        #div_id .selectize-control.single .selectize-input:after{
              content: none;
            }"
          )
        )
      ),
      tags$div(id = "div_id", 
               selectizeInput("foo", "foo", names(mtcars))),  
      selectizeInput("foo_2", "foo 2", names(mtcars)),
      tags$div(id = "div_id", 
               selectizeInput("foo_3", "foo_3", names(iris)))
    )
    
    server <- function(input, output, session) {
    
    }
    
    shinyApp(ui, server)
    

    【讨论】:

      猜你喜欢
      • 2018-08-26
      • 1970-01-01
      • 2018-10-20
      • 1970-01-01
      • 1970-01-01
      • 2017-04-15
      • 2012-06-04
      • 1970-01-01
      • 1970-01-01
      相关资源
      最近更新 更多