1

I'm working on a shiny app that requires a lot of interaction with plots. Its quite complex, therefore I'll provide minimal examples that try to abstract the problem and reduce the code you have to copy and paste to a minimum.

One problem that I faced regarding computational efficiency when the plot changes has been solved here.

With this solution however I'm running into a different problem. Before incorporating the solution the app looked like this.

library(shiny)

ui <- fluidPage(

  wellPanel(
    fluidRow(
      column(
        width = 12,
        fluidRow(
          sliderInput(inputId = "slider_input", label = "Reactive values (Number of red points):", min = 1, max = 100, value = 10),
          plotOutput(outputId = "plotx")
        ),
        fluidRow(
          selectInput(
            inputId = "color_input",
            label = "Choose color:",
            choices = c("red", "blue", "green")
          ),
          sliderInput(
            inputId = "size_input",
            min = 1,
            max = 5,
            step = 0.25,
            value = 1.5,
            label = "Choose size:"
          )
        )
      )
    )
  )

)

slow_server <- function(input, output, session){

  base_data <- reactiveVal(value = data.frame(x = rnorm(n = 200000), y = rnorm(n = 200000)))

  output$plotx <- renderPlot({

    # slow non reactive layer
    plot(x = base_data()$x, y = base_data()$y)

    # reactive layer
    points(
      x = sample(x = -4:4, size = input$slider_input, replace = T),
      y = sample(x = -4:4, size = input$slider_input, replace = T),
      col = input$color_input,
      cex = input$size_input,
      pch = 19
    )

  })

}

shinyApp(ui = ui, server = slow_server)

It differs from the example given in the solved question in so far as that it now features a well panel and some additional inputs below the plot. I had not mentioned this before because I thought it was not important to the problem.

Incorporating the solution the app now looks like this:

library(shiny)
library(ggplot2)
ui <- fluidPage(

  wellPanel(
    fluidRow(
    column(
      width = 12,
      fluidRow(
        sliderInput(inputId = "slider_input", label = "Reactive values (Number of red points):", min = 1, max = 100, value = 10),
        div(
          class = "large-plot",
          plotOutput(outputId = "plot_bg"),
          plotOutput(outputId = "plotx")
        ),
        tags$style(
          "
        .large-plot {
            position: relative;
        }
        #plot_bg {
            position: absolute;
        }
        #plotx {
            position: absolute;
        }
        "
        )
      ),
      fluidRow(
        selectInput(
          inputId = "color_input",
          label = "Choose color:",
          choices = c("red", "blue", "green")
        ),
        sliderInput(
          inputId = "size_input",
          min = 1,
          max = 5,
          step = 0.25,
          value = 1.5,
          label = "Choose size:"
        )
      )
     )
    )
  )

)

quick_server <- function(input, output, session){

  base_data <- reactiveVal(value = data.frame(x = rnorm(n = 200000), y = rnorm(n = 200000)))

  output$plot_bg <- renderPlot({
    ggplot(base_data()) +
      geom_point(aes(x,y)) +
      scale_x_continuous(breaks = -4:4) +
      scale_y_continuous(breaks = -4:4) +
      xlim(-5, 5) +
      ylim(-5, 5)
  })
  output$plotx <- renderPlot({
    data.frame(
      x = sample(x = -4:4, size = input$slider_input, replace = T),
      y = sample(x = -4:4, size = input$slider_input, replace = T)
    ) %>%
      ggplot() +
      geom_point(mapping = aes(x,y), color = input$color_input, size = input$size_input) +
      scale_x_continuous(breaks = -4:4) +
      scale_y_continuous(breaks = -4:4) +
      theme(
        panel.background = element_rect(fill = "transparent"),
        plot.background = element_rect(fill = "transparent", color = NA),
        panel.grid.major = element_blank(),
        panel.grid.minor = element_blank(),
        legend.background = element_rect(fill = "transparent"),
        legend.box.background = element_rect(fill = "transparent")
      )+
      xlim(-5, 5) +
      ylim(-5, 5)
  }, bg="transparent")

}

shinyApp(ui = ui, server = quick_server)

The plot has become way quicker. But now the plot inputs are placed on top of it. I assume it is due to the relative positioning in the new CSS class 'large-plot'. I have been fiddling around with shiny::tags$style() and shiny::verticalLayout() but my knowledge of CSS only allows my to understand CSS code not reakky to change it and I'm not making any progress.

How can I keep the relative positioning of the two overlapping plots (like in example 2) and place the additional inputs in the row below the plot (as in example 1)?

Any help is appreciated. If you need more information about the app please tell me and I'll provide it!

Thanks in advance!!

kuecki95
  • 55
  • 5

1 Answers1

0

so just add some height to the large-plot class. I didn't know you wanted to add content below. So the absolute position of plots will make container large-plot have no height.

Fix is very easy. Since the plotOutput is fixed height of 400px, you can just add the same height to the container:

        .large-plot {
            position: relative;
            height: 400px;
        }

enter image description here

lz100
  • 6,990
  • 6
  • 29