inst/shiny/v1.3/trajectory/select_method_and_name.R

In romanhaa/cerebroApp: Interactive visualization of scRNA-seq data with Cerebro

##----------------------------------------------------------------------------##
## Tab: Trajectory
##
## Select method and name.
##----------------------------------------------------------------------------##

##----------------------------------------------------------------------------##
## UI element to set layout for selection of method and name, which are split
## because the names of available trajectories depends on which method is
## selected. If no method is available, show message that data is missing.
##----------------------------------------------------------------------------##

output[["trajectory_select_method_and_name_UI"]] <- renderUI({

  ## currently, only trajectories from monocle2 are supported
  available_methods <- getMethodsForTrajectories()
  available_methods <- available_methods[available_methods %in% c('monocle2')]

  if ( length(getMethodsForTrajectories()) == 0 ) {
    fluidRow(
      cerebroBox(
        title = "Trajectory",
        textOutput("trajectory_missing")
      )
    )
  } else if ( length(available_methods) > 0 ) {
    tagList(
      fluidRow(
        column(
          6,
          uiOutput("trajectory_selected_method_UI")
        ),
        column(
          6,
          uiOutput("trajectory_selected_name_UI")
        )
      )
    )
  }
})

##----------------------------------------------------------------------------##
## UI element to select from which method the results should be shown.
##----------------------------------------------------------------------------##

output[["trajectory_selected_method_UI"]] <- renderUI({

  ## currently, only trajectories from monocle2 are supported
  available_methods <- getMethodsForTrajectories()
  available_methods <- available_methods[available_methods %in% c('monocle2')]

  tagList(
    div(
      HTML('<h3 style="text-align: center; margin-top: 0"><strong>Choose a method:</strong></h2>')
    ),
    fluidRow(
      column(2),
      column(8,
        selectInput(
          "trajectory_selected_method",
          label = NULL,
          choices = available_methods,
          width = "100%"
        )
      ),
      column(2)
    )
  )
})

##----------------------------------------------------------------------------##
## UI element to select which trajectory (name) should be shown.
##----------------------------------------------------------------------------##

output[["trajectory_selected_name_UI"]] <- renderUI({
  req(
    input[["trajectory_selected_method"]]
  )
  tagList(
    div(
      HTML('<h3 style="text-align: center; margin-top: 0"><strong>Choose a trajectory:</strong></h2>')
    ),
    fluidRow(
      column(2),
      column(8,
        selectInput(
          "trajectory_selected_name",
          label = NULL,
          choices = getNamesOfTrajectories(input[["trajectory_selected_method"]]),
          width = "100%"
        )
      ),
      column(2)
    )
  )
})

##----------------------------------------------------------------------------##
## Alternative text message if data is missing.
##----------------------------------------------------------------------------##

output[["trajectory_missing"]] <- renderText({
  "No trajectories available to display."
})