Состояние гонки при обновлении Shiny SelectizeInputs - PullRequest
Новая
       17

Состояние гонки при обновлении Shiny SelectizeInputs

0 голосов
/ 23 апреля 2020

У меня возникли проблемы с настройкой требуемой функциональности на трех входах выбора в блестящем приложении. Приложение имеет три последовательных ввода (ген, ткань, событие), где значение входа гена ограничивает набор значений ткани, а значение ввода ткани ограничивает набор значений события.

Я настроил функциональность для обновления выбора ткани / события при выборе гена и обновления выбора события при выборе ткани.

Мне также нужна отдельная функция, где Я обновляю все три этих ввода, когда строка выбирается в DataTable.

Я реализовал обе эти функции, но обнаружил, что настроил состояние гонки. Когда я выбираю строку из DataTable, иногда правильные значения вводятся во входные данные, а иногда значения по умолчанию вводятся в ткань / событие, выбирая значение по умолчанию для гена (первая ткань для этого гена, первое событие для этого ткань).

Есть ли способ, которым я могу изменить свои настройки или остановить это состояние гонки и при этом достичь этих функций? 


library(shiny)
library(yaml)
library(DT)
library(shinythemes)

options(bitmapType='cairo')

df <- load.df()
dataTable.df <- load.dataTable.df()

ui <- navbarPage(
    theme = shinytheme("cerulean"), #flatly, simplex, spacelab
    "viewer",
    tabsetPanel(id = "viewer",
        tabPanel(
            title = "panel1",
            value = "panel1",
            mainPanel(
                fluidPage(
                    h3("hits"),
                    DT::dataTableOutput(
                        'hits.table',
                        height = "500px",
                        width = "100%"
                    )
                )
            )
        ),
        tabPanel(
            title = "plots",
            value = "plots",
            sidebarPanel(
                selectizeInput("gene.select",
                label = "Choose gene:",
                choices = gene.list,
                multiple = FALSE
                ),
                br(),
                selectizeInput("tissue.select",
                    label = "Choose tissue:",
                    choices = NULL,
                    multiple = FALSE
                ),
                br(),
                selectizeInput("event.select",
                    label = "Choose splicing event:",
                    choices = NULL,
                    multiple = FALSE
                ),
                br(),
                actionButton("go.plot", "Go!")
            ),
            mainPanel(
                imageOutput(
                    "boxplot", width="50%", height= "auto", inline=TRUE
                )
            )
        )
    )
)


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

  # When an input is updated, update the query string
  observeEvent(input$gene.select, {
    query <- parseQueryString(session$clientData$url_search)
    tissue <- query[['tissue']]
    event <- query[['event']]
    updateQueryString(
      paste(
        paste("?gene", input$gene.select, sep="="),
        paste("tissue", input$tissue.select, sep="="),
        paste("event", input$event.select, sep="="),
        sep="&"
      )
    )
  })

  observeEvent(input$tissue.select, {
    query <- parseQueryString(session$clientData$url_search)
    tissue <- query[['tissue']]
    event <- query[['event']]
    updateQueryString(
      paste(
        paste("?gene", input$gene.select, sep="="),
        paste("tissue", input$tissue.select, sep="="),
        paste("event", input$event.select, sep="="),
        sep="&"
      )
    )
  })

  observeEvent(input$event.select, {
    query <- parseQueryString(session$clientData$url_search)
    tissue <- query[['tissue']]
    event <- query[['event']]
    updateQueryString(
      paste(
        paste("?gene", input$gene.select, sep="="),
        paste("tissue", input$tissue.select, sep="="),
        paste("event", input$event.select, sep="="),
        sep="&"
      )
    )
  })

  # When a table row is selected, update query string and selectize inputs
  observeEvent(input$hits.table_rows_selected, {
    hits <- as.numeric(input$hits.table_rows_selected)
    #hit <- hits[length(hits)]
    hit <- hits[1]
    gene <- dataTable.df[hit, "hgnc"]
    gene.formatted <- hgnc2format(gene)
    tissue <- dataTable.df[hit, "tissue"]
    chrom <- dataTable.df[hit, "chrom"]
    start <- dataTable.df[hit, "start"]
    end <- dataTable.df[hit, "end"]
    event <- paste("chr", chrom, ":", start, "-", end, sep="")
    updateSelectizeInput(
      session, 'gene.select', choices = gene.list,
      selected = gene.formatted, server = TRUE
    )
    hgnc <- strsplit(gene.formatted, " ")[[1]][1]
    ensgs <- hgnc2ensgs(hgnc)
    gene_hits <- df[df$gene_id %in% ensgs,]

    updateSelectizeInput(
      session, "tissue.select",  choices = sort(unique(gene_hits$tissue)),
      selected = tissue
    )

    tissue_hits <- gene_hits[gene_hits$tissue == tissue,]

    updateSelectizeInput(
      session, "event.select", choices = sort(unique(gene_hits$event_coords)),
      selected = event
    )
  })

  ## When a gene or tissue select is updated, update other selects accordingly
  observeEvent(input$gene.select, {
    gene <- input$gene.select
    tissue <- input$tissue.select
    event <- input$event.select

    hgnc <- strsplit(gene, " ")[[1]][1]
    ensgs <- hgnc2ensgs(hgnc)

    gene_hits <- df[df$gene_id %in% ensgs,]

    if (is.null(tissue) || tissue == '' ) {
        tissue <- sort(unique(gene_hits$tissue))[1]
    }

    tissue_hits <- gene_hits[gene_hits$tissue == tissue,]

    if (is.null(event) || event == '') {
        event <- sort(unique(tissue_hits$event_coords))[1]
    }

    updateSelectizeInput(
      session, "tissue.select",  choices = sort(unique(gene_hits$tissue)),
      selected = tissue
    )
    updateSelectizeInput(
      session, "event.select", choices = sort(unique(tissue_hits$event_coords)), selected = event
    )
  })

  observeEvent(input$tissue.select, {
    gene <- input$gene.select
    tissue <- input$tissue.select
    event <- input$event.select

    hgnc <- strsplit(input$gene.select, " ")[[1]][1]
    ensgs <- hgnc2ensgs(hgnc)

    gene_hits <- df[df$gene_id %in% ensgs,]

    if (is.null(tissue) || tissue == '') {
      tissue <- sort(unique(gene_hits$tissue))[1]
    }

    tissue_hits <- gene_hits[gene_hits$tissue == tissue,]

    if (is.null(event) || event == '') {
      event <- sort(unique(tissue_hits$event_coords))[1]
    }

    updateSelectizeInput(
      session, "event.select",
      choices = sort(unique(tissue_hits$event_coords)),
      selected = event
    )
  })

  output$boxplot <- renderImage({
    # Don't make first plot until Go! is clicked
    req(input$go.plot)
    # Load data
    gene_format <- input$gene.select
    hgnc <- strsplit(gene_format, " ")[[1]][1]
    ensgs <- hgnc2ensgs(hgnc)
    tissue <- input$tissue.select
    event <- input$event.select
    chrom <- strsplit(event, ":")[[1]][1]
    coords <- strsplit(event, ":")[[1]][2]
    exon_start <- as.numeric(strsplit(coords, "-")[[1]][1])
    exon_end <- as.numeric(strsplit(coords, "-")[[1]][2])
    gene_hits <- df[df$gene_id %in% ensgs,]
    tissue_hits <- gene_hits[gene_hits$tissue == tissue,]
    event_hits <- tissue_hits[
        (tissue_hits$chrom == chrom) &
        (tissue_hits$exon_start == exon_start) &
        (tissue_hits$exon_end == exon_end),
    ]
    # Update tissue selections
    #updateSelectizeInput(
    #    session, "tissue.select",  choices = sort(unique(gene_hits$tissue))
    #)
    if (dim(event_hits)[1] >= 1) {
      out.file <- paste(
        plots.dir,
        tissue,
        "box_plots",
          paste(
            paste(
              as.character(floor(-1 * log10(event_hits[1,"corrected_pval"]))),
              event_hits[1,"chrom"],
              as.character(event_hits[1,"exon_start"]),
              as.character(event_hits[1,"exon_end"]),
              event_hits[1,"assay_name"],
              sep="_"
            ),
            ".boxplot.png",
            sep=""
          ),
        sep="/"
      )
    } else {
      out.file <- hgnc
      #out.file <- "/public/appdata/no_img_found.png"
    }
    list(src = out.file, contentType = 'image/png', width="49%", alt =  out.file)
}, deleteFile = FALSE)

shinyApp(ui = ui, server = server)```
...