inst/app/server.R

In ALSBinary: 'ALS-Binary': Allele Size to Binary Converter

library(shiny)
library(readr)
library(readxl)
library(data.table)
library(DT)
library(openxlsx)

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

  # Reactive dataset
  dataset <- reactive({
    req(input$datafile)
    ext <- tools::file_ext(input$datafile$name)
    header_flag <- as.logical(input$header)

    # Use fast readers
    if (ext %in% c("csv", "txt")) {
      df <- fread(input$datafile$datapath, sep = input$delimiter, header = header_flag)
    } else if (ext == "xlsx") {
      df <- read_excel(input$datafile$datapath, col_names = header_flag)
    }

    # If no headers, assign defaults
    if (!header_flag) {
      ncols <- ncol(df)
      colnames(df) <- c("Marker", "Genotype",
                        paste0("Allele_", seq_len(ncols - 2)))
    }

    df
  })

  # Preview raw data
  output$datapreview <- renderDT(dataset(), options = list(pageLength = 10, scrollX = TRUE))

  # Reactive repeat length file
  repeat_lengths <- reactive({
    req(input$infofile)
    ext <- tools::file_ext(input$infofile$name)
    header_flag <- as.logical(input$header)

    if (ext %in% c("csv", "txt")) {
      df <- fread(input$infofile$datapath, sep = input$delimiter, header = header_flag)
    } else if (ext == "xlsx") {
      df <- read_excel(input$infofile$datapath, col_names = header_flag)
    }

    # If no header, assign default
    if (!header_flag) {
      colnames(df) <- "Repeat_Length"
    }

    df
  })

  # Preview repeat length
  output$repeatpreview <- renderDT(repeat_lengths(), options = list(pageLength = 10, scrollX = TRUE))

  # Temporary combined data for STRUCTURE output
  repeat_lengths_combined <- reactive({
    df <- dataset()
    rl <- repeat_lengths()

    # Ensure we have the same number of repeat lengths as markers
    markers <- unique(df$Marker)
    if (nrow(rl) != length(markers)) {
      stop("Mismatch: number of repeat lengths does not equal number of markers")
    }

    data.frame(
      Marker = markers,
      Repeat_Length = rl[[1]]
    )
  })

  # Conversion
  allele_results <- eventReactive(input$process, {
    req(dataset(), repeat_lengths())
    withProgress(message = "Converting alleles...", value = 0, {
      incProgress(0.3, detail = "Reading data")
      incProgress(0.6, detail = "Processing markers")

      result <- ALSBinary::allele_to_binary(dataset(), repeat_lengths())

      incProgress(1, detail = "Done")
      showNotification("Conversion complete!", type = "message")
      result
    })
  })

  # Marker selector
  output$marker_ui <- renderUI({
    req(allele_results())
    selectInput("marker", "Select Marker:", choices = names(allele_results()$binary))
  })


  # Update marker selector
  observeEvent(allele_results(), {
    updateSelectInput(session, "marker", choices = names(allele_results()$binary))
  })


  # Render selected marker’s matrix
  output$binarypreview <- renderDT({
    req(input$marker)
    mat <- allele_results()$binary[[input$marker]]
    df <- as.data.frame(mat)
    df <- cbind(Genotype = rownames(mat), df)
    rownames(df) <- NULL   # suppress rownames
    df
  }, options = list(pageLength = 10, scrollX = TRUE))


  output$structurepreview <- renderDT({
    req(input$marker)
    mat <- allele_results()$structure[[input$marker]]
    df <- as.data.frame(mat)
    df <- cbind(Genotype = rownames(mat), df)
    df
  }, options = list(pageLength = 10, scrollX = TRUE))


  # Download results
  output$download <- downloadHandler(
    filename = function() {
      paste0("allele_output_", Sys.Date(), ".xlsx")
    },
    content = function(file) {
      wb <- createWorkbook()
      # Binary outputs
      for (marker in names(allele_results()$binary)) {
        mat <- allele_results()$binary[[marker]]
        df <- as.data.frame(mat)
        df <- cbind(Genotype = rownames(mat), df)
        addWorksheet(wb, paste0(marker, "_binary"))
        writeData(wb, paste0(marker, "_binary"), df)
      }
      # Structure outputs
      for (marker in names(allele_results()$structure)) {
        mat <- allele_results()$structure[[marker]]
        df <- as.data.frame(mat)
        df <- cbind(Genotype = rownames(mat), df)
        addWorksheet(wb, paste0(marker, "_structure"))
        writeData(wb, paste0(marker, "_structure"), df)
      }
      saveWorkbook(wb, file, overwrite = TRUE)
    }
  )
}