DraftApp.R

In jngwehi/loxcodeR: Loxcode Tools

library(shiny)
library(plotly)
library(DT)
library(loxcoder)

react <- reactiveValues(lox=D, selected_codeset="all_codes", selected_sample="all_samples")
lox <- D

shinyApp(

  ui = fluidPage(
    theme="bootstrap.css",
    titlePanel("LoxCodeR"),

    navbarPage(
      "LoxcodeR",
      tabPanel(
        "Create codeset",
        wellPanel(
          fluidRow(
            column(4, selectInput("view_codeset", label="Select an existing codeset to view:", choices=names(lox@code_sets)))
        )),
        wellPanel(fluidRow(
          column(12, dataTableOutput("codeset_table"))
        )),
        wellPanel(fluidRow(
          column(5, textInput("name_codeset", label="Name of new codeset:", placeholder="Codeset Name")),

        ), fluidRow(
          column(2, actionButton("create_codeset", "Create Codeset")),
          column(2, actionButton("create_all_codeset", "Create from All")),
          column(2, actionButton("delete_codeset", "Delete Current Codeset")),
        )),
        fluidPage(
          column(12, verbatimTextOutput("selected_codeset"))
        )
      ),

      tabPanel(
        "Samples",
        wellPanel(fluidRow(
          column(4, selectInput("view_sample", "Select an existing collection of samples to view:", choices = names(lox@count_matrixes)))
        )),
        wellPanel(dataTableOutput("summary_table")),
        wellPanel(
          fluidRow(
            column(5, textInput("name_sample", label="Name of new collection of samples:", placeholder="Sample Collection Name")),
          ), fluidRow(
            column(2, actionButton("create_sample", "Create Collection")),
            column(2, actionButton("create_all_sample", "Create from All")),
            column(2, actionButton("delete_sample", "Delete Current Collection"))
          )
        )
      ),

      tabPanel(
        "Overview",
        plotlyOutput("readstats"),
        fluidRow(
          column(4, selectInput("matrix_stats", "Sample:", choices = names(lox@count_matrixes))),
          column(4, selectInput("codeset_stats", "Codes:", choices = names(lox@code_sets))),
          column(4, selectInput("plot_stats", "Plots:", choices = c("size", "complexity", "ratio", "both")))
        )
      ),

      tabPanel(
        "Heatmap",
        plotlyOutput("heatmap"),
        plotOutput("sample_comparison_pie"),
        fluidRow(
          column(4, selectInput("matrix_heat", "Sample:", choices = names(lox@count_matrixes))),
          column(4, selectInput("codeset_heat", "Codes:", choices = names(lox@code_sets))),
          column(4, selectInput("style_heat", "Style:", choices = c("ggplot", "heatmap3", "pheatmap"))))
      ),

      tabPanel(
        "Saturation Plot",
        plotOutput("saturation"),
        fluidRow(
          column(4, selectInput("codeset_sat", "Codes:", choices = names(lox@code_sets)))
        )
      ),

      tabPanel(
        "Pair Comparison Plot",
        plotlyOutput("pair_plot"),
        fluidRow(
          column(3, selectInput("sample1_pair", "Sample 1:", choices = names(lox@samples))),
          column(3, selectInput("sample2_pair", "Sample 2:", choices = names(lox@samples))),
          column(3, selectInput("colour_pair", "Colour by:", choices = c("size", "complexity"))),
          column(3, sliderInput("slider_pair", "Distance Range:", min = 1, max = 500, value = c(245,255)))
        )
      )
    ),


  ),

  server = function(input, output, session) {

    output$heatmap = renderPlotly({
      p <- heatmap_plot(react$lox, code_set=input$codeset_heat, style=input$style_heat)
      ggplotly(p)
    })

    output$sample_comparison_pie = renderPlot({
      sample_comparison_pie(react$lox)
    })

    output$summary_table = renderDataTable({
      d <- summary_table(react$lox, input$view_sample)
      datatable(
      d,
      filter = 'top',
      rownames = FALSE,
      class = "cell-border stripe",
      editable = list(target="cell", disable=list(columns=c(0,seq(2, ncol(d)))))
    )})

    output$readstats = renderPlotly({
      ggplotly(readstats_plot(react$lox, code_set=input$codeset_stats, plot=input$plot_stats))
    })

    output$saturation = renderPlot({
      saturation_plot(react$lox, code_set = input$codeset_sat)
    })

    output$pair_plot = renderPlotly({
      p <- pair_comparison_plot(
        x1=lox@samples[[input$sample1_pair]],
        x2=lox@samples[[input$sample2_pair]],
        dist_range = input$slider_pair,
        plot = input$colour_pair
      )
      ggplotly(p)
    })

    output$codeset_table = renderDataTable({datatable(
      codeset_table(react$lox, input$view_codeset),
      rownames = FALSE,
      class = "cell-border stripe",
      filter = 'top'
    )})

    output$selected_codeset = renderText({
      selectedRowIndex = input$codeset_table_rows_selected
      if (length(selectedRowIndex)){
        selectedRowIndex <- as.numeric(selectedRowIndex)
        selectedRow <- paste(codeset_table(lox, input$view_codeset)[selectedRowIndex,"code"], collapse=", ")
        selectedRow
      }
    })

    observe({
      # updates the slider based on the distance range of the samples selected
      min_dist_one <- min(na.omit(lox@samples[[input$sample1_pair]]@decode@data$dist_orig))
      min_dist_two <- min(na.omit(lox@samples[[input$sample2_pair]]@decode@data$dist_orig))
      max_dist_one <- max(na.omit(lox@samples[[input$sample1_pair]]@decode@data$dist_orig))
      max_dist_two <- max(na.omit(lox@samples[[input$sample2_pair]]@decode@data$dist_orig))
      newmin <- min(min_dist_one, min_dist_two)
      newmax <- max(max_dist_one, max_dist_two)
      updateSliderInput(session, "slider_pair", value = c(newmin,newmax), min=newmin, max=newmax)
    })

    observeEvent(
      input$delete_codeset, {
        new_exp <- react$lox
        new_exp <- delete_codeset(react$lox, input$view_codeset)
        react$lox <- new_exp

        #updates the codesets available
        codeset_selectionID = c("codeset_stats", "view_codeset", "codeset_stats", "codeset_heat", "codeset_sat")
        for (ID in codeset_selectionID){
          updateSelectInput(session, ID, choices = names(react$lox@code_sets))
        }
      }
    )

    observeEvent(
      input$create_codeset, {
        selectedRowIndex = input$codeset_table_rows_selected
        selectedRowIndex <- as.numeric(selectedRowIndex)
        new_exp = react$lox
        new_exp= make_codeset_index(react$lox, c=input$view_codeset, I=selectedRowIndex, n=input$name_codeset)
        react$lox = new_exp

        # updates the codesets available
        codeset_selectionID = c("codeset_stats", "view_codeset", "codeset_stats", "codeset_heat", "codeset_sat")
        for (ID in codeset_selectionID){
          updateSelectInput(session, ID, choices = names(react$lox@code_sets), selected = input$name_codeset)
        }

        # clears text input box
        updateTextInput(session, "name_codeset", label="Name of new codeset:", placeholder="Codeset Name", value="")
      }
    )

    observeEvent(
      input$create_all_codeset, {
        selectedRowIndex = input$codeset_table_rows_all
        selectedRowIndex <- as.numeric(selectedRowIndex)
        new_exp = react$lox
        new_exp= make_codeset_index(react$lox, c=input$view_codeset, I=selectedRowIndex, n=input$name_codeset)
        react$lox = new_exp

        # updates the codesets available
        codeset_selectionID = c("codeset_stats", "view_codeset", "codeset_stats", "codeset_heat", "codeset_sat")
        for (ID in codeset_selectionID){
          updateSelectInput(session, ID, choices = names(react$lox@code_sets), selected = input$name_codeset)
        }

        # clears text input box
        updateTextInput(session, "name_codeset", label="Name of new codeset:", placeholder="Codeset Name", value="")
      }
    )

    observeEvent(
      input$create_sample, {
        selectedRowIndex = input$summary_table_rows_selected
        selectedRowIndex <- as.numeric(selectedRowIndex)
        new_exp = react$lox
        new_exp= make_count_matrix(react$lox, c=input$view_sample, I=selectedRowIndex, n=input$name_sample)
        react$lox = new_exp

        # updates the samples available
        sample_selectionID = c("view_sample", "matrix_stats", "matrix_heat")
        for (ID in sample_selectionID){
          updateSelectInput(session, ID, choices = names(react$lox@count_matrixes), selected = input$name_sample)
        }

        # clears text input box
        updateTextInput(session, "name_sample", label="Name of new collection of samples:", placeholder="Sample Collection Name", value="")
      }
    )

    observeEvent(
      input$create_all_sample, {
        selectedRowIndex = input$summary_table_rows_all
        selectedRowIndex <- as.numeric(selectedRowIndex)
        new_exp = react$lox
        new_exp= make_count_matrix(react$lox, c=input$view_sample, I=selectedRowIndex, n=input$name_sample)
        react$lox = new_exp

        # updates the codesets available
        sample_selectionID = c("view_sample", "matrix_stats", "matrix_heat")
        for (ID in sample_selectionID){
          updateSelectInput(session, ID, choices = names(react$lox@count_matrixes), selected = input$name_sample)
        }

        # clears text input box
        updateTextInput(session, "name_sample", label="Name of new collection of samples:", placeholder="Sample Collection Name", value="")
      }
    )

    observeEvent(
      input$delete_sample, {
        new_exp <- react$lox
        new_exp <- delete_count_matrix(react$lox, input$view_sample)
        react$lox <- new_exp

        #updates the samples available
        sample_selectionID = c("view_sample", "matrix_stats", "matrix_heat")
        for (ID in sample_selectionID){
          updateSelectInput(session, ID, choices = names(react$lox@count_matrixes))
        }
      }
    )
  },

  options = list(height = 600),
)