是否可以使用没有下拉箭头的 SelectInput?
is it possible to have a SelectInput that does not have a dropdown arrow?
刚开始使用 Rshiny。我的问题主要考虑下拉栏的外观。
有 2 个数据框,一个有汽车数据,另一个显示距离。下拉栏取决于之前选择的内容。
我想知道是否可以使 "cost" 和 "distance in miles" select 输入看起来像没有下拉箭头的普通框?
抱歉,如果这个问题已经得到解答,也许我的谷歌搜索技能还不是编码东西的最佳人选!
环顾四周,我看到使用 multiple = TRUE 摆脱了这个箭头,但这意味着这个人必须 select 它,我不想要它,它应该在他们选择之前的框后自动显示.
第二个想法是改用某种文本输出,但我想我会失去方框和副标题的漂亮格式,现在我没有主意了。而且我不确定如果它不是 select 输入,我将如何 link ....所以有人对这个问题有建议吗?
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)
您可以在 CSS. I used the answer 的基础上执行此操作。参数 content
与箭头有关(顺便说一句,我相关的答案也显示了如何更改箭头的样式)。此外,由于您不想将此更改应用于所有 selectizeInput
,因此您需要将要更改的 selectizeInput
包装成 tags$div
并指定 #div_id
在 HTML
部分:
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)
刚开始使用 Rshiny。我的问题主要考虑下拉栏的外观。 有 2 个数据框,一个有汽车数据,另一个显示距离。下拉栏取决于之前选择的内容。
我想知道是否可以使 "cost" 和 "distance in miles" select 输入看起来像没有下拉箭头的普通框?
抱歉,如果这个问题已经得到解答,也许我的谷歌搜索技能还不是编码东西的最佳人选! 环顾四周,我看到使用 multiple = TRUE 摆脱了这个箭头,但这意味着这个人必须 select 它,我不想要它,它应该在他们选择之前的框后自动显示.
第二个想法是改用某种文本输出,但我想我会失去方框和副标题的漂亮格式,现在我没有主意了。而且我不确定如果它不是 select 输入,我将如何 link ....所以有人对这个问题有建议吗?
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)
您可以在 CSS. I used the answer content
与箭头有关(顺便说一句,我相关的答案也显示了如何更改箭头的样式)。此外,由于您不想将此更改应用于所有 selectizeInput
,因此您需要将要更改的 selectizeInput
包装成 tags$div
并指定 #div_id
在 HTML
部分:
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)