Changing CTRL+P of a web page using R shiny - r

I am currently looking for a method to change parameters of the print function of a normal web page. In fact, when you press CTRL+P, it opens a little window where you can print a file as PDF, and I am trying to change some informations on it. For example, the title of the first page and the name of the PDF file. If someone have an idea of how to do that in my R shiny code, let me know as soon as possible. Thank you :)

The dialog to print the webpage to a pdf file is a feature of the browser and can not be directly manipulated using shiny. Howeve, the browser uses HTML meta data from the head tag e.g. to print the title. You can add these tags to your shiny webpage:
library(shiny)
ui <- fluidPage(
tags$head(
# Define the title in both the browser tab name and pdf print header
tags$title("My fancy shiny title")
),
titlePanel("Hello Shiny!"),
sidebarLayout(
sidebarPanel(
sliderInput(
inputId = "bins",
label = "Number of bins:",
min = 1,
max = 50,
value = 30
)
),
mainPanel(
plotOutput(outputId = "distPlot")
)
)
)
server <- server <- function(input, output) {
output$distPlot <- renderPlot({
x <- faithful$waiting
bins <- seq(min(x), max(x), length.out = input$bins + 1)
hist(x,
breaks = bins, col = "#75AADB", border = "white",
xlab = "Waiting time to next eruption (in mins)",
main = "Histogram of waiting times"
)
})
}
shinyApp(ui, server)
You might also want to add shiny::tags$style tags e.g. to add #media rules to customize the print layout e.g. to remove the sidebar or buttons.

Related

ReferenceError: Can't find variable: Pickr when running shinytest::recordTest()

I am currently working on an RShiny App which became pretty big and hence I want to implement automated UI testing. I therefore tried to record my UI tests with recordTest() from the shinytest package. However, when I run shinytest::recordTest(), I get the error message "ReferenceError: Can't find variable: Pickr" (see attached image). I located the problem to be a colorPickr from the shinyWidgets package and it seems like it has something to do with a .js-File in the package, but I have no idea how to solve this problem.
Error Message
When running shinytest::recordTest(), I usually would expect that the app starts in a headless browser and I can record my tests. This works perfectly fine, when I disable the line of code where the colorPickr is defined. With the colorPickr, the above error occurs.
I tried to update my R version (unfortunately we are working with 3.6.0 currently) and updated all packages, which did not help. I also tried to install phantomJS and set my PATH variable to the phantomjs.exe. Did not help either (not sure if I did that correctly tbh).
The package versions I use are: shinytest_1.5.1, shinyWidgets_0.6.2, shiny_1.6.0
The error is reproducable with the following example app:
library(shiny)
library(shinyWidgets)
library(shinytest)
# Define UI for app that draws a histogram ----
ui <- fluidPage(
# App title ----
titlePanel("Hello Shiny!"),
# Sidebar layout with input and output definitions ----
sidebarLayout(
# Sidebar panel for inputs ----
sidebarPanel(
# Input: Slider for the number of bins ----
sliderInput(inputId = "bins",
label = "Number of bins:",
min = 1,
max = 50,
value = 30),
colorPickr(
inputId = "color",
label = "Pick a color",
selected = "blue" )
),
# Main panel for displaying outputs ----
mainPanel(
# Output: Histogram ----
plotOutput(outputId = "distPlot")
)
)
)
# Define server logic required to draw a histogram ----
server <- function(input, output) {
output$distPlot <- renderPlot({
x <- faithful$waiting
bins <- seq(min(x), max(x), length.out = input$bins + 1)
hist(x, breaks = bins, col = "#007bc2", border = "white",
xlab = "Waiting time to next eruption (in mins)",
main = "Histogram of waiting times")
})
}
shinyApp(ui, server)
To reproduce the error, run shinytest::recordTest().
Thanks in advance for any help!

Using withSpinner with an interactive uiOutput in R Shiny

I have recently written a Shiny app that takes user data input, does some analysis on it, and then displays the results, including graphs. These graphs take a while to render, so I am using withSpinner to inform the users that Shiny is busy and to be patient and wait for the graphs to appear. The graphs are displayed within boxes that have titles informing the users what the graphs show.
What gets displayed to the users depends on the data they provide to the app (how many items of data are provided in their input file) and also which options they choose from within the app (using checkboxes).
The withSpinner function works well for the graphs when wrapped around plotOutput and called from within ui (see line 38 of the example code below).
However, to use this approach for all graphs would require me to know how many items of data the users are likely to provide and then want to view. I would like to just automatically produce a graph, with a spinner, for each data item, without knowing how many there are in advance.
Placing withSpinner within the server doesn’t work at all (lines 58-65), which makes sense. However, if I use it in the ui around the uiOutput object for all of the boxes and graphs (line 29), the spinner only shows until the boxes are rendered – the graphs then appear about a minute later…
Please can you help me to work out how to get the spinners to show until the graphs are rendered? Thank you for any help you can give!
library(shiny)
library(shinydashboard)
library(shinyjs)
library(shinycssloaders)
library(survival)
ui <- dashboardPage(
skin = "blue",
dashboardHeader(title = "My App"),
dashboardSidebar(
sidebarMenu(
useShinyjs(),
id = "tabs",
menuItem("User Choice", tabName = "uChoice", icon = icon("sliders-h"))
)
),
dashboardBody(
id = "dashboardBody",
tabItems(
tabItem(
tabName = "uChoice",
h2("You have a choice"),
# Check boxes to select choice
fluidRow(
uiOutput("userChoiceCheckbox")
),
fluidRow(
# Only show the data graphs that the user has chosen to look at
withSpinner(uiOutput('chosenGraphs'), type=4)
# this spinner only shows until the box containing the graph is rendered
),
fluidRow(
# Always show lung graph
box(
title = paste("Here's the lung graph"),
width = 12,
height="50px",
withSpinner(plotOutput("lungGraph"), type=4)
# This spinner shows until the graph is plotted
)
)
)
)
)
)
server <- function(input, output, session) {
output$userChoiceCheckbox <- renderUI({
column(6, checkboxGroupInput(inputId = "choices", label = "Which graph(s) would you like to view?", choices = c("Lung", "PBC")))
})
output$chosenGraphs <- renderUI({
lapply(input$choices, function(x) {
box(
title = paste("Graph for", x,"cancer"),
width = 12,
renderPlot({
withSpinner(
# This spinner doesn't seem to work at all
plotOutput({
Sys.sleep(2)
plot(survfit(Surv(time, status) ~ 1, data = eval(as.symbol(tolower(x)))),
xlab = "Days",
ylab = "Overall survival probability")
})
)
})
)
})
})
output$lungGraph <- renderPlot(
plot(survfit(Surv(time, status) ~ 1, data = lung),
xlab = "Days",
ylab = "Overall survival probability")
)
}
shinyApp(ui, server)
In case you didn't find an answer, I couldn't add a single spinner per plot but the whole renderUI region can be wrapped by withSpinner() if you add it after the lapply().
In your case it would be something like this:
output$chosenGraphs <- renderUI({
lapply(input$choices, function(x) {
box(
title = paste("Graph for", x,"cancer"),
width = 12,
renderPlot({
plotOutput({
Sys.sleep(2)
plot(survfit(Surv(time, status) ~ 1, data = eval(as.symbol(tolower(x)))),
xlab = "Days",
ylab = "Overall survival probability")
})
})
)
}) %>% withSpinner()
})

Audio files not loading properly in Shiny App

I am trying to load an mp3 file held in the www folder in my shiny app. After having lots of issues with this, I have just reproduced the problem in a very simple shiny App (code below).
The audio file I am using, "brand.mp3" is a 19MB mp3 file
When I run this, it returns a 500 error. What is really weird is, if I close RStudio, and then restart, the first time I run the app, the file loads. Then if I reload, there is nothing at all. The first image shows first load of app:
And on the the reload I get this:
The Chrome console then gives an error: Failed to load resource: the server responded with a status of 500 (Internal Server Error)
Code for this is below.
Would be grateful for any ideas on this one. The only thing I can think of is if the app has some kind of memory issue. I have the same problem if I running RStudio in Windows or if I am running the app through a Docker Shiny Server Image found here
library(shiny)
ui <- fluidPage(
# App title ----
titlePanel("Test app"),
# Sidebar layout with input and output definitions ----
sidebarLayout(
# Sidebar panel for inputs ----
sidebarPanel(
# Input: Slider for the number of bins ----
sliderInput(inputId = "bins",
label = "Number of bins:",
min = 1,
max = 50,
value = 30),
tags$audio(src = "brand.mp3", type = "audio/mp3", autoplay = NA, controls = NA)
),
mainPanel(
plotOutput(outputId = "distPlot")
)
)
)
server <- function(input, output) {
output$distPlot <- renderPlot({
x <- faithful$waiting
bins <- seq(min(x), max(x), length.out = input$bins + 1)
hist(x, breaks = bins, col = "#75AADB", border = "white",
xlab = "Waiting time to next eruption (in mins)",
main = "Histogram of waiting times")
})
}
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

Shiny app with Plotly disconnects from server after rendering 2 Plotly graphs (used to work before R core and some packages update)

I'm preparing the test application with open NY data
https://tabulinas.shinyapps.io/nyaccidents/
It has tab plotlyOutput, that render one from 8 plots.
This works perfectly on my laptop, and used to work on shinyapps server till previous week. Now app shows two plotly plots (no matter what exact plots) and when i choose the third plot it disconnects from server.
I check - if i remove plotly plots, everything works fine.
And if i choose in third times plot that i have already rendered firstly, it crashes anyway (so there is not the reason, that all plotly objects are stored in memory)
It seems that it exceed some limit, some new limit, that wasn't active before.
Or maybe there is any issue with updated versions of R core, server and packages.
Please share any idea how i can make my application works again on server!
Here is part of code, where can be an issue
#Server part:
# Button "Back"
observeEvent(input$Back, {
current <- as.numeric(input$select)
if (current > 1){
updateSelectInput(session, "select",
selected = current-1)
}
})
#button "Next"
observeEvent(input$Next, {
current <- as.numeric(input$select)
if (current < 9){
updateSelectInput(session, "select",
selected = current+1)
}
})
output$selector <- renderUI({
selectInput("select", label = h3("Select plot"),
choices = list("Plot1" = 1, "Plot2" = 2,
"Plot3" = 3, "Plot4"=4,
"Plot5"=5, "Plot6"=6, "Plot7"=7,
"Plot8"=8), selected = 1)
})
output$distPlot <- renderPlotly({
if (as.numeric(input$select)==1){
resplot <- # here code of plotly plot}
# the same for other plots
resplot
})
# UI part
tabPanel(
title= div(img(src="summary.jpg",height = 30)),
fluidPage(
fluidRow(
column(4,
uiOutput("selector"), # Selectize input with plots
actionButton("Back", label = "Back"),
actionButton("Next", label = "Next")
),
column( 8,
htmlOutput("plot_comment") # Plot comment is a text output depending on plot choosen
)),
hr(),
hr(),
plotOutput("distPlot", width = "100%", height ="100%")
)
)
It looks like this

Resources