Better way of scaling a dgr_graph within a shiny app - r

I'm building a shiny app that is supposed to show a bupaR process_map, which is kind of working.
Sadly the process_map()-function returns a dgr_graph-object, which can't be rendered with the DiagrammeR::renderGrViz() or DiagrammeR::renderDiagrammeR() functions. I found a way to convert it to a grViz / htmlwidget-object with render_graph(), but this way the graph is not nicely scaled. This is especially bad since I'm dealing with very long linear graphs.
Here is a MWE:
# server.R
library(DiagrammeR)
library(bupaR)
shinyServer(
function(input, output) {
plot <- patients %>%
process_map(rankdir = "TB",
render = FALSE)
output$diagram <- renderGrViz({
render_graph(plot)
})
}
)
# ui.R
library(DiagrammeR)
shinyUI(fluidPage(
titlePanel("DiagrammeR + shiny"),
grVizOutput(outputId = "diagram")
))
Is there a better way of displaying a dgr_graph-object in shiny, that fills out the whole width of the app and not just a post-stamp size in the middle? Ideal would be something adaptive, without the need for a fixed width in pixels.

As it turns out the problem is not the render_graph-function on the Server, but rather the default setting of the renderGrViz-function in the UI. When you set it to grVizOutput(outputId = "diagram", height = "100%") it works just fine.

Related

screenshotButton() does not render styleColorBar from formatStyle on Shiny

When I want to take a screenshot of a Shiny page using the shinyscreenshot library, the ColorBar style does not appear in the screen.
Minimum reproducible example:
library(shiny)
library(shinyscreenshot)
shinyApp(ui = fluidPage(datatable(iris['Sepal.Length']) %>% formatStyle(1, background = styleColorBar(iris['Sepal.Length'], 'blue')),
screenshotButton()
),
server = function(input, output, session) {})
Shiny application and screenshot
Thank you
If it can help others: use the capture package as suggested by Stéphane instead of shinyscreenshot, but if you want to capture a fluidRow it will not behave well, so it’s better to add a div around that fluidRow and capture the div.

Use `shinycssloaders::withSpinner` to cover more than one input

I am using shinycssloaders to show loading animation. There are multiple inputs on the page which are loaded from the server. These inputs are also dependent on each other.
In the below example I have used a reactive object to create such dependency. First the table is displayed and only when the calculation of table is completed (rv$a <- 1) plot can be completed.
library(shiny)
library(shinycssloaders)
ui <- fluidPage(
withSpinner(tableOutput('data')),
withSpinner(plotOutput('plot'))
)
server <- function(input, output) {
rv <- reactiveValues(a = NULL)
output$data <- renderTable({
#Some long calculation here, using Sys.sleep for simplicity
Sys.sleep(2)
rv$a <- 1
head(mtcars)
})
output$plot <- renderPlot({
req(rv$a)
#Some long calculation here, using Sys.sleep for simplicity
Sys.sleep(2)
plot(rnorm(100), rnorm(100))
})
}
shinyApp(ui, server)
This works fine but it shows 2 loaders, one for table and other one for plot. I want to combine these 2 loaders and show only 1 loading animation which covers the entire page combining table and plot. Also loading should end only after all the calculation is done i.e after plot calculation.
I have tried putting table and plot in a div and use spinner on div but it did not work and gave a blank page.
ui <- fluidPage(
withSpinner(div(
tableOutput('data'),
plotOutput('plot')
))
)
Does anybody have a solution to this? Is this possible using some different package?
You can use the tagList() function, which creates a list of the tags allowing the shinycssloaders package to wrap all the inputs within it in one go.
So the ui will look like the following:
ui <- fluidPage(
withSpinner(tagList(tableOutput('data'),
plotOutput('plot')))
)
Just some extra information for the animation. You can all change the style of the animation such as the the type, color, size , etc by adding these as arguments to the withSpinner(). Check the withSpinner() RDocumentation.

ggplot histogram fails inside shiny app

I am trying to plot a simple histogram inside a shiny app. Outside the app (in R script), the graph gets plotted without any problems, (see here) but the same code produces an odd looking graph from inside the app (see the wrong graph here)
Could you help me figure out what's wrong? Link to dataset: https://drive.google.com/open?id=1ITK0lTWm_mkb9KonHLq4nuKDv-PBUDeR
library(ggplot2)
library(ggthemes)
library(scales)
library(shiny)
# read data
cso_corruption <- read.csv("cso_corruption.csv", header = T, sep = ",")
ui <- fluidPage(
sidebarLayout(
sidebarPanel(
radioButtons(inputId = "x",label ="Measurement Type",choices =
c("freq_business", "freq_cso"), selected = NULL)
),
mainPanel(
plotOutput(outputId = "hist")
)
)
)
server <- function(input, output) {
output$hist <- renderPlot(ggplot(data = na.omit(cso_corruption), aes(x=input$x)) +
geom_histogram(fill="lightgreen", stat="count"))
}
shinyApp(ui = ui, server = server)
Possible reason is the data is not making it into the server.
I would put the csv into another file within the directory, so you can access it using
read.csv("./Data/projectdata.csv")
Therefore it does not get lost when you publish. Also make sure the data is checked when publishing. One last note to include the read.csv function in the server.
After many trial-and-errors, I have figured out a solution. The trick is, in the server, I used aes_string instead of aes. I haven't figured out why aes_string works here, since it is supposed to require the variables to be passed in quotes. But it works for some reason.

How to render scatter3d inside shiny page instead of popup

I'm looking at implementing 3D interactive plots in my shiny App, and so far I've been using plotly. However, plotly has one major disadvantage, it's extremely slow when rendering.
I've done checks, and the whole creation of updated outplot$plot <- renderPlotly ({.....}) and plotlyOutput("plot") takes less than 0.5 seconds, despite the large data set involved. This is a know issue for years but still seems to be current.
Hence, I'm looking to use a package called car, also because it has many options, some which I particularly want that are not available in other packages. Info on the car package is here: http://www.sthda.com/english/wiki/amazing-interactive-3d-scatter-plots-r-software-and-data-visualization
The problem is that it renders in a separate popup window rather than inside the shiny app, and I want to have it inside it, or even better, add a button that allow the user to have it as a popup, but only when asked. However, i can't figure out how to jam the bugger into the actual shiny page.
Here is my minimal example with a single text element and the graph code that (in my case) keeps appearing in a separate window rather than in the app.
install.packages(c("rgl", "car", "shiny"))
library("rgl")
library("car")
library(shiny)
cars$time <- cars$dist/cars$speed
ui <- fluidPage(
hr("how do we get the plot inside this app window rather than in a popup?"),
plotOutput("plot", width = 800, height = 600)
)
server <- (function(input, output) {
output$plot <- renderPlot({
scatter3d(x=cars$speed, y=cars$dist, z=cars$time, surface=FALSE, ellipsoid = TRUE)
})
})
shinyApp(ui = ui, server = server)
There is also this package, scatterplot3d but that's not interactive
http://www.sthda.com/english/wiki/scatterplot3d-3d-graphics-r-software-and-data-visualization
And there are some RGL packages but they have the same issue (seperate window) and don't offer the options I am lookign for.
You need to use an rglwidget which takes the last rgl plot and puts in in an htmlwidget. It used to be in a separate package, but it has recently been integrated into `rgl.
Here is the code to do this:
library(rgl)
library(car)
library(shiny)
cars$time <- cars$dist/cars$speed
ui <- fluidPage(
hr("how do we get the plot inside this app window rather than in a popup?"),
rglwidgetOutput("plot", width = 800, height = 600)
)
server <- (function(input, output) {
output$plot <- renderRglwidget({
rgl.open(useNULL=T)
scatter3d(x=cars$speed, y=cars$dist, z=cars$time, surface=FALSE, ellipsoid = TRUE)
rglwidget()
})
})
shinyApp(ui = ui, server = server)
Yielding this:

laggy Shiny uiOutput

One of my apps is displaying a ggplot via uiOutput('plot.ui') and plot.ui is rendered through renderUI().
output$plot.ui=renderUI({
plotOutput('plot', width=a function(), height=a function())
})
The code works, but it is very laggy. It seems that this is a two-step process. In my app, it first renders 'plot' (which is a ggplot rendered by renderPlot), then it resizes the plot according the specified width and height. The lag between the two steps is significant (about 3 seconds). I checked it by wrapping a withProgress() around plotOutput(), and the problem still exists. I am wondering why this problem exists and if there is any way to solve it.
A small example is attached to illustrate this problem.
library(shiny)
shinyApp(
ui=shinyUI(
pageWithSidebar(
titlePanel('test'),
sidebarPanel(
sliderInput('width','Width: ', min=0,max=1000,value=100),
sliderInput('height','Height: ', min=0,max=1000,value=100)
),
mainPanel(uiOutput('plot.ui'))
)
),
server=function(input,output){
output$plot.ui=renderUI({
plotOutput('plot',width=input$width,height=input$height)
})
output$plot=renderPlot({
plot(runif(100000,1,100),runif(100000,1,100))
})
}
)
Thank you very much for your help!
I had the similar issue, so if you had fixed the problem in another way, let me know. What I attempted to to was adjust the size of plotOutput depending on what I was plotting (with certain inputs, I had horizontal bar plot with 1 bar or 10 bars.. needed to adjust the height accordingly.
Solution 1) Adjust the height of renderplot()
As explained by jcheng5 here. See if this solves the issue
Solution 2) Define a plot function, use isolate()
# Define a function that returns a plot
plot_function <- function(){
plot(runif(100000,1,100),runif(100000,1,100)
}
# reactive UI and adjust the height here
output$plot.ui=renderUI({
plotOutput("plot", height = -------------)
})
# call plot_function but use isolate()
output$plot <- renderPlot({
isolate(plot_function())
}
This works for me. See if this solves the issue.

Resources