inst/shinyapp/app.R

suppressPackageStartupMessages({
  library(shiny)
  library(DT)
  library(shinybusy)
  library(dplyr)
  library(emmeans)
  library(car)
})



ui <- fluidPage(

  tags$style(HTML("

.nav-tabs > li > a {
  background-color: #f5f5f5;
  color: #2c3e50;
  font-weight: bold;
  border-radius: 10px;
  margin-right: 10px;
  margin-bottom: 10px;
  padding: 12px 18px;
}

.nav-tabs > li.active > a,
.nav-tabs > li.active > a:hover,
.nav-tabs > li.active > a:focus {
  background-color: #3498db !important;
  color: white !important;
}

.nav-tabs > li > a:hover {
  background-color: #85c1e9;
}

")),

  title = "Augmented Pooled RCBD Analysis",
  div(
    style = "
    background-color:#5B2C6F;
    color:white;
    padding:15px;
    border-radius:15px;
    text-align:center;
    margin-top:15px;
    margin-bottom:20px;
  ",

    h1(
      "Augmented Pooled RCBD Analysis",
      style = "margin:0;"
    )
  ),

  br(),

  sidebarLayout(

    sidebarPanel(
      style = "background-color: #EEF5FC; padding: 15px; border-radius: 10px;",
      fileInput("file", "Upload Data (CSV) File"),

      downloadButton(
        "download_sample",
        "Download Sample Data",
        class = "btn-primary"
      ),

      br(),
      br(),

      selectInput("trait", "Select Trait/Character/Variable Column", choices = NULL),
      selectInput("env", "Select Environment Column", choices = NULL),
      selectInput("blk", "Select Block Column", choices = NULL),
      selectInput("trt", "Select Treatment/Genotype/Entry Column", choices = NULL),


      textInput(
        "checks",
        "Checks/Controls (comma separated)[Example: 1,2,3,4,5]",
        value = ""
      ),




      tags$span(
        HTML("Significance Level (&alpha;) = 0.05"),
        style = "font-weight:bold; color:black;"
      ),

      br(),
      br(),
      actionButton("run", "Run Analysis",class = "btn-success",
                   style = "font-weight:bold;",
                   width = "100%")
    ),

    mainPanel(
      uiOutput("all_tabs")
    )
  )
)

server <- function(input, output, session){
  output$download_sample <- downloadHandler(

    filename = function() {
      "Sample_Data.csv"
    },

    content = function(file) {

      sample_file <- system.file(
        "shinyapp",
        "sample_data.csv",
        package = "AugmentedPooledRCBD"
      )

      file.copy(
        sample_file,
        file
      )

    }
  )
  results <- reactiveVal(NULL)

  #  Read data reactively
  data <- reactive({
    req(input$file)
    read.csv(input$file$datapath)
  })

  # Update dropdowns AFTER file upload
  observe({
    req(data())

    cols <- names(data())

    updateSelectInput(session, "trait", choices = cols, selected = "")
    updateSelectInput(session, "env", choices = cols, selected = "")
    updateSelectInput(session, "blk", choices = cols, selected = "")
    updateSelectInput(session, "trt", choices = cols, selected = "")
  })

  observeEvent(input$run, {
    show_modal_spinner(
      spin = "circle",
      color = "#007BFF",
      text = "Running analysis, please wait..."   # (Optional text under spinner)
    )
    req(data())

    checks <- unlist(strsplit(input$checks, ","))

    res <- AugmentedPooledRCBD:::augmented_pooled_analysis(
      data = data(),
      trait = input$trait,
      checks = checks,
      env = input$env,
      blk = input$blk,
      trt = input$trt
    )
    results(res)
    remove_modal_spinner()
  })

  output$all_tabs <- renderUI({

    req(results())
    res <- results()

    tabsetPanel(

      # 1. Descriptive Statistics
      tabPanel("Descriptive Statistics",
               br(),
               uiOutput("desc")),

      # 2. Season-wise Results
      tabPanel("Environment-wise Results",
               br(),
               uiOutput("season_tabs")),

      # 3. Variance + Decision
      tabPanel("Variance Test",
               br(),
               uiOutput("var"),
      ),

      # 4. Transformed Data
      tabPanel("Transformed Data",
               br(),
               uiOutput("tdata")),

      # 5. Transformed Means
      tabPanel("Pooled Adjusted Means Across Environments",
               br(),
               uiOutput("tmeans")),


      # 6. Pooled Results
      tabPanel(
        "Pooled Results",

        br(),

        h4(paste("Pooled Analysis Results")),

        hr(),

        tabsetPanel(

          ####################################################
          # ANOVA
          ####################################################
          tabPanel(
            "ANOVA",

            br(),

            DTOutput("p_anova"),

            br(),

            downloadButton(
              "download_p_anova",
              "Download ANOVA",
              class = "btn-success",
              style = "font-weight:bold;"
            )
          ),

          ####################################################
          # Means
          ####################################################

          tabPanel(
            " Adjusted Means",

            br(),

            DTOutput("p_means"),

            br(),

            downloadButton(
              "download_p_means",
              "Download Adjusted Means",
              class = "btn-success",
              style = "font-weight:bold;"
            )
          ),


          ####################################################
          # Partition
          ####################################################

          tabPanel(
            "Treatment Partition",

            br(),

            DTOutput("p_partition"),

            br(),

            downloadButton(
              "download_p_partition",
              "Download Partition",
              class = "btn-success",
              style = "font-weight:bold;"
            )
          ),

          ####################################################
          # SEM, CD & CV"
          ####################################################
          tabPanel(
            "SEM, CD & CV",

            br(),

            DTOutput("p_precision"),

            br(),

            downloadButton(
              "download_p_precision",
              "Download SEM, CD & CV",
              class = "btn-success",
              style = "font-weight:bold;"
            )
          ),

          ####################################################
          # Ranking
          ####################################################

          tabPanel(
            "Ranking of Treatments",

            br(),

            DTOutput("p_rank"),

            br(),
            tags$div(
              style = "background-color:#f8f9fa; padding:10px; border-radius:5px;",
              tags$b("Interpretation: "),
              "Treatment comparisons and classifications are performed relative to the best check using test-versus-check CD at 5% significance level."
            ),

            br(),

            downloadButton(
              "download_p_rank",
              "Download Ranking",
              class = "btn-success",
              style = "font-weight:bold;"
            )
          )

        )
      )

    )
  })

  ### Rendering outputs

  ###Descriptive Statistics

  output$desc <- renderUI({
    req(results())

    tagList(

      DT::DTOutput("desc_table"),

      br(),

      downloadButton(
        "download_desc",
        "Download Descriptive Statistics",
        class = "btn-success",
        style = "font-weight:bold;"
      )
    )
  })

  output$desc_table <- DT::renderDT({

    desc <- results()$Descriptive
    # rename first column for display
    names(desc)[1] <- input$env

    datatable(
      desc,
      rownames = FALSE,
      options = list(
        ordering = FALSE,
        searching = FALSE,
        paging = FALSE,
        info = FALSE
      )
    ) %>%
      formatRound(
        columns = c("Mean", "SD"),
        digits = 4
      )
  })

  output$download_desc <- downloadHandler(

    filename = function() {
      "Descriptive_Statistics.csv"
    },

    content = function(file) {

      desc <- results()$Descriptive

      names(desc)[1] <- input$env

      desc[, c("Mean", "SD")] <- round(
        desc[, c("Mean", "SD")],
        4
      )

      write.csv(
        desc,
        file,
        row.names = FALSE
      )
    }
  )


  ###Variance and Decision

  output$var <- renderUI({

    req(results())

    tagList(

      DT::DTOutput("var_table"),

      br(),

      tableOutput("decision"),

      br(),

      downloadButton(
        "download_var",
        "Download Variance Test Results",
        class = "btn-success",
        style = "font-weight:bold;"
      )
    )
  })


  output$var_table <- DT::renderDT({

    datatable(
      results()$Variance,
      rownames = FALSE,
      options = list(
        ordering = FALSE,
        searching = FALSE,
        paging = FALSE,
        info = FALSE
      )
    )%>%
      formatRound(
        columns = c("Statistic", "p_value"),
        digits = 4
      )
  })

  output$decision <- renderTable({

    data.frame(
      Decision = results()$Decision
    )
  })

  output$download_var <- downloadHandler(

    filename = function() {
      "Variance_Test_Results.csv"
    },

    content = function(file) {

      var_df <- results()$Variance

      var_df[, c("Statistic", "p_value")] <- round(
        var_df[, c("Statistic", "p_value")],
        4
      )

      write.csv(
        var_df,
        file,
        row.names = FALSE
      )
    }
  )


  ### Transformed data

  output$tdata <- renderUI({

    req(results())

    td <- results()$Transformed_Data

    if(is.null(td)){
      return(h4("No transformation required"))
    }

    tagList(

      DT::DTOutput("tdata_table"),

      br(),

      downloadButton(
        "download_tdata",
        "Download Transformed Data",
        class = "btn-success",
        style = "font-weight:bold;"
      )
    )
  })

  output$tdata_table <- DT::renderDT({

    td <- results()$Transformed_Data

    names(td)[1] <- input$env
    names(td)[2] <- input$blk
    names(td)[3] <- input$trt
    names(td)[4] <- paste0("Transformed_", input$trait)
    datatable(
      td,
      rownames = FALSE,
      options = list(pageLength = 10,
                     scrollX = TRUE,
                     ordering = FALSE,
                     searching = FALSE)
    )%>%
      formatRound(
        columns = 4,
        digits = 4
      )
  })

  output$download_tdata <- downloadHandler(

    filename = function() {
      "Transformed_Data.csv"
    },

    content = function(file) {

      td <- results()$Transformed_Data

      names(td)[1] <- input$env
      names(td)[2] <- input$blk
      names(td)[3] <- input$trt
      names(td)[4] <- paste0("Transformed_", input$trait)

      td[[4]] <- round(td[[4]], 4)

      write.csv(
        td,
        file,
        row.names = FALSE
      )
    }
  )


  ### Pooled Adjusted Means Across Environments


  get_pooled_adjusted_means <- function() {

    req(results())

    if (identical(
      results()$Decision,
      "Variances homogeneous"
    )) {

      return(results()$Pooled_Means)

    } else {

      return(results()$Transformed_Means)

    }
  }


  output$tmeans <- renderUI({

    req(results())

    tm <- get_pooled_adjusted_means()

    if (is.null(tm)) {

      return(
        h4("Adjusted means are not available.")
      )

    }

    tagList(

      DT::DTOutput("tmeans_table"),

      br(),

      tags$div(
        style = "background-color:#f8f9fa; padding:10px; border-radius:5px;",

        tags$b("Description: "),

        if (
          identical(
            results()$Decision,
            "Variances homogeneous"
          )
        ) {

          "Pooled adjusted means across environments based on the homogeneous-variance analysis."

        } else {

          "Pooled adjusted means across environments based on the heterogeneity-adjusted (transformed) analysis."

        }
      ),

      br(),

      downloadButton(
        "download_tmeans",
        "Download Adjusted Means Across Environments",
        class = "btn-success",
        style = "font-weight:bold;"
      )
    )
  })


  output$tmeans_table <- DT::renderDT({

    tm <- get_pooled_adjusted_means()

    req(tm)

    names(tm)[1] <- input$trt
    names(tm)[2] <- "Adjusted Mean"
    names(tm)[7] <- "Treatment Type"

    tm[, 7] <- dplyr::recode(
      tm[, 7],
      "control" = "Check",
      "treatment" = "Test"
    )

    datatable(
      tm,
      rownames = FALSE,
      options = list(
        pageLength = 10,
        scrollX = TRUE,
        ordering = FALSE,
        searching = FALSE
      )
    ) %>%
      formatRound(
        columns = c(2, 3, 5, 6),
        digits = 4
      )
  })


  output$download_tmeans <- downloadHandler(

    filename = function() {

      if (
        identical(
          results()$Decision,
          "Variances homogeneous"
        )
      ) {

        "Pooled_Adjusted_Means_Homogeneous.csv"

      } else {

        "Pooled_Adjusted_Means_Transformed.csv"

      }
    },

    content = function(file) {

      tm <- get_pooled_adjusted_means()

      req(tm)

      names(tm)[1] <- input$trt
      names(tm)[2] <- "Adjusted Mean"
      names(tm)[7] <- "Treatment Type"

      # Rename control/treatment
      tm[, 7] <- dplyr::recode(
        tm[, 7],
        "control" = "Check",
        "treatment" = "Test"
      )

      # Round numerical columns by position
      tm[, c(2, 3, 5, 6)] <- round(
        tm[, c(2, 3, 5, 6)],
        4
      )


      write.csv(
        tm,
        file,
        row.names = FALSE
      )
    }
  )


  ### Season wise outputs

  output$season_tabs <- renderUI({

    req(results())


    # detect seasons automatically
    season_names <- unique(as.character(data()[[input$env]]))

    tabs <- lapply(season_names, function(s){

      tabPanel(
        s,

        br(),

        h4(paste("Results for", s)),

        hr(),

        tabsetPanel(
          #========================
          # ANOVA
          #========================

          tabPanel("ANOVA",
                   br(),

                   DTOutput(paste0("anova_", s)),

                   br(),
                   downloadButton(
                     outputId = paste0("download_anova_", s),
                     label = "Download ANOVA",
                     class = "btn-success",
                     style = "font-weight:bold;"
                   )
          ),
          #========================
          # Means
          #========================

          tabPanel("Adjusted Means",

                   br(),

                   DTOutput(paste0("means_", s)),

                   br(),

                   downloadButton(
                     outputId = paste0("download_means_", s),
                     label = "Download Adjusted Means",
                     class = "btn-success",
                     style = "font-weight:bold;"
                   )
          ),

          #========================
          # Partition
          #========================

          tabPanel("Treatment Partition",

                   br(),

                   DTOutput(paste0("partition_", s)),

                   br(),

                   downloadButton(
                     outputId = paste0("download_partition_", s),
                     label = "Download Partition",
                     class = "btn-success",
                     style = "font-weight:bold;"
                   )
          ),

          #========================
          # CD
          #========================
          #========================
          # SEM, CD & CV
          #========================
          tabPanel("SEM, CD & CV",

                   br(),

                   DTOutput(paste0("precision_", s)),

                   br(),

                   downloadButton(
                     outputId = paste0("download_precision_", s),
                     label = "Download SEM, CD & CV",
                     class = "btn-success",
                     style = "font-weight:bold;"
                   )
          ),

          #========================
          # Ranking
          #========================
          tabPanel("Treatment Ranking",

                   br(),

                   DTOutput(paste0("rank_", s)),

                   br(),

                   tags$div(
                     style = "background-color:#f8f9fa; padding:10px; border-radius:5px;",
                     tags$b("Interpretation: "),
                     "Treatment comparisons and classifications are performed relative to the best check using test-versus-check CD at 5% significance level."
                   ),
                   br(),
                   downloadButton(
                     outputId = paste0("download_rank_", s),
                     label = "Download Ranking",
                     class = "btn-success",
                     style = "font-weight:bold;"
                   )
          )
        )
      )
    })

    do.call(tabsetPanel, tabs)
  })


  ############################################################
  # Dynamic rendering + download handlers
  ############################################################

  observe({

    req(results(), data(), input$env)

    res <- results()

    # get seasons from data (clean approach)
    season_names <- unique(as.character(data()[[input$env]]))

    for(s in season_names){

      local({
        ss <- s

        ########################################################
        # ANOVA
        ########################################################

        output[[paste0("anova_", ss)]] <- renderDT({

          df <- res[[paste0("ANOVA_", ss)]]




          df <- df[df$Type == "Type III",
                   c("Source", "Df", "SumSq", "MeanSq", "Fvalue", "p_value")]
          df$Source[df$Source == "blk"] <- input$blk
          df$Source[df$Source == "trt"] <- input$trt

          datatable(
            df,
            rownames = FALSE,
            options = list(
              ordering = FALSE,
              searching = FALSE,
              paging = FALSE,
              info = FALSE,
              scrollX = TRUE
            )
          )%>%
            formatRound(
              columns = c("SumSq", "MeanSq", "Fvalue", "p_value"),
              digits = 4
            )
        })

        output[[paste0("download_anova_", ss)]] <- downloadHandler(

          filename = function() {
            paste0("ANOVA_", ss, ".csv")
          },

          content = function(file) {

            df <- res[[paste0("ANOVA_", ss)]]




            df <- df[df$Type == "Type III",
                     c("Source", "Df", "SumSq", "MeanSq", "Fvalue", "p_value")]
            df$Source[df$Source == "blk"] <- input$blk
            df$Source[df$Source == "trt"] <- input$trt

            df[, c("SumSq", "MeanSq", "Fvalue", "p_value")] <- round(
              df[, c("SumSq", "MeanSq", "Fvalue", "p_value")],
              4
            )

            write.csv(
              df,
              file,
              row.names = FALSE
            )
          }
        )


        ########################################################
        # Means
        ########################################################

        output[[paste0("means_", ss)]] <- renderDT({

          df <- res[[paste0("Means_", ss)]]

          names(df)[1] <- input$trt
          names(df)[2] <- "Adjusted Mean"
          names(df)[7] <- "Treatment Type"

          # Rename control/treatment
          df[, 7] <- dplyr::recode(
            df[, 7],
            "control" = "Check",
            "treatment" = "Test"
          )

          datatable(
            df,
            rownames = FALSE,
            options = list(
              pageLength = 10,
              ordering = FALSE,
              searching = FALSE,
              scrollX = TRUE
            )
          ) %>%
            formatRound(
              columns = c(2, 3, 5, 6),
              digits = 4
            )
        })

        output[[paste0("download_means_", ss)]] <- downloadHandler(

          filename = function() {
            paste0("Means_", ss, ".csv")
          },

          content = function(file) {

            df <- res[[paste0("Means_", ss)]]

            names(df)[1] <- input$trt
            names(df)[2] <- "Adjusted Mean"
            names(df)[7] <- "Treatment Type"

            df[, 7] <- dplyr::recode(
              df[, 7],
              "control" = "Check",
              "treatment" = "Test"
            )

            df[, c(2, 3, 5, 6)] <- round(
              df[, c(2, 3, 5, 6)],
              4
            )

            write.csv(
              df,
              file,
              row.names = FALSE
            )
          }
        )

        ########################################################
        # Partition
        ########################################################

        output[[paste0("partition_", ss)]] <- renderDT({

          datatable(
            res[[paste0("Partition_", ss)]],
            rownames = FALSE,
            options = list(
              ordering = FALSE,
              searching = FALSE,
              paging = FALSE,
              info = FALSE,
              scrollX = TRUE
            )
          )%>%
            formatRound(
              columns = c("SumSq", "MeanSq", "Fvalue", "p_value"),
              digits = 4
            )
        })

        output[[paste0("download_partition_", ss)]] <- downloadHandler(

          filename = function() {
            paste0("Partition_", ss, ".csv")
          },

          content = function(file) {

            df <- res[[paste0("Partition_", ss)]]

            df[, c("SumSq", "MeanSq", "Fvalue", "p_value")] <- round(
              df[, c("SumSq", "MeanSq", "Fvalue", "p_value")],
              4
            )

            write.csv(
              df,
              file,
              row.names = FALSE
            )
          }
        )



        ########################################################
        # SEM, CD & CV
        ########################################################

        output[[paste0("precision_", ss)]] <- renderDT({

          precision_df <- res[[paste0("Precision_", ss)]]

          req(precision_df)

          datatable(
            precision_df,
            rownames = FALSE,
            options = list(
              ordering = FALSE,
              searching = FALSE,
              paging = FALSE,
              info = FALSE,
              scrollX = TRUE
            )
          ) %>%
            formatRound(
              columns = "Value",
              digits = 4
            )
        })


        output[[paste0("download_precision_", ss)]] <- downloadHandler(

          filename = function() {
            paste0("SEM_CD_CV_", ss, ".csv")
          },

          content = function(file) {

            precision_df <- res[[paste0("Precision_", ss)]]

            precision_df$Value <- round(
              precision_df$Value,
              4
            )

            write.csv(
              precision_df,
              file,
              row.names = FALSE
            )
          }
        )
        ########################################################
        # Ranking
        ########################################################
        output[[paste0("rank_", ss)]] <- renderDT({

          df <- res[[paste0("Ranking_", ss)]]

          names(df)[2] <- input$trt
          names(df)[3] <- "Adjusted Mean"
          names(df)[8] <- "Treatment Type"

          # Rename control/treatment
          df[, 8] <- dplyr::recode(
            df[, 8],
            "control" = "Check",
            "treatment" = "Test"
          )

          datatable(df,rownames = FALSE,
                    options = list(pageLength = 10,
                                   scrollX = TRUE,
                                   ordering = FALSE,
                                   searching = FALSE)) %>%
            formatRound(
              columns = c(3, 4, 6, 7),
              digits = 4
            )
        })


        output[[paste0("download_rank_", ss)]] <- downloadHandler(

          filename = function() {
            paste0("Ranking_", ss, ".csv")
          },

          content = function(file) {

            df <- res[[paste0("Ranking_", ss)]]
            names(df)[2] <- input$trt
            names(df)[3] <- "Adjusted Mean"
            names(df)[8] <- "Treatment Type"

            # Rename control/treatment
            df[, 8] <- dplyr::recode(
              df[, 8],
              "control" = "Check",
              "treatment" = "Test"
            )

            df[, c(3, 4, 6, 7)] <- round(
              df[, c(3, 4, 6, 7)],
              4
            )

            write.csv(
              df,
              file,
              row.names = FALSE
            )
          }
        )


      })
    }
  })


  ### Pooled outputs

  ########################################################
  # Pooled ANOVA
  ########################################################

  output$p_anova <- renderDT({

    df <- results()$Pooled_ANOVA


    df <- df[df$Type == "Type III",
             c("Source", "Df", "SumSq", "MeanSq", "Fvalue", "p_value")]

    df$Source[df$Source == "env"] <- input$env
    df$Source[df$Source == "trt"] <- input$trt
    df$Source[df$Source == "env:blk"] <- paste(input$env, input$blk, sep=":")
    df$Source[df$Source == "env:trt"] <- paste(input$env, input$trt, sep=":")

    datatable(
      df,
      rownames = FALSE,
      options = list(
        ordering = FALSE,
        searching = FALSE,
        paging = FALSE,
        info = FALSE,
        scrollX = TRUE
      )
    ) %>%
      formatRound(
        columns = c("SumSq", "MeanSq", "Fvalue", "p_value"),
        digits = 4
      )
  })

  output$download_p_anova <- downloadHandler(

    filename = function() {
      "Pooled_ANOVA.csv"
    },

    content = function(file) {

      df <- results()$Pooled_ANOVA


      df <- df[df$Type == "Type III",
               c("Source", "Df", "SumSq", "MeanSq", "Fvalue", "p_value")]

      df$Source[df$Source == "env"] <- input$env
      df$Source[df$Source == "trt"] <- input$trt
      df$Source[df$Source == "env:blk"] <- paste(input$env, input$blk, sep=":")
      df$Source[df$Source == "env:trt"] <- paste(input$env, input$trt, sep=":")

      df[, c("SumSq", "MeanSq", "Fvalue", "p_value")] <- round(
        df[, c("SumSq", "MeanSq", "Fvalue", "p_value")],
        4
      )

      write.csv(
        df,
        file,
        row.names = FALSE
      )
    }
  )

  ########################################################
  # Pooled Means
  ########################################################
  output$p_means <- renderDT({

    df <- results()$Pooled_Means

    names(df)[1] <- input$trt
    names(df)[2] <- "Adjusted Mean"
    names(df)[7] <- "Treatment Type"

    # Rename control/treatment
    df[, 7] <- dplyr::recode(
      df[, 7],
      "control" = "Check",
      "treatment" = "Test"
    )

    datatable(
      df,
      rownames = FALSE,
      options = list(
        pageLength = 10,
        scrollX = TRUE,
        ordering = FALSE,
        searching = FALSE
      )
    ) %>%
      formatRound(
        columns = c(2, 3, 5, 6),
        digits = 4
      )
  })

  output$download_p_means <- downloadHandler(

    filename = function() {
      "Pooled_Means.csv"
    },

    content = function(file) {

      df <- results()$Pooled_Means


      names(df)[1] <- input$trt
      names(df)[2] <- "Adjusted Mean"
      names(df)[7] <- "Treatment Type"

      # Rename control/treatment
      df[, 7] <- dplyr::recode(
        df[, 7],
        "control" = "Check",
        "treatment" = "Test"
      )

      df[, c(2, 3, 5, 6)] <- round(
        df[, c(2, 3, 5, 6)],
        4
      )

      write.csv(
        df,
        file,
        row.names = FALSE
      )
    }
  )

  ########################################################
  # Pooled Partition
  ########################################################

  output$p_partition <- renderDT({

    datatable(
      results()$Pooled_Partition,
      rownames = FALSE,
      options = list(
        ordering = FALSE,
        searching = FALSE,
        paging = FALSE,
        info = FALSE,
        scrollX = TRUE
      )
    ) %>%
      formatRound(
        columns = c("SumSq", "MeanSq", "Fvalue", "p_value"),
        digits = 4
      )
  })

  output$download_p_partition <- downloadHandler(

    filename = function() {
      "Pooled_Partition.csv"
    },

    content = function(file) {

      df <- results()$Pooled_Partition

      df[, c("SumSq", "MeanSq", "Fvalue", "p_value")] <- round(
        df[, c("SumSq", "MeanSq", "Fvalue", "p_value")],
        4
      )

      write.csv(
        df,
        file,
        row.names = FALSE
      )
    }
  )


  ########################################################
  # Pooled SEM, CD & CV
  ########################################################

  output$p_precision <- renderDT({

    precision_df <- results()$Pooled_Precision

    req(precision_df)

    datatable(
      precision_df,
      rownames = FALSE,
      options = list(
        ordering = FALSE,
        searching = FALSE,
        paging = FALSE,
        info = FALSE,
        scrollX = TRUE
      )
    ) %>%
      formatRound(
        columns = "Value",
        digits = 4
      )
  })

  output$download_p_precision <- downloadHandler(

    filename = function() {
      "Pooled_SEM_CD_CV.csv"
    },

    content = function(file) {

      precision_df <- results()$Pooled_Precision

      precision_df$Value <- round(
        precision_df$Value,
        4
      )

      write.csv(
        precision_df,
        file,
        row.names = FALSE
      )
    }
  )

  ########################################################
  # Pooled Ranking
  ########################################################
  output$p_rank <- renderDT({

    df <- results()$Pooled_Ranking

    names(df)[2] <- input$trt
    names(df)[3] <- "Adjusted Mean"
    names(df)[8] <- "Treatment Type"

    # Rename control/treatment
    df[, 8] <- dplyr::recode(
      df[, 8],
      "control" = "Check",
      "treatment" = "Test"
    )
    datatable(
      df,
      rownames = FALSE,
      options = list(
        pageLength = 10,
        scrollX = TRUE,
        ordering = FALSE,
        searching = FALSE
      )
    ) %>%
      formatRound(
        columns = c(3, 4, 6, 7),
        digits = 4
      )
  })
  output$download_p_rank <- downloadHandler(

    filename = function() {
      "Pooled_Ranking.csv"
    },

    content = function(file) {

      df <- results()$Pooled_Ranking

      names(df)[2] <- input$trt
      names(df)[3] <- "Adjusted Mean"
      names(df)[8] <- "Treatment Type"

      # Rename control/treatment
      df[, 8] <- dplyr::recode(
        df[, 8],
        "control" = "Check",
        "treatment" = "Test"
      )

      df[, c(3, 4, 6, 7)] <- round(
        df[, c(3, 4, 6, 7)],
        4
      )

      write.csv(
        df,
        file,
        row.names = FALSE
      )
    }
  )

}

shinyApp(ui, server)

Try the AugmentedPooledRCBD package in your browser

Any scripts or data that you put into this service are public.

AugmentedPooledRCBD documentation built on Sept. 5, 2026, 1:07 a.m.