Get the size of the window in Shiny - r

I Would like to determine the size of the browser window in Shiny to help me layout my plot divs better. Specifically I would like to determine the aspect ratio of the window to see how many divs I should spread across the screen and it still look nice. My initial thought would be that the number of plots would be floor(width/(height-navbar_height)).
I did some looking for this and I am currently unable to locate a possible solution and am currently lead to believe that this feature is simply not present in the clientData structure. Any thoughts?

See the example below. It uses Javascript to detect the browser window size (initial size and any resize), and use Shiny.onInputChange to send the data to the server code for processing. It uses shiny:connected event to get the initial window size, as Shiny.onInputChange is not ready for use until shiny is connected.
library(shiny)
# Define UI for application that draws a histogram
ui <- shinyUI(fluidPage(
# Application title
titlePanel("Old Faithful Geyser Data"),
# Sidebar with a slider input for number of bins
sidebarLayout(
sidebarPanel(
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);
});
')),
sliderInput("bins",
"Number of bins:",
min = 1,
max = 50,
value = 30)
),
# Show a plot of the generated distribution
mainPanel(
verbatimTextOutput("dimension_display"),
plotOutput("distPlot")
)
)
))
# Define server logic required to draw a histogram
server <- shinyServer(function(input, output) {
output$dimension_display <- renderText({
paste(input$dimension[1], input$dimension[2], input$dimension[2]/input$dimension[1])
})
output$distPlot <- renderPlot({
# generate bins based on input$bins from ui.R
x <- faithful[, 2]
bins <- seq(min(x), max(x), length.out = input$bins + 1)
# draw the histogram with the specified number of bins
hist(x, breaks = bins, col = 'darkgray', border = 'white')
})
})
# Run the application
shinyApp(ui = ui, server = server)

There is a new and much simpler way to do this since 2021: using the {shinybrowser} package. Example:
library(shiny)
ui <- fluidPage(
shinybrowser::detect(),
"Window size:",
textOutput("size")
)
server <- function(input, output, session) {
output$size <- renderText({
paste(
shinybrowser::get_width(),
"x",
shinybrowser::get_height()
)
})
}
shinyApp(ui, server)
Note that {shinybrowser} is currently on GitHub only and not yet on CRAN (should be in the near future). Note also that {shinybrowser} only gives you the initial dimensions, but will not update if the browser is resized.

Shorter version for getting window dimensions in shiny with JS from package htmlwidgets:
window_height <- JS('window.innerHeight')
window_width <- JS('window.innerWidth')

Related

How can I trigger an output when a value changes in a different output?

I have an output that takes user input to select which of a number of calculations to use and results in 5 numbers. That output pushes out the results of this and other calculations as an HTML table. The individual calculations are not particularly complicated, but user selections choose which of many approaches they are using, so I don't really want to replicate all that code in other outputs that are going to use just those 5 numbers.
My thought was to use the double-arrow to make those numbers available to the other outputs (in my case some plots). My goal is to generate graphs from numbers already generated in a different output, however that gets accomplished. I am not attached to the approach below, it is just where I am right now.
I ran into a number of problems just using <<- and tried a lot of things to get it to work. I won't complicate this further with all the things I tried and the problems they created.
The MRE below replicates this by calculating a number in one output that is then to be used in another output. If you enter different numbers of bins, the second output is never triggered to update to the new number. For this MRE I could of course directly use the user input to calculate that number but that is what I am trying to avoid in the real app. I also don't want to use a "Go!" button if I can avoid it since part of the fun is watching how things change in response to your various selections.
# Define UI for application that draws a histogram
ui <- fluidPage(
# Application title
titlePanel("Old Faithful Geyser Data"),
# Sidebar with a slider input for number of bins
sidebarLayout(
sidebarPanel(
numericInput("bins",
"Number of bins:",
min = 1,
max = 50,
value = 30)
),
# Show a plot of the generated distribution
mainPanel(
plotOutput("distPlot"),
textOutput("binnum")
)
)
)
# Define server logic required to draw a histogram
server <- function(input, output) {
a_number<-0
output$distPlot <- renderPlot({
# generate bins based on input$bins from ui.R
x <- faithful[, 2]
bins <- seq(min(x), max(x), length.out = input$bins + 1)
a_number<<-bins[2]/5}
# draw the histogram with the specified number of bins
hist(x, breaks = bins, col = 'darkgray', border = 'white')
})
output$binnum<-renderText({
a_number
})
}
# Run the application
shinyApp(ui = ui, server = server)
Could you just treat bins and a_number as reactive?
# Define UI for application that draws a histogram
ui <- fluidPage(
# Application title
titlePanel("Old Faithful Geyser Data"),
# Sidebar with a slider input for number of bins
sidebarLayout(
sidebarPanel(
numericInput("bins",
"Number of bins:",
min = 1,
max = 50,
value = 30)
),
# Show a plot of the generated distribution
mainPanel(
plotOutput("distPlot"),
textOutput("binnum")
)
)
)
# Define server logic required to draw a histogram
server <- function(input, output) {
# a_number<-0
# generate bins based on input$bins from ui.R
data(faithful)
x <- faithful[, 2]
bins <- reactive({
seq(min(x), max(x), length.out = input$bins + 1)
})
a_number <- reactive({
req(bins())
-bins()[2]/5
})
output$distPlot <- renderPlot({
# draw the histogram with the specified number of bins
hist(x, breaks = bins(), col = 'darkgray', border = 'white', xlab = paste0("a = ", -bins()[2]/5))
})
output$binnum<-renderText({
a_number()
})
}
# Run the application
shinyApp(ui = ui, server = server)

How can I display the code of a specific R file in an R Shiny app?

So I have a shiny app. I want to create a new tab. And within that new tab I want to display the code in a specific R file that is located in a folder within the package.
Basic requirements is to display the R file as if it is a text file verbatim.
Enhance features would have it display text and color rendering as if reading it from RStudio or something.
You can do it by rendering the file contents as HTML inside <pre><code> tags...
Say your file is in www/random_fn.R:
library(shiny)
# Define UI for application that draws a histogram
ui <- fluidPage(
mainPanel(
tabsetPanel(
tabPanel("Home", sliderInput(inputId = "bins",label = "Bins", min = 0, max = 10, value = 3),
plotOutput("distPlot")),
tabPanel("R Code", uiOutput("show_code")
))
)
)
# Define server logic required to draw a histogram
server <- function(input, output, session) {
output$distPlot <- renderPlot({
# generate bins based on input$bins from ui.R
x <- faithful[, 2]
bins <- seq(min(x), max(x), length.out = input$bins + 1)
# draw the histogram with the specified number of bins
hist(x, breaks = bins, col = 'darkgray', border = 'white')
})
output$show_code <- renderUI({
raw_lines <- readLines("www/random_fn.R")
# insert line breaks for HTML
code_joined <- stringi::stri_join(raw_lines, collapse = "\n")
tagList(
tags$pre(
tags$code(
HTML(code_joined)
)
)
)
})
}
# Run the application
shinyApp(ui = ui, server = server)
Also you can use package shinyAce

multiple users changing reactive values in R shiny

Is it possible for multiple users of the same app to make changes to the same set of reactive values?
This question (handling multiple users simulaneously in an R Shiny app) suggests that multiple users in different sessions can make changes to the same value (by declaring it outside of server() and using <<- instead of <- ) But that is for just plain old values/variables. Is this possible for reactive values?
Ideally, I would like a change made by user A to be immediately reflected in some output viewed by user B.
Here's a minimal working example based on RStudio's default one-file Shiny app:
library(shiny)
slidervalue <- 30
# Define UI for application that draws a histogram
ui <- fluidPage(
# Application title
titlePanel("Old Faithful Geyser Data"),
# Sidebar with a slider input for number of bins
sidebarLayout(
sidebarPanel(
sliderInput("bins",
"Number of bins:",
min = 1,
max = 50,
value = slidervalue)
),
# Show a plot of the generated distribution
mainPanel(
plotOutput("distPlot"),
textOutput('txt')
)
)
)
# Define server logic required to draw a histogram
server <- function(input, output, session) {
observe({
slidervalue <<- input$bins
})
reactive_slidervalue <- reactivePoll(100, session,
checkFunc = function() { slidervalue },
valueFunc = function() { slidervalue }
)
output$txt <- renderText(reactive_slidervalue())
observe({
updateSliderInput(session, 'bins', value = reactive_slidervalue())
})
output$distPlot <- renderPlot({
# generate bins based on input$bins from ui.R
x <- faithful[, 2]
bins <- seq(min(x), max(x), length.out = reactive_slidervalue() + 1)
# draw the histogram with the specified number of bins
hist(x, breaks = bins, col = 'darkgray', border = 'white')
})
}
# Run the application
shinyApp(ui = ui, server = server)
Basically, I am using a global variable (as you and and the post suggested), and then hooked it back into server by using the reactivePoll function to make the external dependency reactive.

observeEvent is triggered unnecessary when using one evenExpr for mulitple handlerExpr in Shiny

Im creating shiny app. for calculating risk score where the user will upload input file and select the input such as ethnic groups, type of calculating score and diseases. After all of the input are selected and file is uploaded, my App. will be run when user click at action button and the output such as graph and dataframe will be shown
Im using observeEvent to control my App for triggering unnecessarily( mulitple handleExpr with one eventExpr), and this is my shorten version of code. Im sorry for my code that is not reproducible.
observeEvent(input$action,{
isolate(system2("bash_script/plink.sh",args = c(input$file$datapath,input$type,input$sum_stat,input$Disease,input$Ethnic,input$Ref)))
output$table_score <- renderDataTable({
percentile <- read.csv("../output/score_percentile.csv",header = T, sep = "\t")
}, selection = "single")
output$table_variant <- renderDataTable({
varaints_in_sample <- fread("../output/summary.csv", header = T, drop = 1)
})
#Plot Graph
output$plot <- renderPlot({
s <- input$table_score_cell_clicked
plot("../output/score_percentile_plot.csv",s,"analysis")
})
})
my problem is that when Im running app for the first time, everything is controllable. However, if I want to select new input. for example im changing input disease from heart disease to another disease. my App. will be triggered unnecessarily although I did NOT click at action button.
So, Is there any way to use observeEvent with one evenExpr for mulitple handleExpr
Thanks everyone for your help!
I think, this is simplified example of your problem. The solution is to put all your input$... inside isolate().
library(shiny)
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
sliderInput("bins",
"Number of bins:",
min = 1,
max = 50,
value = 30),
actionButton('action', 'Click')
),
mainPanel(
plotOutput("distPlot")
)
)
)
server <- function(input, output) {
output$distPlot <- renderPlot({
req(input$action)
# generate bins based on input$bins from ui.R
x <- faithful[, 2]
bins <- seq(min(x), max(x), length.out = isolate(input$bins) + 1)
# draw the histogram with the specified number of bins
hist(x, breaks = bins, col = 'darkgray', border = 'white')
})
}
shinyApp(ui = ui, server = server)

404 not found when saving base R plot in Shiny

I'm making a Shiny app that involves making plots from a function from a bioinformatics package that uses base R graphics. I'm building the Shiny app in RStudio Server. Since the plot can only be made with that function in that package, using ggplot2 or highcharter instead is not an option. I have no problem with saving plots made by ggplot2, but got into trouble when trying to save plots made with base R graphics. I used the answer in Downloadhander (save plot) for basic plot in shiny, but when I clicked the download button, I got "404 not found" and download was not initiated, even though that plot displayed properly within the Shiny app. Here's a modified version of RStudio's default Faithful Geyser app that can reproduce this problem:
library(shiny)
# Define UI for application that draws a histogram
ui <- fluidPage(
# Application title
titlePanel("Old Faithful Geyser Data"),
# Sidebar with a slider input for number of bins
sidebarLayout(
sidebarPanel(
sliderInput("bins",
"Number of bins:",
min = 1,
max = 50,
value = 30),
downloadButton("download", "Download plot")
),
# Show a plot of the generated distribution
mainPanel(
plotOutput("distPlot")
)
)
)
# Define server logic required to draw a histogram
server <- function(input, output) {
p <- reactive({
# generate bins based on input$bins from ui.R
x <- faithful[, 2]
bins <- seq(min(x), max(x), length.out = input$bins + 1)
# draw the histogram with the specified number of bins
hist(x, breaks = bins, col = 'darkgray', border = 'white')
})
output$distPlot <- renderPlot(p())
output$download <- downloadHandler("foo.png",
content = function(file) {
png(file = file)
p()
dev.off()
})
}
# Run the application
shinyApp(ui = ui, server = server)
It seems that the problem is related to
png(file = file)
p()
dev.off()
not working within Shiny, since when I tried to save ggplot this way, it also gave "404 not found", while ggsave worked fine to download ggplot (though not base R plots) inside the Shiny app. Outside Shiny, the base R way to save plots works properly.
Changing p() from a reactive to a standard function solved the issue for me.
library(shiny)
# Define UI for application that draws a histogram
ui <- fluidPage(
# Application title
titlePanel("Old Faithful Geyser Data"),
# Sidebar with a slider input for number of bins
sidebarLayout(
sidebarPanel(
sliderInput("bins",
"Number of bins:",
min = 1,
max = 50,
value = 30),
downloadButton("download", "Download plot")
),
# Show a plot of the generated distribution
mainPanel(
plotOutput("distPlot")
)
)
)
# Define server logic required to draw a histogram
server <- function(input, output) {
p <- function() {
# generate bins based on input$bins from ui.R
x <- faithful[, 2]
bins <- seq(min(x), max(x), length.out = input$bins + 1)
# draw the histogram with the specified number of bins
hist(x, breaks = bins, col = 'darkgray', border = 'white')
}
output$distPlot <- renderPlot(p())
output$download <- downloadHandler(filename = "foo.png",
content = function(file) {
png(filename = file)
p()
dev.off()
},
contentType = "image/png")
}
# Run the application
shinyApp(ui = ui, server = server)

Resources