是否有可能在Shiny中制作垂直滑块?我基本上想要一个情节,左边是一个垂直滑块,下面是一个普通的水平滑块。
答案 0 :(得分:5)
有多种方法可以手动完成。您需要创建自定义js
。
这是一个疯狂的闪光应用,一切都在旋转
#Libs
require(c('shiny'))
js<-"$(function() {
var $elie = $('div');
rotate(25);
function rotate(degree) {
$elie.css({ WebkitTransform: 'rotate(' + degree + 'deg)'});
$elie.css({ '-moz-transform': 'rotate(' + degree + 'deg)'});
timer = setTimeout(function() {
rotate(++degree);
},100);
}
});"
renderInputs <- function(prefix) {
wellPanel(
fluidRow(
column(3,
sliderInput(paste0(prefix, "_", "n_obs"), "View a specific date", min = as.Date('1980-05-15'), max = Sys.Date(), value = as.Date('2000-01-01'),
#sliderInput("date_range", "Choose Date Range:", min = as.Date("2016-02-01"), max = Sys.Date(), value = c(as.Date("2016-02-25"), Sys.Date())
),
verbatimTextOutput("info")
),
column(9,
plotOutput("plot1",
click = "plot_click",
dblclick = "plot_dblclick",
hover = "plot_hover",
brush = "plot_brush")
)
)
)
}
ui <- shinyUI(fluidPage(theme="simplex.min.css",
tags$style(type="text/css",
"label {font-size: 12px;}",
".recalculating {opacity: 1.0;}"
),
tags$head(
tags$style(HTML("
@import url('//fonts.googleapis.com/css?family=Lobster|Cabin:400,700');
h1 {
font-family: 'Lobster', cursive;
font-weight: 500;
line-height: 1.1;
color: #48ca3b;
}
")),
tags$script(HTML(js))
),
# Application title
tags$h2("Google!!!"),
p("An adaptation of the",
tags$a(href="https://google.com", "Google"),
"from",
tags$a(href="https://duckduckgo.com/", "DuckDuckGo"),
"to get the best possible results without selling yourself"),
hr(),
fluidRow(
column(6, tags$h3("Scenario A")),
column(6, tags$h3("Scenario B"))
),
fluidRow(
column(12, renderInputs("a"))
),
fluidRow(
column(6,
plotOutput("a_distPlot", height = "600px")
),
column(6,
plotOutput("b_distPlot", height = "600px")
)
)
)
)
server <- function(input, output) {
output$plot1 <- renderPlot({
plot(mtcars$wt, mtcars$mpg)
})
output$info <- renderText({
xy_str <- function(e) {
if(is.null(e)) return("NULL\n")
paste0("x=", round(e$x, 1), " y=", round(e$y, 1), "\n")
}
xy_range_str <- function(e) {
if(is.null(e)) return("NULL\n")
paste0("xmin=", round(e$xmin, 1), " xmax=", round(e$xmax, 1),
" ymin=", round(e$ymin, 1), " ymax=", round(e$ymax, 1))
}
paste0(
"click: ", xy_str(input$plot_click),
"dblclick: ", xy_str(input$plot_dblclick),
"hover: ", xy_str(input$plot_hover),
"brush: ", xy_range_str(input$plot_brush)
)
})
}
shinyApp(ui, server)
################################
如果您希望它只能旋转一个元素,您需要像这样修改js
:
js<-"$(function() {
var $elie = $(document.getElementsByClassName('form-group shiny-input-container'));
rotate(270);
function rotate(degree) {
$elie.css({ WebkitTransform: 'rotate(' + degree + 'deg)'});
$elie.css({ '-moz-transform': 'rotate(' + degree + 'deg)'});
}
});"
还需要一些工作来修复div的滑动和填充等功能,并在要旋转的所有元素上添加自定义ID:从而确保不会在元素上应用js我想从第一个例子中得到一些混乱,但它应该是一个很好的起点。
答案 1 :(得分:2)
现在使用 shinyWidgets 包中的 noUiSliderInput()
非常容易。
示例:
if (interactive()) {
### examples ----
# see ?demoNoUiSlider
demoNoUiSlider("more")
### basic usage ----
library( shiny )
library( shinyWidgets )
ui <- fluidPage(
tags$br(),
noUiSliderInput(
inputId = "noui1",
min = 0, max = 100,
value = 20
),
verbatimTextOutput(outputId = "res1"),
tags$br(),
noUiSliderInput(
inputId = "noui2", label = "Slider vertical:",
min = 0, max = 1000, step = 50,
value = c(100, 400), margin = 100,
orientation = "vertical",
width = "100px", height = "300px"
),
verbatimTextOutput(outputId = "res2")
)
server <- function(input, output, session) {
output$res1 <- renderPrint(input$noui1)
output$res2 <- renderPrint(input$noui2)
}
shinyApp(ui, server)
}
答案 2 :(得分:1)
我也在寻找它,我认为它没有实现。在闪亮的讨论组中,从2014年11月开始有一个类似的问题,它仍然是开放的。
https://groups.google.com/forum/#!searchin/shiny-discuss/vertical$20slider
搜索official gallery和网络,我找不到任何例子。所有滑块都是水平的。总是