R Shiny Flexdashboard ValueBox in Column layout - r

I need to align some elements in a column layout in a Shinydashboard which combines some elements from flexdashboard. Here's the code:
library(shiny)
library(shinydashboard)
library(flexdashboard)
ui <- dashboardPage(
dashboardHeader(title = "Dashboard"),
dashboardSidebar(),
dashboardBody(
column(3,flexdashboard::valueBoxOutput("ValueBox")),
#flexdashboard::valueBoxOutput("ValueBox"),
column(3,plotOutput("plot1",height = 150)),
column(6,h3("Gauges"),
fluidRow(
column(3,flexdashboard::gaugeOutput("Gauge1")),
column(3,flexdashboard::gaugeOutput("Gauge2"))
)
)
)
)
server <- function(input, output) {
output$ValueBox <- renderValueBox({
shinydashboard::valueBox(
value = 100,
subtitle = "Value",
icon = icon("area-chart"),
color = "aqua"
)
})
set.seed(122)
histdata <- rnorm(500)
output$plot1 <- renderPlot({
data <- histdata
hist(data)
})
output$Gauge1 <- flexdashboard::renderGauge({
gauge(60, min = 0, max = 100, symbol = "%")
})
output$Gauge2 <- flexdashboard::renderGauge({
gauge(25, min = 0, max = 100, symbol = "%")
})
}
shinyApp(ui, server)
This produces the output where the value box only fills approximately a third of the space designed for it:
When I change the valueBoxOutput to be outside of a column (comment out the first and uncomment the second line in the dashboardBody), the valuebox does fill the full allocated space, but the "Gauge" output is forced on another line rather than to the right:
How do I force the "combination" of the two approaches so that the result looks something like this?
I have tried the following without success:
Use the shinydashboard::valueBoxOutput instead
Utilize the width argument of column as well as valueBoxOutput commands

After experimenting with column widths based on ismirsehregal's answer, I have discovered what the issue was.
The UI part is correct and both ways are capable of producing the result. The issue was that the definition inside renderValueBox did not specify the width argument, which was by default set to 4 and represents the relative width compared to the parental environment. Thus, in the first case, the box takes 4/12 of the column of width 3. In the second case, the output had a width of 4+3+6=13, which is higher than 12 and hence was broken into two lines.
The following definition solves the problem:
output$ValueBox <- renderValueBox({
shinydashboard::valueBox(
value = 100,
subtitle = "Value",
icon = icon("area-chart"),
color = "aqua",
width = 12
)
})
The width = 12 sets the box to fill out the whole width of the parental environment, which in this case is a column of width 3. One can also use width = 3 directly and drop out the column definition, but the first way is preferred as the width of all three elements is specified in the UI rather than the server.

This works for me:
library(shiny)
library(shinydashboard)
library(flexdashboard)
ui <- dashboardPage(
dashboardHeader(title = "Dashboard"),
dashboardSidebar(),
dashboardBody(
flexdashboard::valueBoxOutput("ValueBox", width = "100%"), # Edit %
#flexdashboard::valueBoxOutput("ValueBox"),
column(4,plotOutput("plot1",height = 150)),
column(4,h3("Gauges"),
fluidRow(
column(6,flexdashboard::gaugeOutput("Gauge1")),
column(6,flexdashboard::gaugeOutput("Gauge2"))
)
)
)
)
server <- function(input, output) {
output$ValueBox <- renderValueBox({
shinydashboard::valueBox(
value = 100,
subtitle = "Value",
icon = icon("area-chart"),
color = "aqua"
)
})
set.seed(122)
histdata <- rnorm(500)
output$plot1 <- renderPlot({
data <- histdata
hist(data)
})
output$Gauge1 <- flexdashboard::renderGauge({
gauge(60, min = 0, max = 100, symbol = "%")
})
output$Gauge2 <- flexdashboard::renderGauge({
gauge(25, min = 0, max = 100, symbol = "%")
})
}
shinyApp(ui, server)
So here is the preferred way based on Radek Janhuba's insights - setting the appropriate width while rendering (for everyone going here later):
library(shiny)
library(shinydashboard)
library(flexdashboard)
ui <- dashboardPage(
dashboardHeader(title = "Dashboard"),
dashboardSidebar(),
dashboardBody(
column(4,flexdashboard::valueBoxOutput("ValueBox")),
column(4,plotOutput("plot1",height = 150)),
column(4,h3("Gauges"),
fluidRow(
column(6,flexdashboard::gaugeOutput("Gauge1")),
column(6,flexdashboard::gaugeOutput("Gauge2"))
)
)
)
)
server <- function(input, output) {
output$ValueBox <- renderValueBox({
shinydashboard::valueBox(
value = 100,
subtitle = "Value",
icon = icon("area-chart"),
color = "aqua",
width = 12
)
})
set.seed(122)
histdata <- rnorm(500)
output$plot1 <- renderPlot({
data <- histdata
hist(data)
})
output$Gauge1 <- flexdashboard::renderGauge({
gauge(60, min = 0, max = 100, symbol = "%")
})
output$Gauge2 <- flexdashboard::renderGauge({
gauge(25, min = 0, max = 100, symbol = "%")
})
}
shinyApp(ui, server)

Related

How to update value of sliderInput with height value from draggable plot?

I'm trying to get the value of a resizable plot (using shinyjqui) and use it to update the sliderInput. I am able to get the value however, but I'm unable to update it to the sliderInput. I tried using observe and observeEvent but I'm stuck.
Code
library(shiny)
library(shinyjqui)
library(ggplot2)
ui <- fluidPage(
tags$p("Height value from draggable plot"),
verbatimTextOutput('size_obj'),
# textInput("plotsize", label = "Plot height", value = "300"),
sliderInput("plotsize", label = "Plot height", value = 300, min = 200, max = 500),
tabsetPanel(
id = 'tabs',
tabPanel(
title = 'ggplot',
jqui_resizable(plotOutput('gg'))
)
)
)
server <- function(input, output, session) {
output$gg <- renderPlot({
ggplot(mtcars, aes(x = cyl, y = mpg)) + geom_point()
},
height=exprToFunction(as.numeric(input$plotsize))
)
# observe({
# size_obj()
# updateTextInput(session, "plotsize", value = size_obj())
# })
output$size_obj <- renderPrint({
name <- paste0('gg', '_size')
cat(#sprintf('%s(height: %s',
# input$tabs,
input[[name]]$height)
# input[[name]]$width))
})
}
shinyApp(ui, server)
If you drag the plot from the bottom right, you will notice the verbatimTextOutput change. Once the drag event is over, it goes to the default value. I would like to reverse this and make it so that the slider changes to the value of the verbatimTextOutput so that when I drag to a different height, the sliderInput updates to the new height value.
You want to do this:
library(shiny)
library(shinyjqui)
library(ggplot2)
ui <- fluidPage(
tags$p("Height value from draggable plot"),
verbatimTextOutput('size_obj'),
# textInput("plotsize", label = "Plot height", value = "300"),
sliderInput("plotsize", label = "Plot height", value = 300, min = 200, max = 500),
tabsetPanel(
id = 'tabs',
tabPanel(
title = 'ggplot',
jqui_resizable(plotOutput('gg', height = "300px"))
)
)
)
server <- function(input, output, session) {
name <- paste0('gg', '_size')
height <- reactive({
if(is.null(input[[name]]$height)) 300
else as.numeric( input[[name]]$height)
})
output$gg <- renderPlot({
updateTextInput(session, "plotsize", value = height())
ggplot(mtcars, aes(x = cyl, y = mpg)) + geom_point()
},
height=exprToFunction(height())
)
# observe({
# size_obj()
# updateTextInput(session, "plotsize", value = size_obj())
# })
output$size_obj <- renderPrint({
cat(#sprintf('%s(height: %s',
# input$tabs,
input[[name]]$height)
# input[[name]]$width))
})
}
shinyApp(ui, server)

R shiny error: Error in html tools::validateCssUnit(height); CSS units must be a single-element numeric or character vector

Am learning to use R shiny and I am trying to create a heatmap that allows the user to specify the height in plotlyOutput to prevent labels from being clumped together. My minimal working code:
library(shiny)
library(plotly)
ui <- fluidPage(
titlePanel("Heatmap"),
sidebarLayout(
sidebarPanel(
sliderInput("mapHeight",
"Heatmap Height",
min = 500,
max = 1000,
value =500),
sliderInput("L", "left adjust", min = 0, max =900, value = 80)
),
mainPanel(plotlyOutput("heatmap"))
)
)
server <- function(input, output) {
output$heatmap <- renderPlotly({
p<- heatmaply(mtcars, plot_method = "plotly")%>%
layout(margin = list(l = input$L, r =50 , t=0, b=90))
#not sure why this is being ignored
ggplotly(p, height = input$mapHeight)
})
}
shinyApp(ui = ui, server = server)
The constraint is related to the heatmaply package, the solution below is temporary while plotly continues to accept the height argument in layout.
Warning: Specifying width/height in layout() is now deprecated.
Please specify in ggplotly() or plot_ly()
You could approach the developer on their GitHub and raise and issue or better yet a pull request with the changes you propose. For the time being, the solution below works with Plotly 4.7.1.
app.R
library(shiny)
library(heatmaply)
ui <- fluidPage(
titlePanel("Heatmap"),
sidebarLayout(
sidebarPanel(
sliderInput("mapHeight", "Heatmap Height",
min = 500, max = 1000, value = 500),
sliderInput("L", "left adjust", min = 0, max = 900, value = 80)
),
mainPanel(plotlyOutput("heatmap"))
)
)
server <- function(input, output) {
output$heatmap <- renderPlotly({
heatmaply(mtcars) %>%
layout(margin = list(l = input$L, r = 50, t = 0, b = 90),
height = input$mapHeight)
})
}
shinyApp(ui = ui, server = server)

Shiny nearPoints() with slider input

I was wondering if I can get rows data using nearPoints() from an interactive graph with slider input. My app.R file looks like:
library('shiny')
library('ggplot2')
dt <-read.csv('file.csv')
ui <- fluidPage(
plotOutput("plot1", height = 550, click = "plot1_click"),
fluidRow(
column(3,
sliderInput("Obs", "Number of Books", min = 1, max = nrow(up), value = 50)
),
column(3, offset = 3,
h4("Legends"),
verbatimTextOutput("selected")
)
)
)
server <- function(input, output) {
mydata <- reactive({
dt[1:as.numeric(input$Obs),]
})
output$plot1 <- renderPlot({
test <- mydata()
ggplot(data = test, aes(x = test[,2], y = test[,1])) + geom_point()
})
output$selected <- renderPrint({
file <- mydata()
nearPoints(file, input$plot1_click, threshold = 10, maxpoints = 1,
addDist = FALSE)
})
}
shinyApp(ui = ui, server = server)
Shiny nearPoints() is working perfectly without this slider input. When I used slider input, I can't get the row data until max. Is there any approach to work with the slider input? Any help is appreciated.
The following code works for me. It seems nearPoints is not able to tell which columns of your dataset are displayed because of the aes(x = test[,2], y = test[,1]) statement. Another possible fix sould be to set the parameters xvar and yvar in nearPoints.
library('shiny')
library('ggplot2')
dt <-mtcars
ui <- fluidPage(
plotOutput("plot1", height = 550, click = "plot1_click"),
fluidRow(
column(3,
sliderInput("Obs", "Number of Cars", min = 1, max = nrow(dt), value = 50)
),
column(3, offset = 3,
h4("Legends"),
verbatimTextOutput("selected")
)
)
)
server <- function(input, output) {
mydata <- reactive({
dt[1:as.numeric(input$Obs),]
})
output$plot1 <- renderPlot({
test <- mydata()
ggplot(data = test, aes(mpg, wt)) + geom_point()
})
output$selected <- renderPrint({
file <- mydata()
nearPoints(file, input$plot1_click, threshold = 100, maxpoints = 1,
addDist = FALSE)
})
}
shinyApp(ui = ui, server = server)
Quick note: Please try to make the code in your question reproducible by using one of the default datasets in R. You can get a list of all available datasets by calling data().

rBokeh dynamic plot size

I am trying to create an rBokeh plot as an output in my Shiny app with rbokehOutput('plot') in the ui and
output$plot <- renderRbokeh({
figure() %>%
ly_hexbin(x,y)
})
in the server part. I'd like the size of the plot to be dynamic in a sense that it should dynamically resize to fill the entire plot window. I've been playing with the height and width arguments, both in the ui and server parts, but have not been able to make it work; I also tried using sizing_mode = "stretch_both" in the server part. When I display the plot in RStudio without Shiny, the plot does not fill the entire plot window either, it keeps its square shape and aspect ratio. I would like it to behave like a normal R plot, i.e. when I enlarge the plot window, the plot automatically resizes to fill the full window. I found this link, but it only deals with Python implementation. Ideally, I would like the height in Shiny to be fixed at 500px and the width to change dynamically based on the (size of) browser.
Minimal working example:
library(shiny)
library(rbokeh)
ui <- fluidPage(
titlePanel("Hello Shiny!"),
sidebarLayout(
sidebarPanel(
sliderInput('numpoint', 'Number of points to plot', min = 10, max = 1000, value = 200)
),
mainPanel(
rbokehOutput('plot', width = "98%", height = "500px")
)
)
)
server <- function(input, output) {
output$plot <- renderRbokeh({
x <- seq(1, 100, length = input$numpoint)
y <- rnorm(input$numpoint, sd = 5)
figure() %>%
ly_hexbin(x,y)
})
}
shinyApp(ui, server)
Updated MWE:
library(shiny)
library(rbokeh)
ui <- fluidPage(
titlePanel("Hello Shiny!"),
sidebarLayout(
sidebarPanel(
sliderInput('numpoint', 'Number of points to plot', min = 10, max = 1000, value = 200)
),
mainPanel(
fluidRow(
column(12,
rbokehOutput('plot', height = "800px")
)
),
fluidRow(
column(12,
plotOutput('plot1', height = "800px")
)
)
)
)
)
server <- function(input, output) {
output$plot <- renderRbokeh({
x <- seq(1, 100, length = input$numpoint)
y <- rnorm(input$numpoint, sd = 5)
figure(width = 1800, height = 800) %>%
ly_hexbin(x,y)
})
output$plot1 <- renderPlot({
x <- seq(1, 100, length = input$numpoint)
y <- rnorm(input$numpoint, sd = 5)
plot(x,y)
})
}
shinyApp(ui, server)
Updating my answer..
I've added width and height into my call to figure() and the plot now re-sizes responsively.
library(shiny)
library(rbokeh)
ui <- fluidPage(
titlePanel("Hello Shiny!"),
sidebarLayout(
sidebarPanel(
sliderInput('numpoint', 'Number of points to plot', min = 10, max = 1000, value = 200)
),
mainPanel(
rbokehOutput('plot', width = "100%", height = "800px")
)
)
)
server <- function(input, output) {
output$plot <- renderRbokeh({
x <- seq(1, 100, length = input$numpoint)
y <- rnorm(input$numpoint, sd = 5)
figure(width = 1800, height = 800) %>%
ly_hexbin(x,y)
})
}
shinyApp(ui, server)
Is this what you wanted?
Inside of your ui body, you can add the following code:
# This will dynamically set the width of the rBokeh plots
tags$head(tags$script('var dimension = [0, 0];
$(document).on("shiny:connected", function(e) {
dimension[0] = window.innerWidth;
dimension[1] = window.innerHeight;
Shiny.onInputChange("dimension", dimension);
});
$(window).resize(function(e) {
dimension[0] = window.innerWidth;
dimension[1] = window.innerHeight;
Shiny.onInputChange("dimension", dimension);
});
'))
Then you can use the dynamic size as an input oject like
figure(width = input$dimension[1], height = input$dimension[2],

flexdashboard:gauge plot does not render in ShinyDashBoard and corrupts the ValueBox

I am trying to plot a gauge plot within ShinyDashBoard and I am seeing two issues.
1) The gauge plot does not render
2) It somehow corrupts the ValueBox in the dashboard.
Below is the code to replicate this issue.
library(shiny)
library(shinydashboard)
#library(flexdashboard)
ui <-dashboardPage(
dashboardHeader(),
dashboardSidebar(),
dashboardBody(
fluidRow(
valueBoxOutput("vbox1"),
column(6,box(plotOutput("plt1"),width=12,title="Gauge Graph",background ="green") ),
column(6,box(plotOutput("plt2"),width=12,title="Graph2",background="yellow") )
),
fluidRow( actionButton("plot","plot") )
)
)
server <- shinyServer(function(input, output, session) {
observeEvent(input$plot,{
output$plt1 <- renderPlot({
flexdashboard::gauge(56, min = 0, max = 100, symbol = '%', label = paste("Test Label"),gaugeSectors(
success = c(100, 6), warning = c(5,1), danger = c(0, 1), colors = c("#CC6699")
))
})
output$plt2 <- renderPlot({plot(runif(100),runif(100))})
})
output$vbox1 <- renderValueBox({
valueBox(
"Gender",
input$count,
icon = icon("users")
)
})
})
shinyApp(ui = ui, server = server)
Also plots generated using plotly library :-(
Any help on resolving this issue is much appreciated. Thanks in advance.
I ran into the same issue!
It's a UI thing -- look at your code when you call the server output. You'll want to use flexdashboard::gaugeOutput("plt1") instead of plotlyOutput. That should solve the problem.
Reference: https://cran.r-project.org/web/packages/flexdashboard/flexdashboard.pdf
(i.e. just the flexdashboard package page).
You should use renderGauge instead of renderPlot. And gaugeOutput instead of plotOutput.
1.In UI
column(6,box(gaugeOutput("plt1"),width=12,title="Gauge Graph",background ="green") )
In Server
output$plt1 <- renderGauge({
flexdashboard::gauge(56, min = 0, max = 100, symbol = '%', label = paste("Test Label"),gaugeSectors(
success = c(100, 6), warning = c(5,1), danger = c(0, 1), colors = c("#CC6699")
))
})
2.
output$vbox1 <- renderValueBox({
shinydashboard::valueBox(
"Gender",
input$count,
icon = icon("users")
)
})

Resources