R/shiny_orgviz.R

In ukgovdatascience/orgsurveyr: Visualising and Analysing Organisation Data As Tidy Networks

#' Orgviz shiny UI
#'
#' Creates a shiny UI object for the orgviz shiny app
#'
#' @return shiny ui object
#' @import shiny
#' @export
#'
#' @examples
#' \dontrun{
#' library(shiny)
#'
#' shinyApp(ui = orgviz_ui(),
#'          server = function(input, output) {
#'            orgviz_server(input, output, tg = NULL, df = NULL)
#'          }
#' )
#' }
orgviz_ui <- function() {

  fluidPage(

    # Application title
    titlePanel("Orgsurveyr Shiny App"),

    # Sidebar with a slider input for number of bins
    sidebarLayout(
      sidebarPanel(
        selectInput(
          'plot_type',
          "Choose a plot type:",
          choices = c("Sunburst", "Icicle", "Dendrogram", "Circular Dendrogram"),
          selected = 'Sunburst'
        ),
        uiOutput('var_ui'),
        uiOutput('root_unit'),
        actionButton("up_one_level", "Go up one level")
      ),

      # Show a plot of the generated distribution
      mainPanel(
        tableOutput('clickedinfo'),
        plotOutput("plot", click = "plot_click", hover = "plot_hover",
                   width='700px', height='600px'),
        verbatimTextOutput('pointinfo')
      )
    )
  )

}

#' Orgviz shiny server
#'
#' Creates a shiny server object for the orgviz shiny app
#'
#' @param input shiny input
#' @param output shiny output
#' @param tg user supplied tbl_graph
#' @param df user supplied a data frame in org_tall_df format
#'  ie summarised metrics for the units in the network as generated by calc_summary_df.
#'
#' @return shiny server function
#' @export
#'
#' @examples
#' \dontrun{
#' library(shiny)
#'
#' shinyApp(ui = orgviz_ui(),
#'          server = function(input, output) {
#'            orgviz_server(input, output, tg = NULL, df = NULL)
#'          }
#' )
#' }
orgviz_server <- function(input, output, tg=NULL, df=NULL) {

  if(is.null(tg)) {
    set.seed(10001)
    tg <- create_realistic_org(5, 5, prob=0.2) %>%
      simulate_unit_size()
  }

  if(is.null(df)) {
    # simulate individual data and summarise
    indiv_df <- tg %>%
      simulate_individuals_df() %>%
      dplyr::mutate(test_var2 = purrr::map_dbl(individual_id, ~rnorm(1, 20,3)))

    df <- calc_summary_df(tg, indiv_df, NULL,
                    c('test_var', 'test_var2'), TRUE)

  }

  var_list <- df %>% dplyr::distinct(metric_id) %>% unlist() %>% unname()

  values <- reactiveValues(
    selected_var = var_list[1],
    selected_node = '1',
    is_circular = TRUE,
    is_dendrogram = TRUE
    )

  observeEvent(input$root_unit, {
    values$selected_node <- input$root_unit
  })

  observeEvent(input$plot_var, {
    values$selected_var <- input$plot_var
  })

  observeEvent(input$plot_click, {
    np <- nearPoints(plot_gg()$data, input$plot_click,
                     xvar='x', yvar='y', maxpoints=1, threshold=10)
    if(nrow(np) ==1) {
      values$selected_node <- np$unit_id
    }
  })

  # go up one level in the org when button pressed
  observeEvent(input$up_one_level, {

    node_parent <- tg %>%
      tidygraph::activate(nodes) %>%
      tidygraph::mutate(node_parent=tidygraph::dfs_parent()) %>%
      tidygraph::as_tibble() %>%
      dplyr::filter(unit_id == values$selected_node)

    if(is.na(node_parent$node_parent)) {
      return()
    }

    nodes <- tg %>%
      tidygraph::activate(nodes) %>%
      tidygraph::as_tibble() %>%
      dplyr::filter(dplyr::row_number() == node_parent$node_parent)

    values$selected_node <- nodes$unit_id

  })

  observeEvent(input$plot_type, {
    if(input$plot_type == 'Sunburst') {
      values$is_dendrogram = FALSE
      values$is_circular = TRUE
    } else if (input$plot_type == 'Icicle') {
      values$is_dendrogram = FALSE
      values$is_circular = FALSE
    } else if (input$plot_type == 'Dendrogram') {
      values$is_dendrogram = TRUE
      values$is_circular = FALSE
    } else if (input$plot_type == 'Circular Dendrogram') {
      values$is_dendrogram = TRUE
      values$is_circular = TRUE
    }
  })

  output$clickedinfo <- renderTable({
    tg %>%
      tidygraph::activate(nodes) %>%
      tidygraph::as_tibble() %>%
      dplyr::filter(unit_id == values$selected_node)
  })

  output$var_ui <- renderUI({
    selectInput('plot_var', 'Select a variable to plot', choices = var_list, selected = var_list[2])
  })

  tg_filtered <- reactive({

    nodes <- tg %>% tidygraph::activate(nodes) %>%
      tidygraph::as_tibble()

    sn <- which(nodes$unit_id == values$selected_node)

    tg %>%
      tidygraph::filter(tidygraph::node_distance_from(sn) < Inf)

  })

  plot_gg <- reactive({

    plot_org(tg_filtered(), fill_var=values$selected_var, df=df,
             is_circular = values$is_circular, is_dendrogram = values$is_dendrogram) +
      scale_fill_gradientn(colours=RColorBrewer::brewer.pal(11, 'PiYG'))

  })

  output$plot <- renderPlot({
    plot_gg()
  })

  output$root_unit <- renderUI({

    dept_info <- tg %>%
      tidygraph::filter(!tidygraph::node_is_leaf()) %>%
      tidygraph::activate(nodes) %>%
      tidygraph::as_tibble() %>%
      dplyr::arrange(unit_id)

    choices_vector <- dept_info$unit_id
    names(choices_vector) <- dept_info$unit_id

    selectInput(
      'root_unit',
      'Choose an organisational unit',
      choices = choices_vector,
      selected = values$selected_node
    )

  })

  output$pointinfo <- renderPrint({
    nearPoints(plot_gg()$data, input$plot_hover, xvar='x', yvar='y') %>%
      dplyr::select(suppressWarnings(dplyr::one_of(c('unit_id', 'org_depth', var_list))))

  })


}

#' Orgviz shiny app
#'
#' Convenience function to run the orgviz shiny app within an R session.
#'
#' The orgviz shiny app permits interactive exploration of an organisational network, and the mapping
#' of numeric data onto the organisation.  By default a dataset is simulated, but a tidygraph object and
#' a data frame in the org_tall_df format call be supplied to visualise custom data.
#'
#' @param tg user supplied tbl_graph
#' @param df user supplied a data frame in org_tall_df format
#'  ie summarised metrics for the units in the network as generated by calc_summary_df.
#'
#' @return runs a shiny app
#' @export
#' @import shiny
#'
#' @examples
#' \dontrun{
#'
#' # run with embedded data
#' orgviz()
#'
#' # run with example data
#' orgviz(tg=orgsurveyr::tg_org, df=orgsurveyr::tg_org_summarised_df)
#'
#' }
orgviz <- function(tg=NULL, df=NULL) {
  shinyApp(ui = orgviz_ui(),
           server = function(input, output) {
             orgviz_server(input, output, tg=tg, df=df)
           }
  )
}