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%"
)
})
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.
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)
}
I'm trying to place a selectInput box beside an actionButton in a shiny app, using fluidRow & column arguments. However the button gets placed at the top of its column.
Using text-align:center in the div places the button centre-top in the column view. I'd like the actionButton to be at the same height as the selectBox on its left.
I'm just beginning to get into some CSS because of Shiny but am at a loss here.
Thanks in advance :)
ui <- fluidPage(title = "Working Title",
sidebarPanel(width = 6,
# *Input() functions
fluidRow(column(6, selectInput("Input1", label = h3("Select Input 1"), choices = list( "A" = "A", "B" = "B"), selected = 1)),
column(6, div(style = "background-color:yellow; text-align:center;", actionButton("goButtonSetInput1", "SetInput1")))
)
)
)
server <- function(input, output) {
}
shinyApp(ui = ui, server = server)
You can do that by adding another fluidRow, and setting the label =NULL
ui <- fluidPage(title = "Working Title",
sidebarPanel(width = 6,
# *Input() functions
fluidRow(column(6, h3("Select Input 1") )),
fluidRow(column(6, selectInput("Input1", label = NULL, choices = list( "A" = "A", "B" = "B"), selected = 1)),
column(6, div(style = "background-color:yellow; text-align:center;", actionButton("goButtonSetInput1", "SetInput1")))
)
)
)
server <- function(input, output) {
}
shinyApp(ui = ui, server = server)
I have a top banner that I want to split into two separate sections representing two different inputs. To do this, I've created a fluidRow and with two columns, one for each input. However, as it is now there is a little bit of white space between the columns, despite putting offset = 0. Is there any way to remove this white space so that the columns are immediately next to one another?
colors = c("green","blue","red")
library(shiny)
ui <- fluidPage(
tabsetPanel(
tabPanel("Info",
fluidRow(
column(width = 6, offset = 0,
div(style = "height:50px;width:100%;background-color: #999999;border-style: solid;border-color: #000000",
tags$h3("Section 1")
)
),
column(width = 6, offset = 0,
div(style = "height:50px;width:100%;background-color: #999999;border-style: solid;border-color: #000000",
tags$h3("Section 2")
)
)
),
fluidRow(
column(width = 6, offset = 0,
div(style = "height:50px;width:100%;background-color: #999999;border-style: solid;border-color: #000000",
selectInput(inputId = "color",label = "color:",
choices = colors,
selected = colors[2],
multiple = FALSE)
)
),
column(width = 6, offset = 0,
div(style = "height:50px;width:100%;background-color: #999999;border-style: solid;border-color: #000000",
selectInput(inputId = "points",label = "Number of Points:",
choices = c("30","60","90"),
selected = "10",
multiple = FALSE) )
)
),
br(),
br(),
fluidRow(
actionButton(inputId = "go",
label = "Update"
)
),
fluidRow(
plotOutput("plot", width = "100%")
)
)
)
)
server <- function(input, output,session) {
data = eventReactive(input$go, {
var1 = rnorm(isolate(as.numeric(input$points)),5)
cat1 = c(rep("red",length(var1)/3),rep("blue",length(var1)/3),rep("green",length(var1)/3))
data = cbind.data.frame(var1,cat1)
plotdata = data[which(data$cat1 ==isolate(input$color)),]
}
)
output$plot = renderPlot({
plotdata = data()
plotcol = isolate(input$color)
plot(plotdata$var1, col = plotcol)
})
}
shinyApp(ui = ui,server = server)
The white space is the padding of the column div. To remove that, use
column(width = 6, offset = 0, style='padding:0px;', ...)
I have an app with two Highcharts plot, when I start the app the width of the two plots are correct, but everytime I change the mean input, the width of the first plot is set to the width of the second, like this :
When I start the app :
When I change the input :
My code to produce the app :
library(rCharts)
library(shiny)
runApp(list(
ui = fluidPage(
title = "App title",
titlePanel(strong("App title", style="color: steelblue")),
sidebarLayout(
sidebarPanel(width = 2,
br()),
mainPanel(width = 10,
tabsetPanel(
tabPanel("Tab 1",
selectInput(inputId = "input_mean", label = "Mean : ", choices = c(20:30)),
fluidRow(
column(8,
showOutput(outputId = "chart1", lib = "highcharts")
, br(), br(), br(), br(), br(), br(), br(), br(), br(), br(), br()),
column(4,
showOutput(outputId = "chart2", lib = "highcharts"))
)
)
)
)
)
),
server = function(input, output) {
my_data <- reactive({
rnorm(n = 30, mean = as.numeric(input$input_mean))
})
output$chart1 <- renderChart2({
my_data = my_data()
h2 <- Highcharts$new()
h2$chart(type="line")
h2$series(data=my_data, name = "One", marker = list(symbol = 'circle'), color = "lightblue")
h2$set(width = 800, height = 400)
return(h2)
})
output$chart2 <- renderChart2({
my_data = my_data()
my_mean = as.numeric(input$input_mean)
part = data.frame(V1 = c("Sup", "Inf"), V2 = c(sum(my_data>my_mean), sum(my_data<my_mean)))
p = hPlot(x = "V1", y = "V2", data = part, type = "pie")
p$tooltip(pointFormat = "{series.name}: <b>{point.percentage:.1f}%</b>")
p$params$width <- 200
p$params$height <- 200
return(p)
})
}
))
I use rCharts_0.4.5 and shiny_0.9.1.
Thanks !
Replace these lines:
h2$chart(type="line")
h2$set(width = 800, height = 400)
as follows:
h2$chart(type="line", width = 800, height = 400)
This should help.