In pratheesh3780/grapesAgri1: Collection of Shiny Apps for Agricultural Research Data Analysis

knitr::opts_chunk$set(echo = FALSE)
library(knitr)
library(Hmisc)
library(agricolae)
library(dplyr)
library(magrittr)
library(kableExtra)
library(gtools)

RESULT

CRD ANALYSIS

csvfile <- reactive({
  csvfile <- input$file1
  if (is.null(csvfile)) {
    return(NULL)
  }
  dt <- read.csv(csvfile$datapath, header = input$header, sep = ",", check.names = FALSE)
  dt
})
################################ trt means
if (input$submit > 0) {
  input$reload
  Sys.sleep(2)
  d <- as.data.frame(csvfile())
  t <- as.numeric(input$trt)
  response <- d[, input$yield]
  treatment <- d[, input$treatment]
  treatment <- factor(treatment)
  anvaTable <- lm(response ~ treatment)
  result <- as.data.frame(anova(anvaTable))
  out <- LSD.test(csvfile()[, input$yield], csvfile()[, input$treatment], result[2, 1], result[2, 3])
  trtmeans <- out$means
  trtmeans <- trtmeans[ gtools::mixedsort(row.names(trtmeans)), ]
  colnames(trtmeans)[1] <- "Treatment_means"
  drops <- c("r", "Q25", "Q50", "Q75","se")
  result <- trtmeans[, !(names(trtmeans) %in% drops)]
  kable(result, digits = 3, caption = "Treatment mean and other statistics", align = "c", row.names = TRUE) %>% kable_styling() %>% kable_paper("hover", full_width = F)
}
################ finish
tags$br()
################################ ANOVA TABLE
if (input$submit > 0) {
  d <- as.data.frame(csvfile())
  t <- as.numeric(input$trt)
  response <- d[, input$yield]
  treatment <- d[, input$treatment]
  treatment <- factor(treatment)
  anvaTable <- lm(response ~ treatment)
  result <- as.data.frame(anova(anvaTable))
  SoV <- c("Treatment", "Error")
  final <- cbind(SoV, result)
  kable(final, digits = 3, caption = "ANOVA TABLE", align = "c", row.names = FALSE) %>% kable_styling() %>% kable_paper("hover", full_width = F)
}
############################# finish
tags$br()
###################### SEM
if (input$submit > 0) {
  if (input$filerepli == "equal") {
    d <- as.data.frame(csvfile())
    t <- as.numeric(input$trt)
    response <- d[, input$yield]
    treatment <- d[, input$treatment]
    treatment <- factor(treatment)
    anvaTable <- lm(response ~ treatment)
    result <- as.data.frame(anova(anvaTable))
    out <- LSD.test(csvfile()[, input$yield], csvfile()[, input$treatment], result[2, 1], result[2, 3])
    colnam <- c("MSE", "SE(d)", "SE(m)", "CV(%)")
    stat <- out$statistics
    repl <- out$means
    r <- repl[1, 3]
    MSE <- stat[1, 1]
    SED <- sqrt((2 * MSE) / r)
    SEM <- sqrt(MSE / r)
    CV <- stat[1, 4]
    Result <- cbind(MSE, SED, SEM, CV)
    colnames(Result) <- colnam
    kable(Result, digits = 3, caption = "Other important Statistics", align = "c", row.names = FALSE) %>% kable_styling() %>% kable_paper("hover", full_width = F)
  }
}
#################################### finish
tags$br()
########################### TEXT INFERENCE
if (input$submit > 0) {
  d <- as.data.frame(csvfile())
  t <- as.numeric(input$trt)
  response <- d[, input$yield]
  treatment <- d[, input$treatment]
  treatment <- factor(treatment)
  anvaTable <- lm(response ~ treatment)
  result <- as.data.frame(anova(anvaTable))
  if (result[1, 5] <= 0.05) {
    cat("Since the P-value in ANOVA table is < 0.05,\nthere is a significant difference between atleast a pair of treatments,\nso multiple comparison is required to identify best treatment(s)")
  }
  if (result[1, 5] > 0.05) {
    cat("Treatment means are not significantly different")
  }
}
#########################
tags$br()
################################### Multi
if (input$submit > 0) {
  if (input$filerepli == "equal") {
    d <- as.data.frame(csvfile())
    t <- as.numeric(input$trt)
    response <- d[, input$yield]
    treatment <- d[, input$treatment]
    treatment <- factor(treatment)
    anvaTable <- lm(response ~ treatment)
    result <- as.data.frame(anova(anvaTable))
    if (result[1, 5] > 0.05) {
      return("Multiple comparison test is not performed")
    }

    else if (input$req == "lsd") {
      d <- as.data.frame(csvfile())
      t <- as.numeric(input$trt)
      response <- d[, input$yield]
      treatment <- d[, input$treatment]
      treatment <- factor(treatment)
      anvaTable <- lm(response ~ treatment)
      result <- as.data.frame(anova(anvaTable))
      out <- LSD.test(d[, input$yield], d[, input$treatment], result[2, 1], result[2, 3])
      result1 <- out$statistics
      kable(result1, caption = "LSD test", digits = 3, align = "c") %>% kable_styling() %>% kable_paper("hover", full_width = F)
    }


    else if (input$req == "dmrt") {
      d <- as.data.frame(csvfile())
      t <- as.numeric(input$trt)
      response <- d[, input$yield]
      treatment <- d[, input$treatment]
      treatment <- factor(treatment)
      anvaTable <- lm(response ~ treatment)
      result <- as.data.frame(anova(anvaTable))
      out <- duncan.test(d[, input$yield], d[, input$treatment], result[2, 1], result[2, 3], alpha = 0.05, group = TRUE, main = NULL, console = FALSE)
      result1 <- out$duncan
      kable(result1, caption = "DMRT", digits = 3, align = "c", row.names = FALSE) %>% kable_styling() %>% kable_paper("hover", full_width = F)
    }


    else if (input$req == "tukey") {
      d <- as.data.frame(csvfile())
      t <- as.numeric(input$trt)
      response <- d[, input$yield]
      treatment <- d[, input$treatment]
      treatment <- factor(treatment)
      anvaTable <- lm(response ~ treatment)
      result <- as.data.frame(anova(anvaTable))
      out <- HSD.test(d[, input$yield], d[, input$treatment], result[2, 1], result[2, 3], alpha = 0.05, group = TRUE, main = NULL, unbalanced = FALSE, console = FALSE)
      result1 <- out$statistics
      kable(result1, caption = "Tukey", digits = 3, align = "c") %>% kable_styling() %>% kable_paper("hover", full_width = F)
    }
  }
}
########################## finish
tags$br()
##################### CD matrix
if (input$submit > 0) {
  if (input$filerepli == "unequal") {
    d <- as.data.frame(csvfile())
    t <- as.numeric(input$trt)
    response <- d[, input$yield]
    treatment <- d[, input$treatment]
    treatment <- factor(treatment)
    anvaTable <- lm(response ~ treatment)
    result <- as.data.frame(anova(anvaTable))
    if (result[1, 5] > 0.05) {
      return("Multiple comparison test is not performed")
    }
    else if (input$req == "lsd") {
      d <- as.data.frame(csvfile())
      t <- as.numeric(input$trt)
      response <- d[, input$yield]
      treatment <- d[, input$treatment]
      treatment <- factor(treatment)
      anvaTable <- lm(response ~ treatment)
      result <- as.data.frame(anova(anvaTable))
      count <- table(d[, input$treatment]) # count the number of replications of treatment
      t <- (result[1, 1] + 1) # no.of treatments
      repli <- as.data.frame(count)
      reciproc <- 1 / repli[, 2] # 1/ri
      npw <- choose(t, 2) # number of pairwise combinations
      sumres <- as.vector(apply(combn(reciproc, 2), 2, sum)) # all pairwise sum of reciprocals (1/ri+1/rj)
      ems <- as.vector(replicate(npw, (result[2, 3])))
      SE_D <- sqrt((ems * sumres)) # standard error of difference
      tvalue <- qt(0.975, result[2, 1]) # tvalue
      vect <- replicate(npw, tvalue) # vector of t value
      CD <- vect * SE_D # critical difference
      means <- aggregate(response, list(treatment), mean)
      std <- aggregate(response, list(treatment), sd)
      finalmean <- cbind(means, std[, 2])
      rownames(finalmean) <- NULL
      colnam <- c("Treatment", "mean", "std")
      colnames(finalmean) <- colnam
      b <- matrix(0, t, t)
      b[upper.tri(b, diag = FALSE)] <- CD
      name <- finalmean$Treatment
      colnames(b) <- name
      row.names(b) <- name
      kable(b, caption = "LSD test Matrix of CD values", digits = 3, align = "c") %>% kable_styling() %>% kable_paper("hover", full_width = F)
    }
  }
}
###################
tags$br()
################################### group
if (input$submit > 0) {
  d <- as.data.frame(csvfile())
  t <- as.numeric(input$trt)
  response <- d[, input$yield]
  treatment <- d[, input$treatment]
  treatment <- factor(treatment)
  anvaTable <- lm(response ~ treatment)
  result <- as.data.frame(anova(anvaTable))
  if (result[1, 5] > 0.05) {
    return("")
  }

  else if (input$req == "lsd") {
    d <- as.data.frame(csvfile())
    t <- as.numeric(input$trt)
    response <- d[, input$yield]
    treatment <- d[, input$treatment]
    treatment <- factor(treatment)
    anvaTable <- lm(response ~ treatment)
    result <- as.data.frame(anova(anvaTable))
    out <- LSD.test(d[, input$yield], d[, input$treatment], result[2, 1], result[2, 3])
    outgroup <- out$groups
    colnames(outgroup) <- c("trt_mean", "grouping")
    kable(outgroup, caption = "Treatment Grouping", align = "c") %>% kable_styling() %>% kable_paper("hover", full_width = F)
  }

  else if (input$req == "dmrt") {
    d <- as.data.frame(csvfile())
    t <- as.numeric(input$trt)
    response <- d[, input$yield]
    treatment <- d[, input$treatment]
    treatment <- factor(treatment)
    anvaTable <- lm(response ~ treatment)
    result <- as.data.frame(anova(anvaTable))
    out <- duncan.test(d[, input$yield], d[, input$treatment], result[2, 1], result[2, 3], alpha = 0.05, group = TRUE, main = NULL, console = FALSE)
    outgroup <- out$groups
    colnames(outgroup) <- c("trt_mean", "grouping")
    kable(outgroup, caption = "Treatment Grouping", align = "c") %>% kable_styling() %>% kable_paper("hover", full_width = F)
  }

  else if (input$req == "tukey") {
    d <- as.data.frame(csvfile())
    t <- as.numeric(input$trt)
    response <- d[, input$yield]
    treatment <- d[, input$treatment]
    treatment <- factor(treatment)
    anvaTable <- lm(response ~ treatment)
    result <- as.data.frame(anova(anvaTable))
    out <- HSD.test(d[, input$yield], d[, input$treatment], result[2, 1], result[2, 3], alpha = 0.05, group = TRUE, main = NULL, unbalanced = FALSE, console = FALSE)
    outgroup <- out$groups
    colnames(outgroup) <- c("trt_mean", "grouping")
    outgroup
    kable(outgroup, caption = "Treatment Grouping", align = "c") %>% kable_styling() %>% kable_paper("hover", full_width = F)
  }
}
tags$br()
############
if (input$submit > 0) {
  d <- as.data.frame(csvfile())
  t <- as.numeric(input$trt)
  response <- d[, input$yield]
  treatment <- d[, input$treatment]
  treatment <- factor(treatment)
  anvaTable <- lm(response ~ treatment)
  result <- as.data.frame(anova(anvaTable))
  if (result[1, 5] > 0.05) {
    return("")
  }
  if (input$req == "tukey" || input$req == "dmrt" || input$req == "lsd") {
    cat("Treatments with same letters are not significantly different")
  }
}

tags$br()
tags$br()

report generated from: Package: grapesAgri1, Version 1.0.0

pratheesh3780/grapesAgri1 documentation built on Dec. 7, 2023, 5:49 a.m.