By default, flexdashboard displays all images using the same predefined size.
Hence, I want to be able to do the following two things:
be able to display the image so it occupies the full availale space (maximize it), and / or
be able to allow a user to modify image size interactively using shiny sliders.
Is that possible to do? At least the first of these tasks, which seems easier.
Below is the .Rmd code and the screenshot of what it does now. You'll note the image is cut at the bottom and I don't know how to change its size.
---
title: "Resizable ggplot images in flexdashboard"
output:
flexdashboard::flex_dashboard:
vertical_layout: fill
orientation: columns
runtime: shiny
---
## Left column ----
This dashboard shows how you can resize ggplot images in 'flexdashboard'.
## Right column, where the shiny sliders and image are displayed ---
```{r}
library(ggplot2)
# fluidPage( # This does not help
fluidRow(
column(width=4, checkboxInput("maximize_image", "Maximize image", T) ),
column(width=4, sliderInput("image_width", "Image width", 2, 6, 3) ),
column(width=4, sliderInput("image_height", "Image height ", 2, 9, 4) )
)
renderPlot(
ggplot(pressure) + geom_point (aes(temperature,pressure))
)
# )
# end of .Rmd code
The following code seems to do the trick:
library(ggplot2)
fluidRow(
# column(width=4, checkboxInput("maximize_image", "Maximize image", T) ),
column(width=4, sliderInput("image_width", "Image width", 50, 100, 50) ),
column(width=4, sliderInput("image_height", "Image height ", 50, 100, 50 ) ),
)
renderUI(
fillPage(
div(style = paste0("width: ", input$image_width, "%;", " height: ", input$image_height, "%;"),
renderPlot( ggplot(pressure) + geom_point (aes(temperature,pressure)) ) )
)
)
It's probably not the best (as it does not know the maximum visible space, so you have to manually play with slider to find out that height=87% is the one you are looking for.
Still though, I'm surprised I could not find it anywhere, because it seems super-handy.
Related
I would like to make a datatable using DT that does not change width when the browser window changes. The example below almost does what I am trying to do, all of the column widths are locked except the first column, which is still flexible. I would like all of the columns to be locked without specifying widths in pixels for each column.
library(DT)
library(dplyr)
datatable(mtcars,
options = list(
autowidth = TRUE
)) %>%
formatStyle(columns = 1:ncol(mtcars),
`width` = "100%")
The following Rmd document gives a fixed width of 100 pixels to the datatable
---
output: html_document
---
```{r}
shiny::div(
width = "100px",
DT::datatable(mtcars))
```
The usage in shiny is similar
shiny::shinyApp(
ui = shiny::div(
width = "100px",
DT::datatable(mtcars)),
server = function(...){}
)
When I insert an embedded shiny app to my document like showed on Embedded Shiny Apps, with “runtime: shiny” in the YAML and click the button “Run Document” there are only image placeholder icons.
But when I remove the shiny app and also remove the “runtime: shiny” from the YAML the embedded image is visible after rendering.
The following to links have the topic of embedding images but none solves my issue – in both cases the image placeholder icon remains.
https://github.com/rstudio/rmarkdown/issues/504
Embedding Image in Shiny App
Question:
What should I change in my code to get the images?
Or has it something to do with my initial choice of encoding?
Below my code example with an embedded shiny app – so when necessary you just need to copy and paste. The shiny app is just a copy from the r studio gallery…
EDIT: As suggested by timfaber I added the renderImage() parts in the code. But two question concering the rendering still remain.
How can I suppress the need for scroll up or down to see the entire image? and How can I position an image in an shiny app?
---
title: "Documentation"
author: "tueftla"
date: "23 Mai 2017"
output: html_document
runtime: shiny
---
```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = TRUE)
library(shiny)
```
Here is my documentation …
and also one of the images.
# my old version
#
#
```{r, echo=FALSE}
# Here you have to scroll up or down to see the entire image
shinyApp(
ui = fluidPage(
imageOutput("image1")
),
server = function(input, output) {
output$image1=renderImage({
# the images are stored in a subdirectory named images
filename <- normalizePath(file.path('./images',
paste('image1', '.png', sep='')))
# Return a list containing the filename
list(src = filename, height = 600,width=800)
}, deleteFile = FALSE)
}
)
```
In the second code sequence I want to position the image at the right. See the comment "old version"
```{r, echo = FALSE}
shinyApp(
ui = fluidPage(
# Application title
titlePanel("Tabsets"),
# my old version
#img(src=image2.png', align = "right"),
# my new version with bad alignment - note also the change in server
imageOutput("image2", height = 200,width=100),
# Sidebar with controls to select the random distribution type
# and number of observations to generate. Note the use of the
# br() element to introduce extra vertical spacing
sidebarLayout(
sidebarPanel(
radioButtons("dist", "Distribution type:",
c("Normal" = "norm",
"Uniform" = "unif",
"Log-normal" = "lnorm",
"Exponential" = "exp")),
br(),
sliderInput("n",
"Number of observations:",
value = 500,
min = 1,
max = 1000)
),
# Show a tabset that includes a plot, summary, and table view
# of the generated distribution
mainPanel(
tabsetPanel(type = "tabs",
tabPanel("Plot", plotOutput("plot")),
tabPanel("Summary", verbatimTextOutput("summary")),
tabPanel("Table", tableOutput("table"))
)
)
)
),
server = function(input, output) {
# the image rendering - necessary for the image in ui of this app
output$image2=renderImage({
# the images are stored in a subdirectory named images
filename <- normalizePath(file.path('./images',
paste('image2', '.png', sep='')))
# Return a list containing the filename
list(src = filename, height = 200,width=100)
}, deleteFile = FALSE)
# Reactive expression to generate the requested distribution.
# This is called whenever the inputs change. The output
# functions defined below then all use the value computed from
# this expression
data <- reactive({
dist <- switch(input$dist,
norm = rnorm,
unif = runif,
lnorm = rlnorm,
exp = rexp,
rnorm)
dist(input$n)
})
# Generate a plot of the data. Also uses the inputs to build
# the plot label. Note that the dependencies on both the inputs
# and the data reactive expression are both tracked, and
# all expressions are called in the sequence implied by the
# dependency graph
output$plot <- renderPlot({
dist <- input$dist
n <- input$n
hist(data(),
main=paste('r', dist, '(', n, ')', sep=''))
})
# Generate a summary of the data
output$summary <- renderPrint({
summary(data())
})
# Generate an HTML table view of the data
output$table <- renderTable({
data.frame(x=data())
})
},
)
```
I hope I gave enough information... but when something is missing please comment. I will edit my question.
Many thanks in advance!
Second Edit: The following is showing my folder structure and the result.
I think it can be done a lot easier. For me the problem was defining the right path for the image. No need to use renderImage! Scaling the image resolves the scrolling and using img allows you to define the position (alignment):
---
title: "Documentation"
author: "tueftla"
date: "23 Mai 2017"
output: html_document
runtime: shiny
---
```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = TRUE)
library(shiny)
```
Here is my documentation …
and also one of the images.
```{r, echo = FALSE}
fluidPage(
titlePanel("Tabsets"),
img(src='www/logotitle.jpg', align = "right",width=100,height=100),
# make sure you define the right (full) path
sidebarLayout(
sidebarPanel(
radioButtons("dist", "Distribution type:",
c("Normal" = "norm",
"Uniform" = "unif",
"Log-normal" = "lnorm",
"Exponential" = "exp")),
br(),
sliderInput("n",
"Number of observations:",
value = 500,
min = 1,
max = 1000)
),
mainPanel(
tabsetPanel(type = "tabs",
tabPanel("Plot", plotOutput("plot")),
tabPanel("Summary", verbatimTextOutput("summary")),
tabPanel("Table", tableOutput("table"))
)
)
))
data <- reactive({
dist <- switch(input$dist,
norm = rnorm,
unif = runif,
lnorm = rlnorm,
exp = rexp,
rnorm)
dist(input$n)
})
# Generate a plot of the data. Also uses the inputs to build
# the plot label. Note that the dependencies on both the inputs
# and the data reactive expression are both tracked, and
# all expressions are called in the sequence implied by the
# dependency graph
output$plot <- renderPlot({
dist <- input$dist
n <- input$n
hist(data(),
main=paste('r', dist, '(', n, ')', sep=''))
})
# Generate a summary of the data
output$summary <- renderPrint({
summary(data())
})
# Generate an HTML table view of the data
output$table <- renderTable({
data.frame(x=data())
})
```
You can remove the renderImage part and all the ui/server functions (as stated earlier), simply keeping the render functions and tabsets. My result:
My goal is to divide the page in four quadrant, each with a separate set of plots.
I have one quadrant ready. It looks ok when it occupies the entire window. I would like to have 4 such panes on a single page. As you can see from the screenshot (of the two upper quadrants), inserting the pane that is already ready in the upper left quadrant results in something very blurry. How can I have the graphs not become blurry?
I used fluidrow, perhaps is this not a good idea?
ui = fluidPage(
fluidRow(
column(6,
fluidRow(
column(8, plotOutput("barChart1", height = 250))
, column(4, plotOutput("compteur1", height = 250))
)
,fluidRow(
column(3,
dateRangeInput(
"dateRange2",
label = "Choose the window:",
start = "2016-09-01"
)
)
, column(3,
selectInput("security", "Index:", selected = worldindices[1]
, list(`World Indices` = worldindices,
`Regional Indices` = regionIndices,
`Country Indices` = countryIndices)
)
)
, column(3,
selectInput("metric", "Metric:", selected = plainMetrics[1]
, list(plainMetrics
, `Valuation Multiples` = valMul
, `Fundamentals` = corpFund)
)
)
)
, plotOutput("chartAggr", height = 250)
)
, column(6, style = "background-color:yellow;", div(style = "height:500px;")
)
)
)
Kind regards
EDIT - FOLLOWING ANSWER BELOW:
Trying to give a higher value to the res parameter of renderPlot on the server side does not seem to work. I gave it for instance the value 128, and get the following result:
In your renderPlot() function on the server pass in the res argument... set it to something higher than the default 72 pixels/inch.
renderPlot(expr, width = "auto", height = "auto", res = 72, ..., env
= parent.frame(), quoted = FALSE, execOnResize = FALSE, outputArgs = list())
Note you may need to adjust the size of your plot and add scrollbars to your containers to accommodate the larger high resolution image.
## Something like this on the server
output$barChart1 <- renderPlot(PLOT(), width = 1000, height = 1000, res = 128)
## Something like this on UI
div(style = 'overflow-x: scroll',
plotOutput("barChart1", inline = TRUE))
)
I know this is an old post, but I thought I'd share my solution to the problem.
I was scaling the height of my plot proportionately to the plot's width in order to fix the aspect ratio using the following renderPlot code:
observeEvent({
input$timelinecontinentselector
input$timelinearrangeselector
input$timelinesmoothselector == TRUE
}, {
output$timeline_plot <- renderPlot({
timeline_plotting()
}, height = function() {
round(session$clientData$output_timeline_plot_width * 0.4)
})
})
Crucially, without the round() function initially. I can only assume that the expression produced a height value with decimals which caused the renderer to struggle. The issue disappeared once the value was rounded to a whole number.
I'm building an R FlexDashboard in storyboard format. I'd like to display multiple plots on a few of the storyboard pages, including a series of linked plots using crosstalk. However, when I try to display multiple plots on a page or use the bscols() function, the page looks all messed up. Are multiple plots allowed in R FlexDashboard's storyboard format? Here is an example:
---
title: "Error_example"
output:
flexdashboard::flex_dashboard:
storyboard: true
theme: bootstrap
---
###Example: Why can't won't the datatable show up below the plot in this storyboard?
```{r}
library(plotly)
library(DT)
plot1<-plot_ly(data=diamonds,x=~carat,y=~price)
table1<-datatable(diamonds)
plot1
table1
bsCols() Seems to completely override the flexdashboard CSS so I would avoid using that.
A simple solution would be to add some divs into the R chunk. Something like:
---
title: "I think this should work"
output:
flexdashboard::flex_dashboard:
storyboard: true
theme: bootstrap
---
###Example: Using divs to separate outputs
```{r}
library(shiny)
library(plotly)
library(DT)
plot1<-plot_ly(data=diamonds,x=~carat,y=~price)
table1<-datatable(diamonds)
tags$div(
tags$div(
plot1
),
tags$div(
table1
)
)
```
This example combines crosstalk, leaflet and plotly, in a way which allows for a high number of plots. The trick is to use absolutepanels with collapsable buttons. The absolutepanel sits over the leaflet map, which means the map can be full size like in superzip https://shiny.rstudio.com/gallery/superzip-example.html, while the buttons allow plots to appear on an as needs basis. So you can add as many plots and tables as youe like, link them with crosstalk, and still tell your story.
This makes a clean interface where plots are included in a way which the user has greater control over the final display. Another example is here How to combine row and column layout in flexdashboard?, but without crosstalk.
---
title: "Demo"
output:
flexdashboard::flex_dashboard:
orientation: columns
vertical_layout: fill
---
```{r setup, include=FALSE}
library(flexdashboard)
library(rmarkdown)
library(plotly)
library(shiny)
library(DT)
```
```{r}
library(crosstalk)
sd <- SharedData$new(quakes[sample(nrow(quakes), 100),])
```
Map { data-icon="fa-map-o"}
=====================================
Sidebar {.sidebar data-width=220}
--------------------------------
```{r, results='asis'}
filter_slider("mag", "Magnitude", sd, column=~mag, step=0.1, width=200)
```
Column {data-width=400}
--------------------------------
### Planet Earth
```{r}
library(leaflet)
leaflet(sd) %>% addTiles() %>% addMarkers()
```
```{r}
##########################
absolutePanel(id = "controls", class = "panel panel-default", fixed = TRUE,
draggable = TRUE, top = 70, left = "auto", right = 20, bottom = "auto",
width = '25%', height = 'auto',
style = "overflow-y:scroll; max-height: 1000px; opacity: 0.9; style = z-index: 400",
h4(strong("Plot Explorer")),
HTML('<button data-toggle="collapse" data-target="#box1" class="btn-block btn-primary">dot plot</button>'),
tags$div(id = 'box1', class="collapse in",
plot_ly(sd, x = ~depth, y = ~mag) %>% layout(height=200)
),
HTML('<button data-toggle="collapse" data-target="#box2" class="btn-block btn-warning">histogram</button>'),
tags$div(id = 'box2', class="collapse",
plot_ly(sd, x = ~depth, y = ~mag, type = "histogram", name = "Histogram") %>% layout(height=200)
),
HTML('<button data-toggle="collapse" data-target="#box3" class="btn-block btn-danger">table</button>'),
tags$div(id = 'box3', class="collapse in",
datatable(sd, extensions="Scroller", style="bootstrap", class="compact", width="100%",height = 300,
options=list(deferRender=TRUE, scrollY=300, scroller=TRUE))
)
)
```
I'm producing some pretty big plots (a grid of about 100 bar graphs). I use verticallayout with the default of fluid = TRUE. I have the size set in my server function
output$hist7 <- renderPlot({ #actual plot excluded though any will do
}, height=1000, width=800)
When I try to place text below this plot with h1("text here"),
"text here" ends up in the middle of hist7. This issue does not occur with any of the plots I didn't set the size for, this is the only one large enough that I have to set a size to prevent shiny scaling it down
The fix should be
ui.R
plotOutput(outputId = 'plot2', width = "700px", height = "600px")
server.R
output$plot2 <- renderPlot({
p <- ggplot(...) + geom_bar(stat="identity", ...)
p
}, width = 700, height = 600)
I had success using inline=TRUE argument in plotOutput and then adding a br() between the plot and my text. E.g.,
column(
plotOutput("my.plot", inline = TRUE),
br(),
h1("my text here")
)
The trick is specifying the same plot size in the ui: plotOutput("hist6", height=1000, width=800)