inst/ANOVA/app.R

In TBA: Collection of 'shiny' Apps for Tree Breeding Analysis

library(shiny)
library(readxl)
library(shinybusy)


# ANOVA analysis function

ANOVA_table <- function(data) {

  # Convert the first two columns to factor type
  data[, 1:2] <- lapply(data[, 1:2], as.factor)

  # Convert the remaining columns to numeric
  data[, -c(1, 2)] <- lapply(data[, -c(1, 2)], as.numeric)

  # Extract trait names (excluding the first two columns)
  traits <- names(data)[-c(1, 2)]

  # Initialize results data frame with corrected column name
  results <- data.frame("Source of variation" = c(names(data)[1], names(data)[2], "Residuals"),
                        "Df" = numeric(3),
                        stringsAsFactors = FALSE)

  # Loop through each trait
  for (trait in traits) {

    # Perform linear regression
    formula <- as.formula(paste0("`", trait, "` ~ `", names(data)[1], "` + `", names(data)[2], "`"))
    model <- lm(formula, data = data)

    # Perform ANOVA
    anova_result <- anova(model)

    # Extract degrees of freedom, mean squares, and p-values
    degrees_of_freedom <- anova_result$Df
    mean_squares <- round(anova_result$`Mean Sq`, 2)
    p_values <- anova_result$`Pr(>F)`[1:2]

    # Update degrees of freedom in the results data frame
    results[["Df"]] <- degrees_of_freedom

    # Determine significance levels
    significance <- ifelse(p_values < 0.05, "*", "NS")


    # Combine mean squares with significance levels
    formatted_results <- c(paste0(mean_squares[1], " ", significance[1]),
                           paste0(mean_squares[2], " ", significance[2]),
                           mean_squares[3])

    # Add results to the data frame
    results[[trait]] <- formatted_results
  }

  # Correcting the column name
  colnames(results)[1] <- "Source of variation"

  # Return the results
  return(results)
}



ui<-fluidPage(
  sidebarLayout(
    sidebarPanel(
      h3("ANOVA Analysis", style = "color: blue; font-weight: bold;font-size: 30px;"),
      h3("Upload the data file", style = "font-weight: bold"),
      fileInput("file2", "Choose Excel File (.xlsx , .xls)", accept = c(".xlsx", ".xls")),
      actionButton("analyze_anova", "Analyze", style = "color: #FFFFFF; background-color: #007BFF; border-color: #007BFF;margin-bottom: 10px;"),
      # Data format instructions in red
      p("Instructions for data format:", style = "color: orange; font-weight: bold;font-size: 16px;"),
      p("Excel file name should not contain spaces (e.g., use 'Sample_Data.xlsx' instead of 'Sample Data.xlsx')", style = "color: red;font-weight: bold;font-size: 14px;"),
      p("First column: Replication", style = "color: red;font-weight: bold;font-size: 14px;"),
      p("Second column: Genotypes", style = "color: red;font-weight: bold;font-size: 14px;"),
      p("Subsequent columns: Trait values (e.g., DBH, PH, FW, SW, KW, OC)", style = "color: red;font-weight: bold;font-size: 14px;"),
      p("Trait names should be short (e.g., 'DBH' for Diameter at Breast Height)", style = "color: red;font-weight: bold;font-size: 14px;"),
      p("Note: The analysis is based on the Randomized Block Design (RBD)", style = "color: purple; font-weight: bold;font-size: 16px;"),
      downloadButton("download_anova_example", "Download Example Data", style = "color: #FFFFFF; background-color: #28A745; border-color: #28A745;margin-bottom: 10px;"),
      p("The example dataset includes:170 genotypes, 3 replications for each genotype and 6 traits", style = "color: red;font-weight: bold;font-size: 14px;"),
      h3("Download Results", style = "font-weight: bold"),
      downloadButton("download_anova", "ANOVA Table (CSV)", style = "color: #00008B; font-weight: bold;margin-bottom: 15px; "),
      # Feedback message
      p("For feedback, queries or suggestions,   email:  tbacafri@gmail.com",style = "color: darkgreen; font-weight: bold; font-size: 14px; width: 100%; white-space: normal;")
    ),
    mainPanel(

      uiOutput("anovaTitle"),
      # Wrap tableOutput in a div with CSS for vertical scrolling
      div(style = "overflow-y: auto;overflow-x: auto; height: 200px;",  # Adjust height as needed
          tableOutput("anovaTable")
      ),

      uiOutput("annotations_anova")
    )
  )
)


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

  ######## ANOVA analysis logic  #########
  ## Download example data
  output$download_anova_example <- downloadHandler(
    filename = function() {
      "ANOVA_Data.xlsx"  # Desired file name when the user downloads it
    },
    content = function(file) {
      # Use system.file to get the path of the example data within the installed package
      example_path <- system.file("ANOVA", "example_ANOVA_data.xlsx", package = "TBA")

      # Copy the file from the package to the user's local machine
      file.copy(example_path, file)
    }
  )


  anova_results <- reactiveVal()

  analyzeANOVA <- function(file) {
    req(file)
    data <- readxl::read_excel(file$datapath)
    res <- ANOVA_table(data)
    anova_results(res)
    return(res)
  }

  # Reset previous outputs when a new file is uploaded
  observeEvent(input$file2, {
    anova_results(NULL)  # Clear the analysis results
    output$anovaTable <- renderUI(NULL)  # Clear correlation table output
    output$annotations_anova <- renderUI(NULL)     # Clear annotations
    output$anovaTitle <- renderUI(NULL)   # Clear titles
  })

  observeEvent(input$analyze_anova, {

    show_modal_spinner(
      spin = "circle",
      color = "#007BFF",
      text = "Analyzing, please wait..."   # (Optional text under spinner)
    )

    res <- analyzeANOVA(input$file2)

    remove_modal_spinner()

    output$anovaTable <- renderTable({
      if (!is.null(anova_results())) {
        anova_results()
      }
    }, rownames = FALSE)
    output$annotations_anova <- renderUI({
      if (!is.null(anova_results())) {
        tagList(
          p("Note: The ANOVA Table displays Mean Sum of Square Values for each trait, following the Degrees of Freedom (Df) column."),
          p(tags$b(tags$span("NS: Non-significant", style = "font-size: 18px;"))),
          p(tags$b(tags$span("*: Significant at 5% (p<0.05)", style = "font-size: 18px;"))),

        )
      }
    })
    output$anovaTitle <- renderUI({
      tagList(
        h3("Analysis of Variance (ANOVA)  Results", style = "color: purple; font-weight: bold;")
      )
    })
  })

  output$download_anova <- downloadHandler(
    filename = function() {
      paste("anova_table", Sys.Date(), ".csv", sep = "")
    },
    content = function(file) {
      write.csv(anova_results(), file, row.names = FALSE)
    }
  )

}
shinyApp(ui, server)