Shiny中的隔离变量

Question

闪亮的初学者问题，但在阅读文档后感到疲倦并且显然错过了isolate() 的要点。我正在开发一个简单的应用程序，用于根据基因型模拟表型。不重要，除非你是遗传学家。我想要实现的是，仅更改 m 或 N 的值会导致重新采样基因型 G 并将它们显示在表格中。当我改变平均效果或其标准时。开发人员，我只想改变第一行的值。当我打电话给currG() 和currBetas() 时试图添加isolate，但没有达到预期的效果。将不胜感激一些提示。代码：

library(shiny)

# Define UI for application that draws a histogram
ui <- fluidPage(

    # Application title
    titlePanel("Phenotype simulator"),

    # Sidebar with a slider input for number of bins
    sidebarLayout(
        sidebarPanel(
            sliderInput("N",
                        "Number of individuals:",
                        min=1000,
                        max=10000,
                        step = 1000,
                        value=5000),
            sliderInput("m",
                        "Number of markers:",
                        min=1,
                        max=10,
                        step=1,
                        value=5),
            sliderInput("betas_mu",
                        "Mean effect:",
                        min=0,
                        max=5,
                        step=.5,
                        value=1),
            sliderInput("betas_sd",
                        "Effect SD:",
                        min=0,
                        max=3,
                        step=0.1,
                        value=1),
            sliderInput("e_mu",
                        "Mean error:",
                        min=0,
                        max=0.5,
                        step=0.01,
                        value=0.25),
            sliderInput("e_sd",
                        "Error SD:",
                        min=0,
                        max=1,
                        step=0.01,
                        value=1),
            sliderInput("m_neg",
                         "Number of markers with negative effect:",
                         value = 0,
                         step = 1,
                         min = 0,
                         max = 5
                         ),
            sliderInput("q",
                        "Minor allele frequency:",
                        min=0,
                        max=1,
                        step=0.01,
                        value=.33),
            # sliderInput("precision",
            #             "Decimals:",
            #             min=1,
            #             max=5,
            #             value=3),
            sliderInput("bins",
                        "Number of bins:",
                        min = 1,
                        max = 50,
                        value = 30)
        ),

        # Show a plot of the generated distribution
        mainPanel(
           p("Error and simulated trait distributions", style="font-size:15pt"),
           plotOutput("distPlot"),
           p("Genotypes for the first 5 individuals", style="font-size:15pt"),
           tableOutput("genos"),
           p("Distribution of effect sizes", style="font-size:15pt"),
           plotOutput("eff_distPlot")
        )
    )
)

# Define server logic required to draw a histogram
server <- function(input, output) {
    currG <- function() {
      p <- 1 - input$q
      q <- input$q
      m <- input$m
      N <- input$N
      gt <- sample(x = c(0,1,2), size = (input$N * input$m), replace = T, prob = c(p^2, p*q, q^2))
      G <- matrix(gt, ncol = m, byrow = T)
      return(G)
    }

    currBetas <- function() {
      cg <- currG()
      m <- dim(cg)[2]
      N <- dim(cg)[1]
      m_neg <- input$m_neg
      betas <- abs(rnorm(n = m, mean = input$betas_mu, sd = input$betas_sd))
      negative_idx <- sample(c(1:m), size=m_neg, replace=F)
      signs <- rep(1, times=m)
      betas[negative_idx] <- -betas[negative_idx]
      return(list(betas=betas, signs=signs))
    }

    currPheno <- function() {
      G <- currG()
      tmp <- currBetas()
      N <- dim(G)[1]
      m <- dim(G)[2]
      m_neg <- input$m_neg
      errors <- rnorm(n = N, mean = input$e_mu, sd = input$e_sd)
      y <- G %*% (tmp$signs * tmp$betas) + errors
      y2 <- round(y, digits = 3)
      data <- data.frame(error = errors, y = y2)
      dat <- data %>% pivot_longer(cols = c(error, y))
      return(list(dat=dat, betas=betas, G=G))
    }

  output$eff_distPlot <- renderPlot({
    dat <- data.frame(value=rnorm(n = 1000, mean = input$betas_mu, sd = input$betas_sd))
    ggplot(dat, mapping = aes(x=value)) +
      geom_histogram(mapping = aes(fill='orange')) +
      theme_bw()
  })

    output$distPlot <- renderPlot({
      new_data = currPheno()
       ggplot(new_data$dat, mapping = aes(x=value)) +
        geom_histogram(mapping = aes(fill=name), bins = input$bins) +
        theme_bw() +
        facet_wrap(~name)
    })

    output$genos <- renderTable({
      G <- currG()
      B <- currBetas()
      G <- G[1:5,]
      tmp <- apply(G, MARGIN = c(1,2), as.integer)
      tmp <- cbind(c('effect', paste0("ind", 1:dim(G)[1])), rbind(round(B$betas, 3), G))
      colnames(tmp) <- c(" ", paste0("SNP", c(1:dim(G)[2])))
      print(tmp)
    },
    colnames = T
)}

# Run the application
shinyApp(ui = ui, server = server)

Answer 1

确实，reactiveValues 以及 observeEvent 和 observe 似乎是实现我想要的更好和更清洁的方式。在 Shiny 方面还有很多东西要学习，但已经向前迈出了一步。感谢MrFlick 的建议！

library(shiny)

# Define UI for application that draws a histogram
ui <- fluidPage(

  # Application title
  titlePanel("Phenotype simulator"),

  # Sidebar with a slider input for number of bins
  sidebarLayout(
    sidebarPanel(
      sliderInput("N",
                  "Number of individuals:",
                  min=1000,
                  max=10000,
                  step = 1000,
                  value=5000),
      sliderInput("m",
                  "Number of markers:",
                  min=1,
                  max=10,
                  step=1,
                  value=5),
      sliderInput("betas_mu",
                  "Mean effect:",
                  min=0,
                  max=5,
                  step=.5,
                  value=1),
      sliderInput("betas_sd",
                  "Effect SD:",
                  min=0,
                  max=3,
                  step=0.1,
                  value=1),
      sliderInput("e_mu",
                  "Mean error:",
                  min=0,
                  max=0.5,
                  step=0.01,
                  value=0.25),
      sliderInput("e_sd",
                  "Error SD:",
                  min=0,
                  max=1,
                  step=0.01,
                  value=1),
      sliderInput("m_neg",
                  "Number of markers with negative effect:",
                  value = 0,
                  step = 1,
                  min = 0,
                  max = 5
      ),
      sliderInput("q",
                  "Minor allele frequency:",
                  min=0,
                  max=1,
                  step=0.01,
                  value=.33),
      # sliderInput("precision",
      #             "Decimals:",
      #             min=1,
      #             max=5,
      #             value=3),
      sliderInput("bins",
                  "Number of bins:",
                  min = 1,
                  max = 50,
                  value = 30)
    ),

    # Show a plot of the generated distribution
    mainPanel(
      p("Genotypes for the first 5 individuals", style="font-size:15pt"),
      tableOutput("genos"),
      tableOutput("betas"),
      plotOutput("errors"),
      plotOutput("phenos"),
    )
  )
)

# Define server logic required to draw a histogram
server <- function(input, output) {
  rvals <- reactiveValues(
    G = NULL,
    betas = NULL,
    errors = c(0),
    phenos = c(0),
  )

  observeEvent(c(input$N, input$m, input$q), {
    p <- 1 - input$q
    q <- input$q
    gt <- sample(x = c(0,1,2),
                 size = (input$N * input$m),
                 replace = T,
                 prob = c(p^2, p*q, q^2))
    rvals$G <- matrix(gt, ncol = input$m, byrow = T)
  })

  observe({
    betas <- abs(rnorm(n = input$m,
                       mean = input$betas_mu,
                       sd = input$betas_sd))
    negative_idx <- sample(c(1:input$m), size=input$m_neg, replace=F)
    signs <- rep(1, times=input$m)
    betas[negative_idx] <- -betas[negative_idx]
    rvals$betas <- betas
  })

  observe({
    N <- dim(rvals$G)[1]
    m <- dim(rvals$G)[2]
    errors <- rnorm(n = N, mean = input$e_mu, sd = input$e_sd)
    rvals$errors <- errors
  })

  observe({
    phenos <- round(rvals$G %*% rvals$betas + rvals$errors, digits = 3)
    rvals$phenos <- phenos
  })

  output$genos <- renderTable({
    rvals$G[1:5,]
  })

  output$betas <- renderTable({
    t(rvals$betas)
  })

  output$errors <- renderPlot({
    x <- data.frame(errors = rvals$errors)
    ggplot(x, mapping = aes(x = errors)) +
      geom_histogram() +
      theme_bw()
  })

  output$phenos <- renderPlot({
    x <- data.frame(phenos = rvals$phenos)
    ggplot(x, mapping = aes(x = phenos, fill = 'orange')) +
      geom_histogram() +
      theme_bw()
  })
}

# Run the application
shinyApp(ui = ui, server = server)