I've come across some open issues when looking for a way to make a vertical slider in R Shiny apps, to put next to one of my plots so that the user can "move a horizontal line" in the plot with a slider that follows the same range as the plot's y axis.
I managed to make the slider turn vertical, but it still wants the mouse to be dragged horizontal. Anyone a clue how to attack this with css to rotate the drag action?
library(shiny)
ui <- fluidPage(
fluidRow(
column(3,
sliderInput(inputId = 'myslider1', label = 'Change vertical', min = -5, max = 6.3, step = 0.1, value = -6)
),
column(3,
sliderInput(inputId = 'myslider2', label = 'Change horizontal', min = -5, max = 6.3, step = 0.1, value = 0)
), style = "margin-top:200px"
),
tags$style(HTML(".js-irs-0 { transform: rotateZ(270deg)}")),
tags$style(HTML(".js-irs-0 .irs-bar-edge, .js-irs-0 .irs-bar {background: yellow}"))
)
server <- function(input, output, session) {
}
shinyApp(ui = ui, server = server)
There is this function noUiSliderInput() from the shinyWidgets package that does what you need.
See example below:
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)
}
Related
I'm trying to change the color of my sliders in R shiny from blue to black and I was able to do it for the first one but I can't make it work for the others. It's probably because they are conditional so I'm not sure how to change the color of those. Could someone help me please? Here is my code
library(shiny)
library(shinyjs)
library(shinyWidgets)
library(shinydashboard)
MyData <- read.csv("/Users/s/Desktop/ShinyTest/ForShiny8.csv")
# Define UI ----
ui <- dashboardPage(
dashboardHeader(title = "PP",
titleWidth = 500),
dashboardSidebar(disable = TRUE),
dashboardBody(
useShinyjs(),
box(
#change color to red
status = "danger",width = 8,
fluidRow(
column(6,
selectInput("DrillName1",
label = "Choose a Drill:",
choices = unique(MyData$Drill),
selected = NULL,
multiple = FALSE),
),
column(6,
sliderInput("slider1",
label = ("Time in minutes"),
min = 0,
max = 60,
value = 0),
)
),
fluidRow(
conditionalPanel(
condition = "input.num > '1'",
column(6,
selectInput("DrillName2",
label = "Choose a Drill:",
choices = unique(MyData$Drill),
selected = NULL,
multiple = FALSE),
),
column(6,
sliderInput("slider2",
label = ("Time in minutes"),
min = 0,
max = 60,
value = 0,
),
),
)
),
#change color of slider
setSliderColor(c("black"),c(1,2))
)
)
)
# Define server logic ----
server <- function(input, output, session) {
}
# Create Shiny app ----
shinyApp(ui = ui, server = server)
This should work for you.
Since you have multiple sliders you need to chose a color for each id.
setSliderColor(c("black", "black"),c(1,2))
Alternatively, another approach if you want all sliders to be the same color is to use shinyWidgets::chooseSliderSkin. You can add that in your dashboardBody or fluidPage and set the color property to your choosing or even a different slider UI.
Layout-Question: Attached the following figure. I try to adjust the layout in the following way such that I achieve the "red" extensions. Any suggestions how to do that?
library(shiny)
# Define UI for application that draws a histogram
ui <- fluidPage(
mainPanel(width = 12,
fluidRow(
column(6, offset = 0, uiOutput("f1")),
column(6, offset = 0, uiOutput("f2"))
),
fluidRow(
column(4, offset = 0, uiOutput("f3")),
column(4, offset = 0, uiOutput("f4")),
column(4, offset = 0, uiOutput("f5"))
)
)
)
# Define server logic required to draw a histogram
server <- function(input, output) {
output$f1 <- renderUI({
selectizeInput(inputId = "select_visualize_aggregation",
label = "F1",
choices = c("day", "week"),
selected = "week",
multiple = FALSE
)
})
...
}
# Run the application
shinyApp(ui = ui, server = server)
Set width = "100%" in selectizeInput:
output$f1 <- renderUI({
selectizeInput(inputId = "select_visualize_aggregation",
label = "F1",
choices = c("day", "week"),
selected = "week",
multiple = FALSE,
width = "100%"
)
})
I wanna have a plot with dynamic size and all should happen in the shinyUI.
Here is my code:
shinyUI{
sidebarPanel(
sliderInput("width", "Plot Width", min = 10, max = 20, value = 15),
sliderInput("height", "Plot Height", min = 10, max = 20, value = 15)
)
mainPanel(
plotOutput("plot", width="15cm", height="15cm")
)
}
I set "15cm" only to see the plot.
I tried different methods to take the data from the sliderInputs and bring it to the plotOutput. I tried "input.height", "input$heigt" but nothing worked.
You must use the inputs in the server side, for example here is one solution :
And the unit of the width and height must be a valid CSS unit, i'm not sure that "cm" is valid, use "%" or "px" (or an int, it will be coerced to a string with "px" at the end)
library(shiny)
runApp(list(
ui = pageWithSidebar(
headerPanel("Test"),
sidebarPanel(
sliderInput("width", "Plot Width (%)", min = 0, max = 100, value = 100),
sliderInput("height", "Plot Height (px)", min = 0, max = 400, value = 400)
),
mainPanel(
uiOutput("plot.ui")
)
),
server = function(input, output, session) {
output$plot.ui <- renderUI({
plotOutput("plot", width = paste0(input$width, "%"), height = input$height)
})
output$plot <- renderPlot({
plot(1:10)
})
}
))
I'm trying to access an input field in mainPanel from the sidebarPanel, but I couldn't succeed.
Code:
shinyUI(pageWithSidebar{
sidebarPanel(
sliderInput("x", "X", min = 10, max = 100, value = 50)
),
mainPanel(
#this is where I wanna use the input from the sliderInput
#I tried input.x, input$x, paste(input.x)
)
})
Where seems to be the problem? Or isn't possible to use the input from the sidebarPanel in the mainPanel?
You can only use the inputs in the server side.
For example :
library(shiny)
runApp(list(
ui = pageWithSidebar(
headerPanel("test"),
sidebarPanel(
sliderInput("x", "X", min = 10, max = 100, value = 50)
),
mainPanel(
verbatimTextOutput("value")
)
),
server = function(input, output, session) {
output$value <- renderPrint({
input$x
})
}
))
EDIT ::
Dynamically set the dimensions of the plot.
Use renderUi to render a plot output using the values of your inputs.
library(shiny)
runApp(list(
ui = pageWithSidebar(
headerPanel("Test"),
sidebarPanel(
sliderInput("width", "Plot Width (%)", min = 0, max = 100, value = 100),
sliderInput("height", "Plot Height (px)", min = 0, max = 400, value = 400)
),
mainPanel(
uiOutput("ui")
)
),
server = function(input, output, session) {
output$ui <- renderUI({
plotOutput("plot", width = paste0(input$width, "%"), height = paste0(input$height, "px"))
})
output$plot <- renderPlot({
plot(1:10)
})
}
))
I wanna have a plot with dynamic size and all should happen in the shinyUI.
Here is my code:
shinyUI{
sidebarPanel(
sliderInput("width", "Plot Width", min = 10, max = 20, value = 15),
sliderInput("height", "Plot Height", min = 10, max = 20, value = 15)
)
mainPanel(
plotOutput("plot", width="15cm", height="15cm")
)
}
I set "15cm" only to see the plot.
I tried different methods to take the data from the sliderInputs and bring it to the plotOutput. I tried "input.height", "input$heigt" but nothing worked.
You must use the inputs in the server side, for example here is one solution :
And the unit of the width and height must be a valid CSS unit, i'm not sure that "cm" is valid, use "%" or "px" (or an int, it will be coerced to a string with "px" at the end)
library(shiny)
runApp(list(
ui = pageWithSidebar(
headerPanel("Test"),
sidebarPanel(
sliderInput("width", "Plot Width (%)", min = 0, max = 100, value = 100),
sliderInput("height", "Plot Height (px)", min = 0, max = 400, value = 400)
),
mainPanel(
uiOutput("plot.ui")
)
),
server = function(input, output, session) {
output$plot.ui <- renderUI({
plotOutput("plot", width = paste0(input$width, "%"), height = input$height)
})
output$plot <- renderPlot({
plot(1:10)
})
}
))