Flexible height of plot in shiny app - r

I´m searching for a method to change the height parameter in plotOutput() depending on an input$.. value.
Any suggestions?
Samuel

Here you go:
library(shiny)
shinyApp(
ui = fluidPage(
numericInput("height", "height", 300),
plotOutput("plot", height = "auto")
),
server = function(input, output, session) {
output$plot <- renderPlot({
plot(1:10)
},
height = function(x) input$height)
}
)

Related

Fixing top section in shiny

Is there a way to fix the top section of the dashboard here. Right now, the widgets (selectinput) are fixed, but when the user scroll down, it gets covered by the datatable. Can we not make sure this does not get covered and only datatable moves down?
library(shiny)
library(DT)
ui <- shinyUI(fluidPage(
titlePanel(fluidRow(
div(column(12, align="center",
selectInput("rmd1", "RMDw", choices = c(1,2)),
selectInput("rmd2", "RMD2", choices = c(1,2))
), style = "position:fixed; width:inherit;")
)),
br(),br(),br(),br(),br(),br(),br(),br(),br(),br(),br(),br(),br(),br(),br(),
dataTableOutput("uioutput", height = "2000px")
))
server <- function(input, output, session) {
output$uioutput <- renderDataTable({
datatable(iris)
})
}
shinyApp(ui, server)
You can use the CSS z-index property to control the stack order the HTML elements:
library(shiny)
library(DT)
ui <- shinyUI(fluidPage(
titlePanel(fluidRow(
div(column(12, align="center",
selectInput("rmd1", "RMDw", choices = c(1,2)),
selectInput("rmd2", "RMD2", choices = c(1,2))
), style = "position:fixed; width:inherit; z-index: 1; background-color: white;")
)),
br(),br(),br(),br(),br(),br(),br(),br(),br(),br(),br(),br(),br(),br(),br(),
dataTableOutput("uioutput", height = "2000px")
))
server <- function(input, output, session) {
output$uioutput <- renderDataTable({
datatable(iris)
})
}
shinyApp(ui, server)
Another approach is using position: sticky;.
Changing the style line to position:absolute makes it so that the selection boxes scroll up and out of the page when you scroll down, if that's what you were looking for.
library(shiny)
library(DT)
ui <- shinyUI(fluidPage(
titlePanel(fluidRow(
div(column(12, align="center",
selectInput("rmd1", "RMDw", choices = c(1,2)),
selectInput("rmd2", "RMD2", choices = c(1,2))
), style = "position:absolute; width:inherit;")
)),
br(),br(),br(),br(),br(),br(),br(),br(),br(),br(),br(),br(),br(),br(),br(),
dataTableOutput("uioutput", height = "2000px")
))
server <- function(input, output, session) {
output$uioutput <- renderDataTable({
datatable(iris)
})
}
shinyApp(ui, server)
If you're trying to make the table stay in place and scroll down through the table, use DTOutput() and renderDataTable() instead of dataTableOutput() and renderDataTable(). Then, get rid of datatable() inside renderDT() and just use 'iris'. Finally, you can add the Scroller extension and an options list with scrollY and scroller. Others may be able to explain the difference between DT and DataTable (this page might help as well: https://rstudio.github.io/DT/shiny.html), but I believe DTOutput and renderDT are more flexible. Note: you can add horizontal scrollbars as well with scrollX if you use a table with more fields in the future.
Updated code is below.
Hope either of these helps!
library(shiny)
library(DT)
ui <- shinyUI(fluidPage(
titlePanel(fluidRow(
div(column(12, align="center",
selectInput("rmd1", "RMDw", choices = c(1,2)),
selectInput("rmd2", "RMD2", choices = c(1,2))
), style = "position:absolute; width:inherit;")
)),
br(),br(),br(),br(),br(),br(),br(),br(),br(),br(),br(),br(),br(),br(),br(),
DTOutput("uioutput", height = "600px")
))
server <- function(input, output, session) {
output$uioutput <- renderDT({
iris
},
extensions = c('Scroller'),
fillContainer = T,
options = list(deferRender = T,
scrollY = 400,
scroller = T)
)
}
shinyApp(ui, server)

How to put entire image location in tags$img of shiny package?

The following code for tags$img is:
Working...when the image is stored in 'www' folder and src = "Rlogo.png"
Not working...when entire path of the image is given
I need to put the entire location in one of my shiny app where the app.R file will be run from command prompt. Please help thanks..
library(shiny)
ui <- fluidPage(
box(
tags$img(height = 100, width = 100,src = "Rlogo.png"),
tags$img(height = 100, width = 100,src = "E:/myApp/www/Rlogo.png")
)
)
server <- function(input, output, session) {
}
shinyApp(ui, server)
use imageOutput instead of tags$img:
library(shiny)
ui <- fluidPage(
box(
tags$img(height = 100, width = 100,src = "Rlogo.png"),
imageOutput('image')
)
)
server <- function(input, output, session) {
output$image <- renderImage({
list(src = "E:/myApp/www/Rlogo.png",
alt = "This is alternate text"
)
}, deleteFile = TRUE)
}
shinyApp(ui, server)

Fix width of a DT in shiny

I'm trying to fix the width of very wide table in shiny but haven't mange to do it. I try the answer here Shrink DT::dataTableOutput Size but it didn't work, I also tried the answer from here https://github.com/rstudio/DT/issues/29 with percentage and pixels for all the columns and it didn't work neither. This is an example of the table and problem I have:
shinyApp(
ui = fluidPage(
DT::dataTableOutput("table")
),
server <- function(input, output) {
x <- cbind(iris,iris,iris,iris)
output$table <- DT::renderDataTable(x)
}
)
I think this does what you want:
library(shiny)
shinyApp(
ui = fluidPage(
DT::dataTableOutput("table",width='500px')
),
server <- function(input, output) {
x <- cbind(iris,iris,iris,iris)
output$table <- DT::renderDataTable(x,options=list(scrollX=T))
}
)

Changing height of d3heatmapOutput() in R Shiny

I'm building a heatmap using R's d3heatmap library: https://cran.r-project.org/web/packages/d3heatmap/d3heatmap.pdf
I'd like to be able to allow a user to freely adjust (through the UI) the height = argument in the d3heatmapOutput() function.
Compare the following two code snippets (just copy/paste them directly into R Studio), where the only difference between them is the value of the height = argument in the d3heatmapOutput():
library(d3heatmap)
library(shiny)
ui <- fluidPage(
h1("A heatmap demo"),
selectInput("palette", "Palette", c("YlOrRd", "RdYlBu", "Greens", "Blues")),
checkboxInput("cluster", "Apply clustering"),
d3heatmapOutput("heatmap", height = "400px")
)
server <- function(input, output, session) {
output$heatmap <- renderD3heatmap({
d3heatmap(
scale(mtcars),
colors = input$palette,
dendrogram = if (input$cluster) "both" else "none"
) })
}
shinyApp(ui, server)
VS.
library(d3heatmap)
library(shiny)
ui <- fluidPage(
h1("A heatmap demo"),
selectInput("palette", "Palette", c("YlOrRd", "RdYlBu", "Greens", "Blues")),
checkboxInput("cluster", "Apply clustering"),
d3heatmapOutput("heatmap", height = "1000px")
)
server <- function(input, output, session) {
output$heatmap <- renderD3heatmap({
d3heatmap(
scale(mtcars),
colors = input$palette,
dendrogram = if (input$cluster) "both" else "none"
) })
}
shinyApp(ui, server)
I'd like to allow the user to choose this value of height = themselves. However, because "400px" is a non-numeric argument, UI tools such as numericInput() don't work. Likewise, selectInput() doesn't work either, e.g.:
selectInput("foo", "Bar:", c("400px", "700px", "1000px"))
where d3heatmapOutput("heatmap", height = "foo"). Unfortunately, neither of these options work, which makes me wonder if I may have overlooked a simpler, more elegant option.
In this example you can control the hight of the plot using a slider. The idea is to render the map on the server side and to use paste0 function to set desired size in pixels.
library(d3heatmap)
library(shiny)
ui <- fluidPage(
h1("A heatmap demo"),
sliderInput("pixels", "size", value = 400, min = 100, max = 1000),
selectInput("palette", "Palette", c("YlOrRd", "RdYlBu", "Greens", "Blues")),
checkboxInput("cluster", "Apply clustering"),
uiOutput("dynamic")
)
server <- function(input, output, session) {
output$heatmap <- renderD3heatmap({
d3heatmap(
scale(mtcars),
colors = input$palette,
dendrogram = if (input$cluster) "both" else "none"
) })
output$dynamic <- renderUI({
d3heatmapOutput("heatmap", height = paste0(input$pixels, "px"))
})
}
shinyApp(ui, server)

Shiny: plot results in popup window

I am trying to build a web app with shiny and I would like to display the resulting plot of a R function in a popup
window rather than in mainPanel.
For instance, for the below example (from http://shiny.rstudio.com/articles/action-buttons.html), clicking on "Go" button
would show the same plot but in a popup window.
I tried to add some javascript, but I have not succeeded yet... Can anyone help ?
Thank you in advance !
library(shiny)
ui <- fluidPage(
actionButton("go", "Go"),
numericInput("n", "n", 50),
plotOutput("plot")
)
server <- function(input, output) {
randomVals <- eventReactive(input$go, {
runif(input$n)
})
output$plot <- renderPlot({
hist(randomVals())
})
}
shinyApp(ui, server)
Look into shinyBS package which offers modal popups. Example below shows the plot upon button click.
EDIT - Added a download button to the Modal
rm(list = ls())
library(shiny)
library(shinyBS)
shinyApp(
ui =
fluidPage(
sidebarLayout(
sidebarPanel(numericInput("n", "n", 50),actionButton("go", "Go")),
mainPanel(
bsModal("modalExample", "Your plot", "go", size = "large",plotOutput("plot"),downloadButton('downloadPlot', 'Download'))
)
)
),
server =
function(input, output, session) {
randomVals <- eventReactive(input$go, {
runif(input$n)
})
plotInput <- function(){hist(randomVals())}
output$plot <- renderPlot({
hist(randomVals())
})
output$downloadPlot <- downloadHandler(
filename = "Shinyplot.png",
content = function(file) {
png(file)
plotInput()
dev.off()
})
}
)
Using native Shiny functionality
library(shiny)
ui <- fluidPage(
actionButton("go", "Go"),
numericInput("n", "n", 50)
)
server <- function(input, output) {
randomVals <- eventReactive(input$go, {
runif(input$n)
})
output$plot <- renderPlot({
hist(randomVals())
})
observeEvent(input$go, {
showModal(modalDialog(
plotOutput("plot"),
footer = NULL,
easyClose = TRUE
))
})
}
shinyApp(ui, server)
You could use a conditional panel to show/hide an absolute panel containing your plot, setting the condition to some js variable toggled by a function attached to your button .
e.g.
conditionalPanel("popupActive==1",
absolutePanel(id = "popup", class = "modal",
fixed = FALSE, draggable = TRUE,
top = 200, right = "auto", left = 400,
bottom = "auto",
width = 500, height = 500,
plotOutput(#output plot stuff#)
)
)
Then toggle the value of popupActive in js to show/hide
HTML('<head><script>popupActive = 0; function myFunction(){popupActive=!popupActive;} </script></head>'), HTML('<button id="go" type="button" class="btn btn-default action-button" onclick="myFunction()">Go</button>'),

Resources