Skip to content

Instantly share code, notes, and snippets.

@timelyportfolio
Last active February 20, 2021 12:48
Show Gist options
  • Star 4 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save timelyportfolio/a33ede926338fcd832fdaba50d1cdf8f to your computer and use it in GitHub Desktop.
Save timelyportfolio/a33ede926338fcd832fdaba50d1cdf8f to your computer and use it in GitHub Desktop.
svg as reactiveValue in Shiny used with uiOutput

Just playing around with svg from svglite, and I wondered if the svg output would work as reactiveValue in Shiny. Of course, it does. Then, I wanted to confirm that functions could be used for render*Output, and yes they can.

useful?

Is this useful? svg works really well in responsive contexts, so this might be helpful in that situation. Also, we could dynamically render svg spinners or animations on load or for other feedback. Let me know if you think of use cases.

functions for render*Output can help immensely.

library(htmltools)
library(svglite)

ui <- fluidPage(
  fluidRow(
    column(6, uiOutput("plot1", style="height:50vh;")),
    column(6, uiOutput("plot2", style="height:50vh;")),
  ),
  fluidRow(
    column(6, uiOutput("plot3", style="height:50vh;")),
    column(6, uiOutput("plot4", style="height:50vh;"))
  )
)

server <- function(input, output, session) {
  rv <- reactiveValues()
  observe({
    invalidateLater(1000, session)
    s <- svgstring(standalone=FALSE)
    plot(runif(20), bty="L", pch=19)
    dev.off()
    rv$svg <- gsub( # yes I know there are better ways to do this
      x = gsub(x=s(), pattern="width='720.00pt'", replacement="width='100%'"),
      pattern = "height='576.00pt",
      replacement = "height='100%'"
    )
  })
  
  lapply(
    1:4,
    function(x) {
      output[[paste0("plot",x)]] <- renderUI({ HTML(rv$svg) })
    }
  )
}
shinyApp(ui, server)

Tweeted here as @timelyportfolio

library(shiny)
library(htmltools)
library(svglite)
ui <- fluidPage(
fluidRow(
column(6, uiOutput("plot1", style="height:50vh;")),
column(6, uiOutput("plot2", style="height:50vh;")),
),
fluidRow(
column(6, uiOutput("plot3", style="height:50vh;")),
column(6, uiOutput("plot4", style="height:50vh;"))
)
)
server <- function(input, output, session) {
rv <- reactiveValues()
observe({
invalidateLater(1000, session)
s <- svgstring(standalone=FALSE)
plot(runif(20), bty="L", pch=19)
dev.off()
rv$svg <- gsub( # yes I know there are better ways to do this
x = gsub(x=s(), pattern="width='720.00pt'", replacement="width='100%'"),
pattern = "height='576.00pt",
replacement = "height='100%'"
)
})
lapply(
1:4,
function(x) {
output[[paste0("plot",x)]] <- renderUI({ HTML(rv$svg) })
}
)
}
shinyApp(ui, server)
@timelyportfolio
Copy link
Author

reactive_svg

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment