Shinylive app renders in Quarto but not the correct size - Stack Overflow

admin管理员组

文章数量:1287858

The shiny app works. Also, using shinylive it renders in quarto. However you can see from the screen shot below it "truncates" the app when rendering I've tired a few ways to get the app to render correctly e.g. varying body-width and viewer-height options with no success.

This is the code.

---
title: "demo"
format:
  html:
    grid:
      body-width: 1400px
filters:
  - shinylive
---

---
title: "Our first r-shinylive Quarto document!"
filters:
  - shinylive
---

```{shinylive-r}
#| standalone: true
#| viewer-height: 600
  

library(shiny)
library(ggplot2)
library(dplyr)
library(bslib)

theme <-bs_theme(font_scale=1.5)

ui <- fluidPage(
  titlePanel("ShinyLive: Visualizing X ~ N(μ_x, 1) and Custom Y Transformations"),
  
  sidebarLayout(
    sidebarPanel(
      textInput("y_formula", "Enter Y formula (use 'X'):", "2 + 2*X"),
      helpText("Use 'X' to define the function, e.g., '2 + 2*X' or '2 + 4*X'."),
      
      textInput("mu_x_values", "Enter up to 3 values for μ_x (comma-separated):", "0,2"),
      numericInput("n", "Number of Samples:", value = 1000, min = 100, max = 5000, step = 100)
    ),
    
    mainPanel(
      plotOutput("distPlotX"),
      plotOutput("distPlotY"),
      verbatimTextOutput("error_message")
    )
  )
)

server <- function(input, output) {
  data <- reactive({
    mu_x_values <- unlist(strsplit(input$mu_x_values, ","))
    mu_x_values <- suppressWarnings(as.numeric(mu_x_values))
    mu_x_values <- mu_x_values[!is.na(mu_x_values) & mu_x_values != ""]
    
    if (length(mu_x_values) == 0 || length(mu_x_values) > 3) {
      output$error_message <- renderText("Please enter 1 to 3 valid numeric values for μ_x, separated by commas.")
      return(NULL)
    }
    
    df_list <- lapply(mu_x_values, function(mu) {
      x <- rnorm(input$n, mean = mu, sd = 1)
      y <- tryCatch(
        eval(parse(text = gsub("X", "x", input$y_formula))),
        error = function(e) {
          output$error_message <- renderText("Invalid Y formula. Please check your input.")
          return(rep(NA, length(x)))
        }
      )
      data.frame(X = x, Y = y, mu_x = paste("μ_x =", mu))
    })
    
    bind_rows(df_list)
  })
  
  output$distPlotX <- renderPlot({
    req(data())

    # Compute density peak and mean for X
    density_data <- data() %>%
      group_by(mu_x) %>%
      summarize(density_peak = max(density(X)$y), mean_X = mean(X))

    ggplot(data(), aes(x = X)) +
      geom_histogram(aes(y = ..density..), bins = 30, alpha = 0.5, fill = "blue", color = "black") +
      geom_density(linewidth = 1, color = "red") +
      geom_segment(data = density_data, aes(x = mean_X, xend = mean_X, y = 0, yend = density_peak), 
                   color = "black", linetype = "dashed", linewidth = 1) + # Clipped vertical mean line
      facet_wrap(~mu_x) +
      labs(title = "Distribution of X ~ N(μ_x, 1)",
           x = "X", y = "Density") +
      theme_minimal()
  })

  output$distPlotY <- renderPlot({
    req(data())

    # Compute density peak and mean for Y
    density_data <- data() %>%
      group_by(mu_x) %>%
      summarize(density_peak = max(density(Y, na.rm = TRUE)$y), mean_Y = mean(Y, na.rm = TRUE))

    ggplot(data(), aes(x = Y)) +
      geom_histogram(aes(y = ..density..), bins = 30, alpha = 0.5, fill = "green", color = "black") +
      geom_density(linewidth = 1, color = "darkgreen") +
      geom_segment(data = density_data, aes(x = mean_Y, xend = mean_Y, y = 0, yend = density_peak), 
                   color = "black", linetype = "dashed", linewidth = 1) + # Clipped vertical mean line
      facet_wrap(~mu_x) +
      labs(title = expression(paste("Distribution of Y = f(X) for each ", mu[x])),
           x = "Y", y = "Density") +
      theme_minimal()
  })
}

shinyApp(ui, server)

This renders but gives

本文标签： Shinylive app renders in Quarto but not the correct sizeStack Overflow