Hi Community!
I'm building my first Shiny app, and I'm having some trouble. I need to display data for a music experiment on the top of the body page, and I need to separately render the image of the music it corresponds to below it. I need the output for both to dynamically resize to the window, and I'm letting users manipulate the window size with a slider. The plot(s) on top are being rendered with plotly, and the music on the bottom is natively .svg format.
Here's my problem. When I run the program locally, things are typically fine, but when I run it in the browser, but especially when I run it from shinyapps, the music image flashes or disappears on slider adjustment or window resize. In fact, when no music is displayed and you adjust the slider, it will appear for a brief moment before resizing. If you click back and forth between "Single emotion explorer" and "Multiple emotion explorer" the music shows up again. I don't typically have a problem with Chrome, but the local "run in window" and Safari are really unpredictable.
I've tried converting it to jpeg, and that always works, but because the entire piece of music is there it really bogs the process down and there's some odd conversion happening with the music fonts that don't render properly. I'm a novice, so my code is probably a bit messy and inefficient. You can also go to the shinyapps page and play with it live here:
https://cbmajor7.shinyapps.io/Pathetique/
Thanks!
-Josh
library(shiny)
library(shinydashboard)
library(shinyjs)
library(plotly)
library(magick)
library(dplyr)
library(htmltools)
library(pipeR)
library(svglite)
library(rsvg)
all.data <- read.table('www/all.data')
all.means <- read.table('www/all.means')
# Set consistent colors
cols <- c('#1f77b4', '#ff7f0e', '#2ca02c', '#d62728', '#9467bd', '#8c564b',
'#e377c2', '#7f7f7f', '#bcbd22', '#17becf', 'black')
cols <- setNames(cols, c("Calm/Serene", "Carefree", "Contentment", "Dark",
"Happy/Joyful", "Lonely", "Sad/Depressed/Tragic",
"Striving/Yearning", "Suspense/Anticipation",
"Unsettled/Anxious", "Weighty"))
all.means$color <- factor(all.means$V4, labels = cols)
all.data$color <- factor(all.data$V4, labels = cols)
ui <- dashboardPage(
dashboardHeader(title = "Emotion data explorer"),
dashboardSidebar(
sidebarMenu(id = "tabs",
menuItem("Dashboard", tabName = "dashboard", icon = icon("dashboard")),
menuItem("Single emotion explorer", tabName = "single", icon = icon("cube"), selected = F),
conditionalPanel("input.tabs === 'single'",
radioButtons(inputId = "radioemotion", "Select emotions to display",
c("Calm/Serene", "Carefree", "Contentment", "Dark",
"Happy/Joyful", "Lonely", "Sad/Depressed/Tragic",
"Striving/Yearning", "Suspense/Anticipation",
"Unsettled/Anxious", "Weighty"), inline =F, selected = "Calm/Serene", width = "100%")
),
menuItem("Multiple emotions explorer", tabName = "multiple", icon = icon("cubes"), selected= F, startExpanded = F),
conditionalPanel("input.tabs === 'multiple'",
checkboxGroupInput(inputId = "checkemotions", "Select emotions to display",
c("Calm/Serene", "Carefree", "Contentment", "Dark",
"Happy/Joyful", "Lonely", "Sad/Depressed/Tragic",
"Striving/Yearning", "Suspense/Anticipation",
"Unsettled/Anxious", "Weighty"), inline =F, selected = "Calm/Serene", width = "100%")
),
sliderInput("selection", "Select excerpt (seconds)",
min = 0, max = 277.5,
value = c(0,20), step = 2.5,
post = '"', sep = ",",
animate = F)
)
),
dashboardBody(
tags$style(type = "text/css", "#plotsingle {height: calc(80vh - 300px) !important;}"),
tags$style(type = "text/css", "#plotmulti {height: calc(80vh - 300px) !important;}"),
tabItems(
tabItem(tabName = "single",
fluidRow(plotlyOutput("plotsingle"),
plotOutput("widthdetector", height=1), width=12),
fluidRow(imageOutput("picture"), width =12)
),
tabItem(tabName = "multiple",
fluidRow(plotlyOutput("plotmulti"),
plotOutput("widthdetector2", height=1), width=12),
fluidRow(imageOutput("picture2"), width =12)
)
)
)
)
server <- function(input, output, session) {
sliderData1 <- reactive({
input$selection[1]
})
sliderData2 <- reactive({
input$selection[2]
})
emos <- reactive({
filter(all.means[all.means$V4 %in% input$checkemotions,])
})
emos1 <- reactive({
filter(all.means[all.means$V4 %in% input$radioemotion,])
})
emos2 <- reactive({
filter(all.data[all.data$V4 %in% input$radioemotion,])
})
widthdetector2 <- reactive({
session$clientData$output_picture_width
})
widthdetector <- reactive({
session$clientData$output_picture_width
})
output$width_detector2 <- renderPlot(boxplot(x=0, plot=F, silent=T), height = 1 )
output$width_detector <- renderPlot(boxplot(x=0, plot=F, silent=T), height = 1 )
output$picture <- renderImage({
if(input$selection[2] - input$selection[1] >= 20){
picture1 <- image_read_svg('www/op13-02.svg')
image_info(picture1) -> ch
modified1 <- image_background(
image_scale(
image_crop(picture1, geometry_area((ch$width*(sliderData2() - sliderData1())/277.5), ch$height, (ch$width*(sliderData1())/277.5), 0)),
geometry_size_pixels(width = session$clientData$output_widthdetector_width, height = NULL, preserve_aspect = TRUE)), color = "white")
tmpfile1 <- image_write(modified1, format = 'svg', tempfile(fileext='.svg'))
list(src = tmpfile1, contentType = "image/svg+xml")
} else {
system('verovio/verovio --breaks "none" --adjust-page-height --spacing-non-linear 1 --spacing-linear .05 -s 50 www/temp.krn')
picture2 <- image_read_svg('www/temp.svg')
modified2 <- image_background(
image_scale(picture2, geometry_size_pixels(width = session$clientData$output_widthdetector_width, height = NULL, preserve_aspect = TRUE)), color = "white")
tmpfile2 <- image_write(modified2, format = 'svg', tempfile(fileext='.svg'))
list(src = tmpfile2, contentType = "image/svg+xml")
}
})
output$picture2 <- renderImage({
if(input$selection[2] - input$selection[1] >= 20){
picture3 <- image_read_svg('www/op13-02.svg')
print("stage1")
image_info(picture3) -> ch
modified3 <- image_background(
image_scale(
image_crop(picture3, geometry_area((ch$width*(sliderData2() - sliderData1())/277.5), ch$height, (ch$width*(sliderData1())/277.5), 0)),
geometry_size_pixels(width = session$clientData$output_widthdetector2_width, height = NULL, preserve_aspect = TRUE)), color = "white")
tmpfile3 <- image_write(modified3, format = 'svg', tempfile(fileext='.svg'))
list(src = tmpfile3, contentType = "image/svg+xml")
} else {
system('verovio/verovio --breaks "none" --adjust-page-height --spacing-non-linear 1 --spacing-linear .05 -s 50 www/temp.krn')
picture4 <- image_read_svg('www/temp.svg')
modified4 <- image_background(
image_scale(picture4, geometry_size_pixels(width = session$clientData$output_widthdetector2_width, height = NULL, preserve_aspect = TRUE)), color = "white")
tmpfile4 <- image_write(modified4, format = 'svg', tempfile(fileext='.svg'))
list(src = tmpfile4, contentType = "image/svg+xml")
}
})
output$plotsingle <- renderPlotly({
emos1 <- emos1()
emos2 <- emos2()
plot_ly(x = ~emos2[which(emos2()$V1 >= input$selection[1] & emos2()$V1 <= input$selection[2]),]$V1,
y = ~emos2[which(emos2()$V1 >= input$selection[1] & emos2()$V1 <= input$selection[2]),]$V3,
visible = T,
type = "box",
name = "Boxplot by segment", hoverinfo = "none"
) %>%
layout(dragmode= "zoom",
legend = list(orientation = "h"),
xaxis = list(title = "", fixedrange = T, showspikes = F),
yaxis = list(title = "Standard deviations from the mean", fixedrange = T, showspikes = F)) %>%
config(displayModeBar = F) %>%
add_trace(
x = ~emos1[which(emos1()$V1 >= input$selection[1] & emos1()$V1 <= input$selection[2]),]$V1,
y = ~emos1[which(emos1()$V1 >= input$selection[1] & emos1()$V1 <= input$selection[2]),]$V3,
visible = T, name = input$radioemotion, type="scatter", mode= "lines",
colors = cols,
hoverinfo = "y") %>%
layout(hovermode = "x"
)
})
output$plotmulti <- renderPlotly({
emos <- emos()
req(input$checkemotions)
p <- plot_ly(
x = emos[which(emos$V1 >= sliderData1() & emos$V1 <= sliderData2()),]$V1,
y = ~emos[which(emos$V1 >= sliderData1() & emos$V1 <= sliderData2()),]$V3,
hoverinfo = "x+y"
)
subplot(add_lines(p, color = ~emos[which(emos$V1 >= sliderData1() & emos$V1 <= sliderData2()),]$V4,
colors = cols),
shareX = TRUE
) %>%
config(displayModeBar = F) %>%
layout(dragmode= "zoom", hovermode = "x",
images = list(
list(source = 'www/this.svg',
xref = "x",
yref = "y",
sizex = 2,
sizey = 2,
sizing = "stretch",
opacity= .4,
layer = "below")
),
legend = list(orientation = "h"),
xaxis = list(fixedrange = T, showspikes = F),
yaxis = list(title = "Standard deviations from the mean", fixedrange = T, showspikes = F))
})
}
shinyApp(ui = ui, server = server)