diff --git a/inst/hidap_agrofims/app.R b/inst/hidap_agrofims/app.R index 92b141a..ebe921a 100755 --- a/inst/hidap_agrofims/app.R +++ b/inst/hidap_agrofims/app.R @@ -134,12 +134,12 @@ ui <- dashboardPage( br(), - sidebarMenuOutput("menu") #menu is render in login.R when users logs in + sidebarMenuOutput("menu")#, #menu is render in login.R when users logs in # menuItem("Site information", tabName = "trialSite", icon = icon("map-marker")), # menuItem("Fieldbook", icon = icon("book"), # #menuSubItem("New fieldbook", tabName = "newFieldbook", icon = icon("file")), # menuSubItem("Create fieldbook", tabName = "newFieldbookAgrofims", icon = icon("file")), - # + # # menuSubItem("Open fieldbook", tabName = "openFieldbook", icon = icon("file-o")), # menuSubItem("Check fieldbook", tabName = "checkFieldbook", icon = icon("eraser"))#, # # menuSubItem("Data transformation", tabName = "singleAnalysisTrans", icon = icon("file-text-o")) @@ -161,22 +161,22 @@ ui <- dashboardPage( # #menuSubItem("Distribution Data", tabName = "distributionDB", icon = icon("database")) # ), # - # menuItem("Fieldbook management", - # #menuSubItem("New fieldbook", tabName = "newFieldbook", icon = icon("file")), - # menuSubItem("Create fieldbook", tabName = "newFieldbookAgrofims", icon = icon("file")), - # - # menuSubItem("Open fieldbook", tabName = "openFieldbook", icon = icon("file-o")), - # menuSubItem("Check fieldbook", tabName = "checkFieldbook", icon = icon("eraser"))#, - # # menuSubItem("Data transformation", tabName = "singleAnalysisTrans", icon = icon("file-text-o")) - # )#, - # - # # menuItem("Single Trial Analysis", - # # #menuSubItem("Single trial graph",tabName = "SingleChart", icon = icon("calculator")), - # # menuSubItem("Single report", tabName = "singleAnalysisReport", icon = icon("file-text-o")), - # # menuSubItem("Genetic report", tabName = "geneticAnalysisReport", icon = icon("file-text-o")) - # # - # # #menuSubItem("Data Transformation", tabName = "singleAnalysisTrans", icon = icon("file-text-o")) - # # ), + # menuItem("Fieldbook management", + # #menuSubItem("New fieldbook", tabName = "newFieldbook", icon = icon("file")), + # menuSubItem("Create fieldbook", tabName = "newFieldbookAgrofims", icon = icon("file")), + # + # menuSubItem("Open fieldbook", tabName = "openFieldbook", icon = icon("file-o")), + # menuSubItem("Check fieldbook", tabName = "checkFieldbook", icon = icon("eraser"))#, + # # menuSubItem("Data transformation", tabName = "singleAnalysisTrans", icon = icon("file-text-o")) + # ), + + # menuItem("Single Trial Analysis", + # #menuSubItem("Single trial graph",tabName = "SingleChart", icon = icon("calculator")), + # menuSubItem("Single report", tabName = "singleAnalysisReport", icon = icon("file-text-o"))#, + # #menuSubItem("Genetic report", tabName = "geneticAnalysisReport", icon = icon("file-text-o")) + # + # #menuSubItem("Data Transformation", tabName = "singleAnalysisTrans", icon = icon("file-text-o")) + # )#, # # # # menuItem("PVS Trial Analysis", # # menuSubItem("PVS report", tabName = "singlePVS", icon = icon("calculator"))#, @@ -214,7 +214,7 @@ ui <- dashboardPage( # # menuSubItem("Check updates", tabName = "updateHidap",icon = icon("refresh"))#, # ), # - # menuItem("About", tabName = "dashboard", icon = icon("dashboard"), selected = TRUE) + #menuItem("About", tabName = "dashboard", icon = icon("dashboard"), selected = TRUE) ) @@ -419,7 +419,7 @@ ui <- dashboardPage( br(), br(), - h2("HIDAP AgroFIMS v0.0.16"), + h2("HIDAP AgroFIMS v0.0.17"), p(class = "text-muted", style="text-align:justify", #paste("HiDAP is a Highly Interactive Data Analysis Platform originally meant to support clonal crop breeders at the International Potato Center. It is part of a continuous institutional effort to improve data collection, data quality, data analysis and open access publication. The recent iteration simultaneously also represents efforts to unify best practices from experiences in breeding data management of over 10 years, specifically with DataCollector and CloneSelector for potato and sweetpotato breeding, to address new demands for open access publishing and continue to improve integration with both corporate and community databases (such as biomart and sweetpotatobase) and platforms such as the Global Trial Data Management System (GTDMS) at CIP.
One of the main new characteristics of the current software development platform established over the last two years is the web-based interface which provides also a highly interactive environment. It could be used both online and offline and on desktop as well as tablets and laptops. Key features include support for data capture, creation of field books, upload field books from and to accudatalogger, data access from breeding databases (e.g., CIP BioMart, sweetpotatobase via breeding API), data quality checks, single and multi-environmental data analysis, selection indices, and report generations. For users of DataCollector or CloneSelector many of the features are known but have been improved upon. Novel features include list management of breeding families, connection with the institutional pedigree database, interactive and linked graphs as well as reproducible reports. With the first full release by end of November 2016 we will include all characteristics from both DataCollector and CloneSelector. HIDAP, with additional support from GT4SP, RTB, USAID, and SASHA, is aimed to support the broader research community working on all aspects with primary focus on breeding, genetics, biotechnology, physiology and agronomy.") shiny::includeHTML("www/about_hidap.txt") @@ -488,8 +488,8 @@ ui <- dashboardPage( # # Material List Module ---------------------------------------------------- # # fbmlist::generate_ui(name = "generateList"), - fbmlist::managerlist_ui_agrofims(name ="manageListAgrofims"), - fbmlist::generate_ui_agrofims(name = "generateListAgrofims") + #fbmlist::managerlist_ui_agrofims(name ="manageListAgrofims"), + #fbmlist::generate_ui_agrofims(name = "generateListAgrofims") # fbmlist::managerlist_ui(name = "manageList"), # fbmlist::createlist_ui(name = "createList"), @@ -498,7 +498,7 @@ ui <- dashboardPage( # #brapps::fbasingle_ui("SingleChart"), # - # fbanalysis::single_ui(name="singleAnalysisReport"), + fbanalysis::single_hdagrofims_ui(name="singleAnalysisReportAgrofims")#, # fbanalysis::genetic_ui(name="geneticAnalysisReport"), # # @@ -610,7 +610,7 @@ sv <- function(input, output, session) ({ fbdesign::server_design_agrofims(input, output, session, values) # fbdesign::server_design_big(input, output, session, values) # fbopenbooks::fbopenbooks_server(input, output, session, values) - # fbanalysis::single_server(input, output, session, values) + fbanalysis::single_hdagrofims_server(input, output, session, values) # fbanalysis::dtr_server(input, output, session, values) # # fbanalysis::met_server(input, output, session, values) diff --git a/inst/hidap_agrofims/reports/.gitignore b/inst/hidap_agrofims/reports/.gitignore deleted file mode 100755 index c930958..0000000 --- a/inst/hidap_agrofims/reports/.gitignore +++ /dev/null @@ -1,4 +0,0 @@ -report_location.html -report_anova.docx -report_anova.html -report_anova.pdf diff --git a/inst/hidap_agrofims/reports/2fcrd.Rmd b/inst/hidap_agrofims/reports/2fcrd.Rmd new file mode 100644 index 0000000..e631877 --- /dev/null +++ b/inst/hidap_agrofims/reports/2fcrd.Rmd @@ -0,0 +1,76 @@ +--- +title: "`r params$title`" +subtitle: '`r params$subtitle`' +author: '`r params$author`' +date: '`r format(Sys.time(), "%B %d, %Y")`' +output: + html_document: + theme: united + toc: true + toc_depth: 3 + pdf_document: + toc: true + toc_depth: 3 + highlight: zenburn + word_document: + toc: true + toc_depth: 3 + highlight: "tango" +params: + traits: "no data" + A: "no data" + B: "no data" + rep: "no data" + design: "no data" + data: "no data" + maxp: "no data" + title: "no data" + subtitle: "no data" + author: "no data" +--- + +```{r, echo = FALSE} +library(knitr) + +traits <- params$traits +A <- params$A +B <- params$B +rep <- params$rep +design <- params$design +data <- params$data +maxp <- params$maxp + +data[, A] <- as.character(data[, A]) +data[, B] <- as.character(data[, B]) +data[, rep] <- as.character(data[, rep]) +``` + +# 1. Model specification and data description + +The data frame has two factors with `r nlevels(as.factor(data[, A]))` and `r nlevels(as.factor(data[, B]))` levels. The experimental design is a completely randomized design with `r nlevels(as.factor(data[, rep]))` replications. The statistical model is +$$ +y_{ijk} = \mu + \alpha_i + \beta_j + (\alpha\beta)_{ij} + \epsilon_{ijk} +$$ +where + +* $y_{ijk}$ is the observed response with level $i$ of factor A, level $j$ of factor B, and replication $k$. +* $\mu$ is the mean response over all levels of factor A, factor B, and replications. +* $\alpha_i$ is the effect for level $i$ of factor A. +* $\beta_j$ is the effect for level $j$ of factor B. +* $(\alpha\beta)_{ij}$ is the interaction effect between level $i$ of factor A and level $j$ of factor B. +* $\epsilon_{ijk}$ is the error term. + +In this model we assume that the errors are independent and have a normal distribution with common variance, that is, $\epsilon_{ijk} \sim N(0,\sigma_{\epsilon}^2)$. + +```{r, include = FALSE} +out <- NULL +for (i in 1:length(traits)) { + lc <- check.2f(traits[i], A, B, rep, data) + if (lc$c1 == 1 & lc$c2 == 1 & lc$c3 == 1 & lc$pmis <= maxp) + out <- c(out, knit_expand('child_2f.Rmd')) + else + out <- c(out, knit_expand('child_2f_fail.Rmd')) +} +``` + +`r paste(knit(text = out), collapse = '\n')` diff --git a/inst/hidap_agrofims/reports/2frcbd.Rmd b/inst/hidap_agrofims/reports/2frcbd.Rmd new file mode 100644 index 0000000..1f02ae2 --- /dev/null +++ b/inst/hidap_agrofims/reports/2frcbd.Rmd @@ -0,0 +1,77 @@ +--- +title: "`r params$title`" +subtitle: '`r params$subtitle`' +author: '`r params$author`' +date: '`r format(Sys.time(), "%B %d, %Y")`' +output: + html_document: + theme: united + toc: true + toc_depth: 3 + pdf_document: + toc: true + toc_depth: 3 + highlight: zenburn + word_document: + toc: true + toc_depth: 3 + highlight: "tango" +params: + traits: "no data" + A: "no data" + B: "no data" + rep: "no data" + design: "no data" + data: "no data" + maxp: "no data" + title: "no data" + subtitle: "no data" + author: "no data" +--- + +```{r, echo = FALSE} +library(knitr) + +traits <- params$traits +A <- params$A +B <- params$B +rep <- params$rep +design <- params$design +data <- params$data +maxp <- params$maxp + +data[, A] <- as.character(data[, A]) +data[, B] <- as.character(data[, B]) +data[, rep] <- as.character(data[, rep]) +``` + +# 1. Model specification and data description + +The data frame has two factors with `r nlevels(as.factor(data[, A]))` and `r nlevels(as.factor(data[, B]))` levels. The experimental design is a randomized complete block design with `r nlevels(as.factor(data[, rep]))` blocks. The statistical model is +$$ +y_{ijk} = \mu + \alpha_i + \beta_j + (\alpha\beta)_{ij} + \gamma_k + \epsilon_{ijk} +$$ +where + +* $y_{ijk}$ is the observed response with level $i$ of factor A, level $j$ of factor B, and block $k$. +* $\mu$ is the mean response over all levels of factor A, factor B, and blocks. +* $\alpha_i$ is the effect for level $i$ of factor A. +* $\beta_j$ is the effect for level $j$ of factor B. +* $(\alpha\beta)_{ij}$ is the interaction effect between level $i$ of factor A and level $j$ of factor B. +* $\gamma_k$ is the effect of block $k$. +* $\epsilon_{ijk}$ is the error term. + +In this model we assume that the errors are independent and have a normal distribution with common variance, that is, $\epsilon_{ijk} \sim N(0,\sigma_{\epsilon}^2)$. + +```{r, include = FALSE} +out <- NULL +for (i in 1:length(traits)) { + lc <- check.2f(traits[i], A, B, rep, data) + if (lc$c1 == 1 & lc$c2 == 1 & lc$c3 == 1 & lc$pmis <= maxp) + out <- c(out, knit_expand('child_2f.Rmd')) + else + out <- c(out, knit_expand('child_2f_fail.Rmd')) +} +``` + +`r paste(knit(text = out), collapse = '\n')` diff --git a/inst/hidap_agrofims/reports/a01d.Rmd b/inst/hidap_agrofims/reports/a01d.Rmd old mode 100755 new mode 100644 index cbfb32a..b17a30e --- a/inst/hidap_agrofims/reports/a01d.Rmd +++ b/inst/hidap_agrofims/reports/a01d.Rmd @@ -1,5 +1,6 @@ --- -title: "Automatic report for an alpha (0,1) design" +title: "`r params$title`" +subtitle: '`r params$subtitle`' author: '`r params$author`' date: '`r format(Sys.time(), "%B %d, %Y")`' output: @@ -22,6 +23,8 @@ params: block: "no data" k: "no data" data: "no data" + title: "no data" + subtitle: "no data" author: "no data" --- diff --git a/inst/hidap_agrofims/reports/abd.Rmd b/inst/hidap_agrofims/reports/abd.Rmd old mode 100755 new mode 100644 index edf9da1..b5690c1 --- a/inst/hidap_agrofims/reports/abd.Rmd +++ b/inst/hidap_agrofims/reports/abd.Rmd @@ -1,5 +1,6 @@ --- -title: "Automatic report for an Augmented Block Design (ABD)" +title: "`r params$title`" +subtitle: '`r params$subtitle`' author: '`r params$author`' date: '`r format(Sys.time(), "%B %d, %Y")`' output: @@ -20,6 +21,8 @@ params: geno: "no data" rep: "no data" data: "no data" + title: "no data" + subtitle: "no data" author: "no data" --- diff --git a/inst/hidap_agrofims/reports/aov.Rmd b/inst/hidap_agrofims/reports/aov.Rmd new file mode 100644 index 0000000..d1d2492 --- /dev/null +++ b/inst/hidap_agrofims/reports/aov.Rmd @@ -0,0 +1,31 @@ +--- +title: "Report for an aov or lm object" +author: '`r params$author`' +date: '`r format(Sys.time(), "%B %d, %Y")`' +output: + html_document: + theme: united + pdf_document: + toc: true + highlight: zenburn + word_document: + highlight: "tango" +params: + x: "no data" + author: "no data" +--- + +Congratulations! You have fitted a linear model. The ANOVA table for your model is +```{r, echo = FALSE} +anova(params$x) +noterms <- dim(anova(params$x))[1] - 1 +pvalues <- anova(params$x)[1:noterms, 5] +``` + +`r if(noterms == 1 & sum(pvalues < 0.05) > 0) {"Your model has 1 term and it is significant. That is really good! Have you checked your assumptions?"}` + +`r if(noterms > 1 & sum(pvalues < 0.05) > 0) {paste("Your model has", noterms, "terms and some of them are significant. That is really good! Have you checked your assumptions?")}` + +`r if(noterms == 1 & sum(pvalues < 0.05) == 0) {"Your model has 1 term but it is not significant. I am really sorry, but don't forget that p-values are a function of sample size, so maybe you can try with more replications or a larger sample size next time."}` + +`r if(noterms > 1 & sum(pvalues < 0.05) == 0) {paste("Your model has", noterms, "terms but none of them are significant. I am really sorry, but don't forget that p-values are a function of sample size, so maybe you can try with more replications or a larger sample size next time.")}` diff --git a/inst/hidap_agrofims/reports/aovmet.Rmd b/inst/hidap_agrofims/reports/aovmet.Rmd new file mode 100644 index 0000000..ef9ca92 --- /dev/null +++ b/inst/hidap_agrofims/reports/aovmet.Rmd @@ -0,0 +1,71 @@ +--- +title: "ANOVA for a MET with a RCBD" +author: '`r params$author`' +date: '`r format(Sys.time(), "%B %d, %Y")`' +output: + html_document: + theme: united + pdf_document: + toc: true + highlight: zenburn + word_document: + highlight: "tango" +params: + trait: "no data" + geno: "no data" + env: "no data" + rep: "no data" + data: "no data" + maxp: "no data" + author: "no data" +--- + +```{r, echo = FALSE} +trait <- params$trait +geno <- params$geno +env <- params$env +rep <- params$rep +data <- params$data +maxp <- params$maxp + +lc <- check.2f(trait, geno, env, rep, data) +at <- suppressWarnings(aov.met(trait, geno, env, rep, data, maxp)) +if (lc$c4 == 0) + data[, trait] <- mve.met(trait, geno, env, rep, data, maxp)[, 5] +model <- aov(data[, trait] ~ data[, geno] + data[, env] + + data[, rep] %in% data[, env] + data[, geno]:data[, env]) +``` + +`r if(lc$c1 == 1 & lc$c2 == 1) {"You have fitted a linear model for a multi environment trial (MET) with a RCBD in each environment. The ANOVA table for your model is:"}` + +```{r, echo = FALSE} +at +``` + +`r if(lc$c4 == 0) paste("You have some missing values (", format(lc$pmis * 100, digits = 3), "%) and they have been estimated before running ANOVA.")` + +The p-values for your model are: + +- `r format(at[1, 5], digits = 4)` for genotypes `r if(at[1, 5] < 0.05) {"which is significant at the 5% level."} else {"which is not significant at the 5% level."}` +- `r format(at[2, 5], digits = 4)` for environments `r if(at[2, 5] < 0.05) {"which is significant at the 5% level."} else {"which is not significant at the 5% level."}` +- `r format(at[4, 5], digits = 4)` for the genotypes by environments interaction `r if(at[4, 5] < 0.05) {"which is significant at the 5% level."} else {"which is not significant at the 5% level."}` + +`r if(at[4, 5] < 0.05) {"Because interaction is significant you should want to run a stability analysis. Keep also in mind that a significant interaction means that the differences in response of the genotypes are not the same in all the environments. Therefore, on an individual analysis you could find significant differences among genotypes for some environments and non-significant differences for some others, and the difference for any pair of genotypes could be in different directions and magnitudes depending on the environment."}` + +Below you can see a table of means for genotypes, environments, and interaction: + +```{r, echo = FALSE} +tapply(data[, trait], data[, geno], mean) +tapply(data[, trait], data[, env], mean) +tapply(data[, trait], list(data[, geno], data[, env]), mean) +``` + +Don't forget the assumptions of the model. It is supposed that the error has a normal distribution with the same variance for all the genotypes and evironments. The following plots must help you evaluate this: + +```{r, echo = FALSE, fig.height = 5, fig.width = 10} +par(mfrow = c(1, 2)) +plot(model, which = 1) +plot(model, which = 2) +``` + +Funnel shapes for the first plot may suggest heterogeneity of variances while departures from the theoretical normal line are symptoms of lack of normality. diff --git a/inst/hidap_agrofims/reports/child_2f.Rmd b/inst/hidap_agrofims/reports/child_2f.Rmd new file mode 100644 index 0000000..4a7940f --- /dev/null +++ b/inst/hidap_agrofims/reports/child_2f.Rmd @@ -0,0 +1,59 @@ +`r i = {{i}}` + +```{r, echo = FALSE} +lc <- check.2f(traits[i], A, B, rep, data) +if (lc$c4 == 0) + data$est <- mve.2f(traits[i], A, B, rep, design, data, maxp)[, 5] else + data$est <- data[, traits[i]] +``` + +# {{i+1}}. Analysis for trait `r traits[i]` + +`r if (lc$c4 == 1) {"There are no missing values for this trait; the design is balanced."}` + +`r if (lc$c4 == 0) paste("There are some missing values (", format(lc$pmis * 100, digits = 3), "%) and they have been estimated for the descriptive statistics and ANOVA.", sep = "")` + +## {{i+1}}.1. Descriptive statistics + +### {{i+1}}.1.1. Means by factor A levels + +```{r, echo = FALSE} +tapply(data$est, data[, A], mean) +``` + +### {{i+1}}.1.2. Means by factor B levels + +```{r, echo = FALSE} +tapply(data$est, data[, B], mean) +``` + +### {{i+1}}.1.3. Means by factor A and factor B levels + +```{r, echo = FALSE} +tapply(data$est, list(data[, A], data[, B]), mean) +``` + +## {{i+1}}.2. ANOVA + +### {{i+1}}.2.1. Checking assumptions + +As it was stated in section 1, it is supposed that the error has a normal distribution with the same variance for all the combinations among the levels of both factors. The following plots help to evaluate this assumptions: + +```{r, echo = FALSE, fig.height = 5, fig.width = 10} +if (design == "crd") + model <- aov(data[, traits[i]] ~ data[, A] * data[, B]) +if (design == "rcbd") + model <- aov(data[, traits[i]] ~ data[, A] * data[, B] + data[, rep]) +par(mfrow = c(1, 2)) +suppressWarnings(plot(model, which = 1)) +suppressWarnings(plot(model, which = 2)) +``` + +Funnel shapes for the first plot may suggest heterogeneity of variances while departures from the theoretical normal line are symptoms of lack of normality. + +### {{i+1}}.2.2. ANOVA table + +```{r, echo = FALSE} +at <- suppressWarnings(aov.2f(traits[i], A, B, rep, design, data, maxp)) +at +``` diff --git a/inst/hidap_agrofims/reports/child_2f_fail.Rmd b/inst/hidap_agrofims/reports/child_2f_fail.Rmd new file mode 100644 index 0000000..31e7871 --- /dev/null +++ b/inst/hidap_agrofims/reports/child_2f_fail.Rmd @@ -0,0 +1,22 @@ +`r i = {{i}}` + +# {{i+1}}. Analysis for trait `r traits[i]` + +```{r, echo = FALSE} +lc <- check.2f(traits[i], A, B, rep, data) +``` + +`r if (lc$c2 == 0) {"There is only one replication. Analysis is not possible with one replication."}` + +`r if (lc$c2 == 1 & lc$c3 == 0) {"There is more than one datum for at least on combination of the factors in at least one replication. This could be the result of a mislabeling for the levels of the factors. The table below shows the frequencies of valid data for each combination of the levels of the factors in each replication. Solve this to proceed."}` + +`r if (lc$c1 == 0 & lc$c2 == 1 & lc$c3 == 1) {"There is at least one combination of the factors without data. The table below shows the frequencies of valid data for each combination of the levels of the factors. The analysis cannot be produced if there are combinations of the factors without data. Solve this to proceed."}` + +`r if (lc$pmis > maxp & lc$c1 == 1 & lc$c2 == 1 & lc$c3 == 1) paste("There are too many missing values (", format(lc$pmis * 100, digits = 3), "%). The table below shows the frequencies of valid data for each combination of the levels of the factors. This procedure estimates up to 10%. Solve this to proceed.", sep = "")` + +```{r, echo = FALSE} +if (lc$c2 == 1 & lc$c3 == 1) + lc$tfreq +if (lc$c2 == 1 & lc$c3 == 0) + lc$tfreqr +``` diff --git a/inst/hidap_agrofims/reports/child_a01d.Rmd b/inst/hidap_agrofims/reports/child_a01d.Rmd old mode 100755 new mode 100644 index f899e66..13fb0a4 --- a/inst/hidap_agrofims/reports/child_a01d.Rmd +++ b/inst/hidap_agrofims/reports/child_a01d.Rmd @@ -4,8 +4,19 @@ ```{r, echo = FALSE, results = 'hide'} y <- data[, traits[i]] -model <- agricolae::PBIB.test(factor(data[, block]), factor(data[, geno]), - factor(data[, rep]), y, k) +n_geno <- length(unique(data[, geno])) + +data[, block] <- factor(data[, block]) +data[, geno] <- factor(data[, geno]) +data[, rep] <- factor(data[, rep]) + + + +if(n_geno>=50){ + model <- pepa::PBIB.test.mod(data[, block], data[, geno], data[, rep], y, k, method = "VC") +} else { + model <- agricolae::PBIB.test(data[, block], data[, geno], data[, rep], y, k, method = "VC") +} ``` ## {{i+1}}.1. ANOVA @@ -24,5 +35,9 @@ model$means ## {{i+1}}.3. LSD test ```{r, echo = FALSE} -model$groups +if(n_geno>= 50){ + model$groups[,-3] +} else { + model$groups +} ``` diff --git a/inst/hidap_agrofims/reports/child_abd.Rmd b/inst/hidap_agrofims/reports/child_abd.Rmd old mode 100755 new mode 100644 index b9ddc81..3116cf8 --- a/inst/hidap_agrofims/reports/child_abd.Rmd +++ b/inst/hidap_agrofims/reports/child_abd.Rmd @@ -19,7 +19,7 @@ if (lc$nt.check.1 > 0){ } y <- temp[, traits[i]] -model <- agricolae::DAU.test(factor(temp[, rep]), factor(temp[, geno]), y) +model <- agricolae::DAU.test(temp[, rep], temp[, geno], y) ``` ## {{i+1}}.1. General setting diff --git a/inst/hidap_agrofims/reports/child_abd_fail.Rmd b/inst/hidap_agrofims/reports/child_abd_fail.Rmd old mode 100755 new mode 100644 index 580a9b0..6b60199 --- a/inst/hidap_agrofims/reports/child_abd_fail.Rmd +++ b/inst/hidap_agrofims/reports/child_abd_fail.Rmd @@ -2,6 +2,4 @@ # {{i+1}}. Analysis for trait `r traits[i]` -```{r, echo = FALSE} -warning("You need at least two checks with at least two valid replications to run ABD.") -``` +You need at least two checks with at least two valid replications to run ABD. diff --git a/inst/hidap_agrofims/reports/child_crd.Rmd b/inst/hidap_agrofims/reports/child_crd.Rmd old mode 100755 new mode 100644 diff --git a/inst/hidap_agrofims/reports/child_lxt.Rmd b/inst/hidap_agrofims/reports/child_lxt.Rmd new file mode 100644 index 0000000..dff3fe7 --- /dev/null +++ b/inst/hidap_agrofims/reports/child_lxt.Rmd @@ -0,0 +1,42 @@ +`r i = {{i}}` + +# {{i}}. Analysis for trait `r traits[i]` + +```{r, echo = FALSE} +model <- aov.lxt(traits[i], lines, testers, rep, data) +``` + +#### GCA effects for lines plot + +```{r, echo = FALSE} +barplot(model$GCA.le[, 1], col = "lightblue", las = 2, cex.names = 0.8, + ylab = "GCA effects") +``` + +#### Mid parent heterosis increment plot + +```{r, echo = FALSE} +# Means + +means <- docomp('mean', traits[i], c(lines, testers), data = data) +hhh <- means[!is.na(means[, lines]) & !is.na(means[, testers]), ] +line.means <- means[!is.na(means[, lines]) & is.na(means[, testers]), ] +test.means <- means[is.na(means[, lines]) & !is.na(means[, testers]), ] + +# Colnames + +colnames(line.means)[3] <- paste(lines, 'means', sep = "_") +colnames(test.means)[3] <- paste(testers, 'means', sep = "_") + +# Merge data frames + +hhh <- merge(hhh, line.means[, -2], by = lines) +hhh <- merge(hhh, test.means[, -1], by = testers) +hhh$het <- hhh[, 3] / (hhh[, 4] + hhh[, 5]) * 200 - 100 + +# Graph + +barplot(hhh$het, col = "lightblue", las = 2, cex.names = 0.8, + ylab = "Heterosis increment (%)", + names.arg = paste(hhh[, lines], hhh[, testers], sep = "-")) +``` diff --git a/inst/hidap_agrofims/reports/child_met.Rmd b/inst/hidap_agrofims/reports/child_met.Rmd old mode 100755 new mode 100644 index 4295add..3709251 --- a/inst/hidap_agrofims/reports/child_met.Rmd +++ b/inst/hidap_agrofims/reports/child_met.Rmd @@ -1,17 +1,17 @@ `r i = {{i}}` ```{r, echo = FALSE} -lc <- check.met(traits[i], geno, env, rep, data) -if (lc$c3 == 0) - data$est <- mvemet(traits[i], geno, env, rep, data, maxp)[, 5] else +lc <- check.2f(traits[i], geno, env, rep, data) +if (lc$c4 == 0) + data$est <- mve.met(traits[i], geno, env, rep, data, maxp)[, 5] else data$est <- data[, traits[i]] ``` # {{i+1}}. Analysis for trait `r traits[i]` -`r if(lc$c3 == 1) {"There are no missing values for this trait; the design es balanced."}` +`r if (lc$c4 == 1) {"There are no missing values for this trait; the design is balanced."}` -`r if(lc$c3 == 0) paste("There are some missing values (", format(lc$pmis * 100, digits = 3), "%) and they have been estimated for the descriptive statistics, ANOVA, regression stability analysis and Tai sections.")` +`r if (lc$c4 == 0) paste("There are some missing values (", format(lc$pmis * 100, digits = 3), "%) and they have been estimated for the descriptive statistics, ANOVA, regression stability analysis and Tai sections.", sep = "")` ## {{i+1}}.1. Descriptive statistics @@ -37,7 +37,7 @@ tapply(data$est, list(data[, geno], data[, env]), mean) ### {{i+1}}.2.1. Checking assumptions -As it was stated in section 1, it is supposed that the error has a normal distribution with the same variance for all the genotypes and evironments. The following plots help to evaluate this assumptions: +As it was stated in section 1, it is supposed that the error has a normal distribution with the same variance for all the genotypes and environments. The following plots help to evaluate this assumptions: ```{r, echo = FALSE, fig.height = 5, fig.width = 10} model <- aov(data[, traits[i]] ~ data[, geno] + data[, env] @@ -54,18 +54,29 @@ Funnel shapes for the first plot may suggest heterogeneity of variances while de For this analysis it is assumed that genotypes and environments have fixed effects and that the blocks are random. ```{r, echo = FALSE} -at <- suppressWarnings(aovmet(traits[i], geno, env, rep, data, maxp)) +at <- suppressWarnings(aov.met(traits[i], geno, env, rep, data, maxp)) at ``` -The coefficient of variation for this experiment is `r format(agricolae::cv.model(model), digits = 4)`%. -The p-values for the model are: +The coefficient of variation for this experiment is `r format(agricolae::cv.model(model), digits = 4)`%. The p-values for the model are: `r format(at[1, 5], digits = 4)` for genotypes `r if (at[1, 5] < 0.05) {" which is significant at the 5% level, "} else {" which is not significant at the 5% level, "}` `r format(at[2, 5], digits = 4)` for environments `r if (at[2, 5] < 0.05) {" which is significant at the 5% level,"} else {" which is not significant at the 5% level,"}` and `r format(at[4, 5], digits = 4)` for the genotypes by environments interaction `r if (at[4, 5] < 0.05) {" which is significant at the 5% level."} else {" which is not significant at the 5% level."}` -- `r format(at[1, 5], digits = 4)` for genotypes `r if(at[1, 5] < 0.05) {"which is significant at the 5% level."} else {"which is not significant at the 5% level."}` -- `r format(at[2, 5], digits = 4)` for environments `r if(at[2, 5] < 0.05) {"which is significant at the 5% level."} else {"which is not significant at the 5% level."}` -- `r format(at[4, 5], digits = 4)` for the genotypes by environments interaction `r if(at[4, 5] < 0.05) {"which is significant at the 5% level."} else {"which is not significant at the 5% level."}` +`r if(at[1, 5] < 0.05) {"In the next two sections the least significance difference method and the multiple comparisons method of Tukey are used to evaluate differences among genotypes, both at the 5% level. However take into account that differences among genotypes can be obscured by the interaction effects, and that in the case of strong interaction, differences among genotypes must depend on the specific environments."} else {"Because the effect of genotypes was not significant in the ANOVA, multiple comparison tests are not presented."}` -### {{i+1}}.2.3. Variance components estimation +`r if (at[1, 5] < 0.05) {paste("### ", {{i+1}}, ".2.3. LSD test", sep = "")}` + +```{r, echo = FALSE} +if (at[1, 5] < 0.05) + agricolae::LSD.test(data[, traits[i]], data[, geno], at[5, 1], at[5, 3])$groups +``` + +`r if (at[1, 5] < 0.05) {paste("### ", {{i+1}}, ".2.4. Tukey test", sep = "")}` + +```{r, echo = FALSE} +if (at[1, 5] < 0.05) + agricolae::HSD.test(data[, traits[i]], data[, geno], at[5, 1], at[5, 3])$groups +``` + +`r if (at[1, 5] < 0.05) {paste("### ", {{i+1}}, ".2.5. Variance components estimation", sep = "")} else {paste("### ", {{i+1}}, ".2.3. Variance components estimation", sep = "")}` Under the assumption that all the factors (genotypes, environments, and blocks) have random effects, below it is shown the variance components estimation. Here the model is estimated by REML (Restricted Maximum Likelihood) and the original data without the estimation of missing values is used. @@ -87,7 +98,7 @@ vc[vc[, 1] == "fr:fe", 1] <- paste(rep, "(", env, ")", sep = "") rownames(vc) <- vc[, 1] vc <- vc[, c(4, 5)] colnames(vc) <- c("Variance", "Std.Dev.") -h2 <- vg / (vg + vgxe / lc$ne + vr / lc$ne / lc$nr) * 100 +h2 <- vg / (vg + vgxe / lc$nb + vr / lc$nb / lc$nr) * 100 vc ``` @@ -95,105 +106,109 @@ With these variance estimates, the broad sense heritability results `r paste(for ## {{i+1}}.3. Stability analysis -`r if(at[4, 5] > 0.05) {"Because interaction is non significant a stability analysis is not presented."}` -`r if(at[4, 5] < 0.05) {"Because interaction is significant a stability analysis is presented."}` +`r if (at[4, 5] > 0.05 | lc$nb <= 2) {"This analysis is not shown because:"}` + +`r if (at[4, 5] > 0.05) {"- Interaction is non significant."}` +`r if (lc$nb <= 2) {"- There are only 2 environments. At least 3 are needed."}` + +`r if (at[4, 5] < 0.05 & lc$nb > 2) {"Because interaction is significant a stability analysis is presented."}` -`r if(at[4, 5] < 0.05) {paste("### ", {{i+1}}, ".3.1. AMMI", sep = "")}` +`r if (at[4, 5] < 0.05 & lc$nb > 2) {paste("### ", {{i+1}}, ".3.1. AMMI", sep = "")}` -`r if(at[4, 5] < 0.05) {"#### AMMI biplots"}` +`r if (at[4, 5] < 0.05 & lc$nb > 2) {"#### AMMI biplots"}` -```{r, echo = FALSE, fig.align = 'center', fig.width = 7, fig.height = 7} -if(at[4, 5] < 0.05) { +```{r, echo = FALSE, fig.align = 'center', fig.width = 8, fig.height = 8} +if (at[4, 5] < 0.05 & lc$nb > 2) { ammimodel <- suppressWarnings(ammi(traits[i], geno, env, rep, data)) plot(ammimodel, biplot = 1) } ``` -```{r, echo = FALSE, fig.align = 'center', fig.height = 7, fig.width = 7} -if(at[4, 5] < 0.05) { +```{r, echo = FALSE, fig.align = 'center', fig.height = 8, fig.width = 8} +if (at[4, 5] < 0.05 & lc$nb > 2) { plot(ammimodel, biplot = 2) } ``` -`r if(at[4, 5] < 0.05) {"#### Interaction effects"}` +`r if (at[4, 5] < 0.05 & lc$nb > 2) {"#### Interaction effects"}` ```{r, echo = FALSE} -if(at[4, 5] < 0.05) ammimodel$Interaction_effects +if (at[4, 5] < 0.05 & lc$nb > 2) ammimodel$Interaction_effects ``` -`r if(at[4, 5] < 0.05) {"#### PC-values for genotypes"}` +`r if (at[4, 5] < 0.05 & lc$nb > 2) {"#### PC-values for genotypes"}` ```{r, echo = FALSE} -if(at[4, 5] < 0.05) ammimodel$PC_values_genotypes +if (at[4, 5] < 0.05 & lc$nb > 2) ammimodel$PC_values_genotypes ``` -`r if(at[4, 5] < 0.05) {"#### PC-values for environments"}` +`r if (at[4, 5] < 0.05 & lc$nb > 2) {"#### PC-values for environments"}` ```{r, echo = FALSE} -if(at[4, 5] < 0.05) ammimodel$PC_values_environments +if (at[4, 5] < 0.05 & lc$nb > 2) ammimodel$PC_values_environments ``` -`r if(at[4, 5] < 0.05) {"#### PC contributions"}` +`r if (at[4, 5] < 0.05 & lc$nb > 2) {"#### PC contributions"}` ```{r, echo = FALSE} -if(at[4, 5] < 0.05) ammimodel$Contribution_PCs +if (at[4, 5] < 0.05 & lc$nb > 2) ammimodel$Contribution_PCs ``` -`r if(at[4, 5] < 0.05) {paste("### ", {{i+1}}, ".3.2. GGE", sep = "")}` +`r if (at[4, 5] < 0.05 & lc$nb > 2) {paste("### ", {{i+1}}, ".3.2. GGE", sep = "")}` -`r if(at[4, 5] < 0.05) {"#### GGE biplots"}` +`r if (at[4, 5] < 0.05 & lc$nb > 2) {"#### GGE biplots"}` -```{r, echo = FALSE, fig.align = 'center', fig.height = 7, fig.width = 7} -if(at[4, 5] < 0.05) { - ggemodel <- suppressWarnings(ammi(traits[i], geno, env, rep, data, method = "GGE")) +```{r, echo = FALSE, fig.align = 'center', fig.height = 8, fig.width = 8} +if (at[4, 5] < 0.05 & lc$nb > 2) { + ggemodel <- suppressWarnings(ammi(traits[i], geno, env, rep, data, method = "gge")) plot(ggemodel, biplot = 1) } ``` -```{r, echo = FALSE, fig.align = 'center', fig.height = 7, fig.width = 7} -if(at[4, 5] < 0.05) { +```{r, echo = FALSE, fig.align = 'center', fig.height = 8, fig.width = 8} +if (at[4, 5] < 0.05 & lc$nb > 2) { plot(ggemodel, biplot = 2) } ``` -`r if(at[4, 5] < 0.05) {"#### PC-values for genotypes"}` +`r if (at[4, 5] < 0.05 & lc$nb > 2) {"#### PC-values for genotypes"}` ```{r, echo = FALSE} -if(at[4, 5] < 0.05) ggemodel$PC_values_genotypes +if (at[4, 5] < 0.05 & lc$nb > 2) ggemodel$PC_values_genotypes ``` -`r if(at[4, 5] < 0.05) {"#### PC-values for environments"}` +`r if (at[4, 5] < 0.05 & lc$nb > 2) {"#### PC-values for environments"}` ```{r, echo = FALSE} -if(at[4, 5] < 0.05) ggemodel$PC_values_environments +if (at[4, 5] < 0.05 & lc$nb > 2) ggemodel$PC_values_environments ``` -`r if(at[4, 5] < 0.05) {"#### PC contributions"}` +`r if (at[4, 5] < 0.05 & lc$nb > 2) {"#### PC contributions"}` ```{r, echo = FALSE} -if(at[4, 5] < 0.05) ggemodel$Contribution_PCs +if (at[4, 5] < 0.05 & lc$nb > 2) ggemodel$Contribution_PCs ``` -`r if(at[4, 5] < 0.05) {paste("### ", {{i+1}}, ".3.3. Regression Stability Analysis", sep = "")}` +`r if (at[4, 5] < 0.05 & lc$nb > 2) {paste("### ", {{i+1}}, ".3.3. Regression Stability Analysis", sep = "")}` ```{r, echo = FALSE} -if(at[4, 5] < 0.05) { +if (at[4, 5] < 0.05 & lc$nb > 2) { rsamodel <- suppressWarnings(rsa(traits[i], geno, env, rep, data)) } ``` -`r if(at[4, 5] < 0.05) {"#### ANOVA"}` +`r if (at[4, 5] < 0.05 & lc$nb > 2) {"#### ANOVA"}` ```{r, echo = FALSE} -if(at[4, 5] < 0.05) rsamodel$ANOVA +if (at[4, 5] < 0.05 & lc$nb > 2) rsamodel$ANOVA ``` -`r if(at[4, 5] < 0.05) {"#### Stability measures for genotypes"}` +`r if (at[4, 5] < 0.05 & lc$nb > 2) {"#### Stability measures for genotypes"}` ```{r, echo = FALSE} -if(at[4, 5] < 0.05) rsamodel$Stability_for_genotypes +if (at[4, 5] < 0.05 & lc$nb > 2) rsamodel$Stability_for_genotypes ``` -`r if(at[4, 5] < 0.05) {"Here: \n +`r if (at[4, 5] < 0.05 & lc$nb > 2) {"Here: \n - a is the linear regression intercept, \n - b is the linear regression slope, \n - se is the slope standard error, \n @@ -202,26 +217,26 @@ if(at[4, 5] < 0.05) rsamodel$Stability_for_genotypes - MSinter is the variance of the interaction effects. \n The same is shown in the next section for each environment."}` -`r if(at[4, 5] < 0.05) {"#### Stability measures for environments"}` +`r if (at[4, 5] < 0.05 & lc$nb > 2) {"#### Stability measures for environments"}` ```{r, echo = FALSE} -if(at[4, 5] < 0.05) rsamodel$Stability_for_environments +if (at[4, 5] < 0.05 & lc$nb > 2) rsamodel$Stability_for_environments ``` -`r if(at[4, 5] < 0.05) {paste("### ", {{i+1}}, ".3.4. Tai stability analysis", sep = "")}` +`r if (at[4, 5] < 0.05 & lc$nb > 2) {paste("### ", {{i+1}}, ".3.4. Tai stability analysis", sep = "")}` -`r if(at[4, 5] < 0.05) {"#### Tai plot"}` +`r if (at[4, 5] < 0.05 & lc$nb > 2) {"#### Tai plot"}` -```{r, echo = FALSE, fig.align = 'center', fig.height = 7, fig.width = 7} -if(at[4, 5] < 0.05) { +```{r, echo = FALSE, fig.align = 'center', fig.height = 8, fig.width = 8} +if (at[4, 5] < 0.05 & lc$nb > 2) { taimodel <- suppressWarnings(tai(traits[i], geno, env, rep, data)) plot(taimodel) } ``` -`r if(at[4, 5] < 0.05) {"#### Tai alpha and lambda values"}` +`r if (at[4, 5] < 0.05 & lc$nb > 2) {"#### Tai alpha and lambda values"}` ```{r, echo = FALSE} -if(at[4, 5] < 0.05) +if (at[4, 5] < 0.05 & lc$nb > 2) taimodel$Tai_values ``` diff --git a/inst/hidap_agrofims/reports/child_met_fail.Rmd b/inst/hidap_agrofims/reports/child_met_fail.Rmd new file mode 100644 index 0000000..9cc64b2 --- /dev/null +++ b/inst/hidap_agrofims/reports/child_met_fail.Rmd @@ -0,0 +1,22 @@ +`r i = {{i}}` + +# {{i+1}}. Analysis for trait `r traits[i]` + +```{r, echo = FALSE} +lc <- check.2f(traits[i], geno, env, rep, data) +``` + +`r if (lc$c2 == 0) {"There is only one replication. Analysis is not possible with one replication."}` + +`r if (lc$c2 == 1 & lc$c3 == 0) {"There is more than one datum for at least one combination of the genotypes and environments in at least one replication. This could be the result of a mislabeling for the levels of the factors. The table below shows the frequencies of valid data for each genotype and environment in each replication. Solve this to proceed."}` + +`r if (lc$c1 == 0 & lc$c2 == 1 & lc$c3 == 1) {"There is at least one genotype without data in at least one environment. The table below shows the frequencies of valid data for each genotype in each environment. A MET analysis cannot be produced if there are combination of genotypes and environments without data. Solve this to proceed."}` + +`r if (lc$pmis > maxp & lc$c1 == 1 & lc$c2 == 1 & lc$c3 == 1) paste("There are too many missing values (", format(lc$pmis * 100, digits = 3), "%). The table below shows the frequencies of valid data for each genotype in each environment. This procedure estimates up to 10%. Solve this to proceed.", sep = "")` + +```{r, echo = FALSE} +if (lc$c2 == 1 & lc$c3 == 1) + lc$tfreq +if (lc$c2 == 1 & lc$c3 == 0) + lc$tfreqr +``` diff --git a/inst/hidap_agrofims/reports/child_nc.Rmd b/inst/hidap_agrofims/reports/child_nc.Rmd new file mode 100644 index 0000000..f9a3262 --- /dev/null +++ b/inst/hidap_agrofims/reports/child_nc.Rmd @@ -0,0 +1,26 @@ +`r i = {{i}}` + +# {{i}}. Analysis for trait `r traits[i]` + +```{r, echo = FALSE} +if (model == 1) { + ddd <- data.frame ( + set = data[, set], + male = data[, male], + female = data[, female], + progeny = data[, progeny], + rep = data[, rep], + yield = data[, traits[i]]) +} + +if (model == 2 | model == 3) { + ddd <- data.frame ( + set = data[, set], + male = data[, male], + female = data[, female], + rep = data[, rep], + yield = data[, traits[i]]) +} + +agricolae::carolina(model, ddd) +``` diff --git a/inst/hidap_agrofims/reports/child_rcbd.Rmd b/inst/hidap_agrofims/reports/child_rcbd.Rmd old mode 100755 new mode 100644 index 63a13cb..34fa04a --- a/inst/hidap_agrofims/reports/child_rcbd.Rmd +++ b/inst/hidap_agrofims/reports/child_rcbd.Rmd @@ -4,19 +4,19 @@ ```{r, echo = FALSE} lc <- check.rcbd(traits[i], geno, rep, data) -at <- suppressWarnings(rcbd(traits[i], geno, rep, data, maxp)) +at <- suppressWarnings(aov.rcbd(traits[i], geno, rep, data, maxp)) model <- aov(data[, traits[i]] ~ data[, geno] + data[, rep]) ``` ## {{i+1}}.1. ANOVA -`r if(lc$c1 == 1 & lc$c2 == 1) {"You have fitted a linear model for a RCBD. The ANOVA table for your model is:"}` +You have fitted a linear model for a RCBD. The ANOVA table for your model is: ```{r, echo = FALSE} at ``` -`r if(lc$c3 == 0) paste("You have some missing values (", format(lc$pmis * 100, digits = 3), "%) and they have been estimated before running ANOVA.")` +`r if(lc$c4 == 0) paste("You have some missing values (", format(lc$pmis * 100, digits = 3), "%) and they have been estimated before running ANOVA.", sep = "")` The coefficient of variation for this experiment is `r format(agricolae::cv.model(model), digits = 4)`%. The p-value for genotypes is `r format(at[1, 5], digits = 4)` @@ -28,6 +28,7 @@ Don't forget the assumptions of the model. It is supposed that the errors are in ```{r, echo = FALSE, fig.height = 5, fig.width = 10} par(mfrow = c(1, 2)) + plot(model, which = 1) plot(model, which = 2) ``` @@ -36,14 +37,29 @@ Any trend in the residuals in the left plot would violate the assumption of inde ## {{i+1}}.3. Genotype means -`r if(at[1, 5] < 0.05) {"Below are the sorted means for each genotype with letters indicating if there are significant differences using the multiple comparisons method of Tukey at the 5% level."} else {"The means of your genotypes are:"}` +`r if(at[1, 5] < 0.05) {"Below are the sorted means for each genotype with letters indicating if there are significant differences using the least significance difference method and the multiple comparisons method of Tukey, both at the 5% level."} else {"Because the effect of genotypes was not significant in the ANOVA, multiple comparison tests are not presented. The means of your genotypes are:"}` + +`r if (at[1, 5] < 0.05) {paste("### ", {{i+1}}, ".3.1. LSD test", sep = "")}` ```{r, echo = FALSE} if (at[1, 5] < 0.05) - agricolae::HSD.test(data[, traits[i]], data[, geno], at[3, 1], at[3, 3])$groups else + agricolae::LSD.test(data[, traits[i]], data[, geno], at[3, 1], at[3, 3])$groups +``` + +`r if (at[1, 5] < 0.05) {paste("### ", {{i+1}}, ".3.2. Tukey test", sep = "")}` + +```{r, echo = FALSE} +if (at[1, 5] < 0.05) + agricolae::HSD.test(data[, traits[i]], data[, geno], at[3, 1], at[3, 3])$groups +``` + +```{r, echo = FALSE} +if (at[1, 5] > 0.05) tapply(data[, traits[i]], data[, geno], mean) ``` +`r if (lc$nt < 10 & at[1, 5] < 0.05) {paste("### ", {{i+1}}, ".3.3. Plot of means", sep = "")}` + `r if(lc$nt < 10) {"It is always good to have some visualization of the data. Because the number of genotypes in your experiment is not so big, we can plot the data for each genotype:"}` ```{r, echo = FALSE} diff --git a/inst/hidap_agrofims/reports/child_rcbd2_old.Rmd b/inst/hidap_agrofims/reports/child_rcbd2_old.Rmd deleted file mode 100755 index 8290490..0000000 --- a/inst/hidap_agrofims/reports/child_rcbd2_old.Rmd +++ /dev/null @@ -1,74 +0,0 @@ -```{r, echo = FALSE} -i = {{k}} -``` - -### Analysis of **`r trts[i]`** - -```{r , echo = FALSE, message=FALSE, warning=FALSE, error=FALSE} - at <- suppressWarnings(st4gi::rcbd(trts[i], treat, rep, tbl, maxp)) - - model <- aov(tbl[, trts[i]] ~ tbl[, treat] + tbl[, rep]) - -``` - -`r if(lc$c1 == 1 & lc$c2 == 1 ) {"You have fitted a linear model for a RCBD. The ANOVA table for your model is:"}` - -```{r, echo=FALSE, comment = NA, results = 'asis',message=FALSE, warning=FALSE, error=FALSE} -pander::pandoc.table(at, justify = "lrrrrr", digits = 6) -``` - -`r if(lc$c3 == 0) paste("You have some missing values (", format(lc$pmis * 100, digits = 3), "%) and they have been estimated before running ANOVA.")` - -```{r , echo = FALSE} -if (at[1, 5] < 0.05 ) { - txt = paste("The p-value for treatments is", - format(at[1, 5], digits = 6, scientific = FALSE), - "which is significant at the 5% level.") -} else { - txt = "" -} - -``` - -`r txt` - -The means of your treatments are: -```{r, echo=FALSE, comment = NA, results = 'asis'} - -x <- tapply(tbl[, trts[i]], tbl[, treat], mean) -x <- as.data.frame(x) -x <- cbind(row.names(x), x) -names(x) <- c(treat, trts[i]) -row.names(x) = 1:nrow(x) -x[, 2] <- format(x[, 2], digits = 3) -x[, 2] <- as.numeric(x[, 2]) -pander::pandoc.table(x, digits = 3, justify = "lr") - -``` - -```{r, echo = FALSE, fig.height = 8, fig.width = 10} - - #z=x[order(x[traits[i]]), ] - z=x[order(x[2]), ] - dotchart(z[,2], labels = z[,1]) - -``` - -`r if(lc$nt < 10 ) {"It is always good to have some visualization of the data. Because the number of treatments in your experiment is not so big, we can plot the data for each treatment:"}` - -```{r, echo = FALSE} -if (lc$nt < 10 ) msdplot(trts[i], treat, tbl, conf = 1) -``` - - -Do not forget the assumptions of the model. It is supposed that the error has a normal distribution with the same variance for all the treatments. The following plots must help you evaluate this: - -```{r, echo = FALSE, fig.height = 5, fig.width = 10} - - par(mfrow = c(1, 2)) - plot(model, which = 1) - plot(model, which = 2) - -``` - -Funnel shapes for the first plot may suggest heterogeneity of variances while departures from the theoretical normal line are symptoms of lack of normality. diff --git a/inst/hidap_agrofims/reports/child_rcbd_fail.Rmd b/inst/hidap_agrofims/reports/child_rcbd_fail.Rmd new file mode 100644 index 0000000..dd3ab3f --- /dev/null +++ b/inst/hidap_agrofims/reports/child_rcbd_fail.Rmd @@ -0,0 +1,20 @@ +`r i = {{i}}` + +# {{i+1}}. Analysis for trait `r traits[i]` + +```{r, echo = FALSE} +lc <- check.rcbd(traits[i], geno, rep, data) +``` + +`r if (lc$c2 == 0) {"There is only one replication. Analysis is not possible with one replication."}` + +`r if (lc$c2 == 1 & lc$c3 == 0) {"There is more than one datum for at least one genotype in at least one replication. This could be the result of a mislabeling for the levels of the factors. The table below shows the frequencies of valid data for each genotype in each replication. Solve this to proceed."}` + +`r if (lc$c1 == 0 & lc$c2 == 1 & lc$c3 == 1) {"There is at least one genotype without data. The table below shows the frequencies of valid data for each genotype in each replication. The analysis cannot be produced if there are genotypes without data. Solve this to proceed."}` + +`r if (lc$pmis > maxp & lc$c1 == 1 & lc$c2 == 1 & lc$c3 == 1) paste("There are too many missing values (", format(lc$pmis * 100, digits = 3), "%). The table below shows the frequencies of valid data for each genotype in each replication. This procedure estimates up to 10%. Solve this to proceed.", sep = "")` + +```{r, echo = FALSE} +if (lc$c2 == 1) + lc$tfreq +``` diff --git a/inst/hidap_agrofims/reports/crd.Rmd b/inst/hidap_agrofims/reports/crd.Rmd old mode 100755 new mode 100644 index 3ee0b4b..9e2d0ed --- a/inst/hidap_agrofims/reports/crd.Rmd +++ b/inst/hidap_agrofims/reports/crd.Rmd @@ -1,5 +1,6 @@ --- -title: "Automatic report for a Completely Randomized Design (CRD)" +title: "`r params$title`" +subtitle: '`r params$subtitle`' author: '`r params$author`' date: '`r format(Sys.time(), "%B %d, %Y")`' output: @@ -20,6 +21,8 @@ params: geno: "no data" data: "no data" maxp: "no data" + title: "no data" + subtitle: "no data" author: "no data" --- @@ -30,6 +33,8 @@ traits <- params$traits geno <- params$geno data <- params$data maxp <- params$maxp + +data[, geno] <- as.character(data[, geno]) ``` # 1. Model specification and data description diff --git a/inst/hidap_agrofims/reports/df.Rmd b/inst/hidap_agrofims/reports/df.Rmd new file mode 100644 index 0000000..6a055ef --- /dev/null +++ b/inst/hidap_agrofims/reports/df.Rmd @@ -0,0 +1,27 @@ +--- +title: "Report for a data table" +author: '`r params$author`' +date: '`r format(Sys.time(), "%B %d, %Y")`' +output: + html_document: + theme: united + pdf_document: + toc: true + highlight: zenburn + word_document: + highlight: "tango" +params: + x: "no data" + author: "no data" +--- + +You have a nice data table with `r dim(params$x)[1]` rows and `r dim(params$x)[2]` columns. The first six rows are shown below: +```{r, echo = FALSE} +head(params$x) +``` +Remember that the table is the standard format for data analysis; it is the kind of data structure that any statistical package prefers. In a table you have: + +* one row for each observation (e.g. a plot, a pot or a plant) and +* one column for each variable (e.g. a trait like root yield or a factor like genotypes). + +Maybe you would like to read [this](https://github.com/reyzaguirre/MoreStats/tree/master/GoodDataPractices). diff --git a/inst/hidap_agrofims/reports/elston.Rmd b/inst/hidap_agrofims/reports/elston.Rmd new file mode 100644 index 0000000..f2193de --- /dev/null +++ b/inst/hidap_agrofims/reports/elston.Rmd @@ -0,0 +1,41 @@ +--- +title: "Elston index" +author: '`r params$author`' +date: '`r format(Sys.time(), "%B %d, %Y")`' +output: + html_document: + theme: united + pdf_document: + toc: true + highlight: zenburn + word_document: + highlight: "tango" +params: + traits: "no data" + geno: "no data" + env: "no data" + rep: "no data" + data: "no data" + means: "no data" + lb: "no data" + author: "no data" +--- + +```{r, echo = FALSE} +traits <- params$traits +geno <- params$geno +env <- params$env +rep <- params$rep +data <- params$data +means <- params$means +lb <- params$lb + +eindex <- elston(traits, geno, env, rep, data, means, lb) +``` + +### The Elston index + +The Elston index for each genotype is shown below. As you see, genotype `r (eindex[sort(eindex$E.Index, decreasing = T, index.return = T)$ix, ])[1,1]` is the one with the highest value. +```{r, echo = FALSE} +eindex[sort(eindex$E.Index, decreasing = T, index.return = T)$ix, ] +``` diff --git a/inst/hidap_agrofims/reports/lxt.Rmd b/inst/hidap_agrofims/reports/lxt.Rmd new file mode 100644 index 0000000..ad24aee --- /dev/null +++ b/inst/hidap_agrofims/reports/lxt.Rmd @@ -0,0 +1,47 @@ +--- +title: "`r params$title`" +subtitle: '`r params$subtitle`' +author: '`r params$author`' +date: '`r format(Sys.time(), "%B %d, %Y")`' +output: + html_document: + theme: united + toc: true + toc_depth: 3 + pdf_document: + toc: true + toc_depth: 3 + highlight: zenburn + word_document: + highlight: "tango" + toc: true + toc_depth: 3 +params: + traits: "no data" + lines: "no data" + testers: "no data" + rep: "no data" + data: "no data" + title: "no data" + subtitle: "no data" + author: "no data" +--- + +```{r, echo = FALSE} +library(knitr) + +traits <- params$traits +lines <- params$lines +testers <- params$testers +rep <- params$rep +data <- params$data +``` + +```{r, include = FALSE} +out <- NULL + +for (i in 1:length(traits)) + out <- c(out, knit_expand('child_lxt.Rmd')) +``` + +`r paste(knit(text = out), collapse = '\n')` diff --git a/inst/hidap_agrofims/reports/met.Rmd b/inst/hidap_agrofims/reports/met.Rmd old mode 100755 new mode 100644 index 8b301ef..286379a --- a/inst/hidap_agrofims/reports/met.Rmd +++ b/inst/hidap_agrofims/reports/met.Rmd @@ -1,5 +1,6 @@ --- -title: "Automatic report for a MET with a RCBD" +title: "`r params$title`" +subtitle: '`r params$subtitle`' author: '`r params$author`' date: '`r format(Sys.time(), "%B %d, %Y")`' output: @@ -22,6 +23,8 @@ params: rep: "no data" data: "no data" maxp: "no data" + title: "no data" + subtitle: "no data" author: "no data" --- @@ -34,11 +37,15 @@ env <- params$env rep <- params$rep data <- params$data maxp <- params$maxp + +data[, geno] <- as.character(data[, geno]) +data[, env] <- as.character(data[, env]) +data[, rep] <- as.character(data[, rep]) ``` # 1. Model specification and data description -There is data from `r nlevels(as.factor(data[, env]))` environments and `r nlevels(as.factor(data[, geno]))` genotypes. In each environment the genotypes were evaluated using a randomized complete block design with `r nlevels(as.factor(data[, rep]))` blocks. The statistical model is +The data frame has `r nlevels(as.factor(data[, env]))` environments and `r nlevels(as.factor(data[, geno]))` genotypes. In each environment the genotypes were evaluated using a randomized complete block design with `r nlevels(as.factor(data[, rep]))` blocks. The statistical model is $$ y_{ijk} = \mu + \alpha_i + \beta_j + (\alpha\beta)_{ij} + \gamma_{k(j)} + \epsilon_{ijk} $$ @@ -56,8 +63,13 @@ In this model we assume that the errors are independent and have a normal distri ```{r, include = FALSE} out <- NULL -for (i in 1:length(traits)) - out <- c(out, knit_expand('child_met.Rmd')) +for (i in 1:length(traits)) { + lc <- check.2f(traits[i], geno, env, rep, data) + if (lc$c1 == 1 & lc$c2 == 1 & lc$c3 == 1 & lc$pmis <= maxp) + out <- c(out, knit_expand('child_met.Rmd')) + else + out <- c(out, knit_expand('child_met_fail.Rmd')) +} ``` `r paste(knit(text = out), collapse = '\n')` diff --git a/inst/hidap_agrofims/reports/na.Rmd b/inst/hidap_agrofims/reports/na.Rmd new file mode 100644 index 0000000..bb59225 --- /dev/null +++ b/inst/hidap_agrofims/reports/na.Rmd @@ -0,0 +1,18 @@ +--- +title: "Report for unknown object" +author: '`r params$author`' +date: '`r format(Sys.time(), "%B %d, %Y")`' +output: + html_document: + theme: united + pdf_document: + toc: true + highlight: zenburn + word_document: + highlight: "tango" +params: + x: "no data" + author: "no data" +--- + +I am sorry, this object is not in my list. diff --git a/inst/hidap_agrofims/reports/nc.Rmd b/inst/hidap_agrofims/reports/nc.Rmd new file mode 100644 index 0000000..cba2fea --- /dev/null +++ b/inst/hidap_agrofims/reports/nc.Rmd @@ -0,0 +1,53 @@ +--- +title: "`r params$title`" +subtitle: '`r params$subtitle`' +author: '`r params$author`' +date: '`r format(Sys.time(), "%B %d, %Y")`' +output: + html_document: + theme: united + toc: true + toc_depth: 3 + pdf_document: + toc: true + toc_depth: 3 + highlight: zenburn + word_document: + highlight: "tango" + toc: true + toc_depth: 3 +params: + traits: "no data" + set: "no data" + male: "no data" + female: "no data" + progeny: "no data" + rep: "no data" + model: "no data" + data: "no data" + title: "no data" + subtitle: "no data" + author: "no data" +--- + +```{r, echo = FALSE} +library(knitr) + +traits <- params$traits +set <- params$set +male <- params$male +female <- params$female +progeny <- params$progeny +rep <- params$rep +model <- params$model +data <- params$data +``` + +```{r, include = FALSE} +out <- NULL + +for (i in 1:length(traits)) + out <- c(out, knit_expand('child_nc.Rmd')) +``` + +`r paste(knit(text = out), collapse = '\n')` diff --git a/inst/hidap_agrofims/reports/nt.Rmd b/inst/hidap_agrofims/reports/nt.Rmd new file mode 100644 index 0000000..ab5c3a9 --- /dev/null +++ b/inst/hidap_agrofims/reports/nt.Rmd @@ -0,0 +1,60 @@ +--- +title: "Report for a numeric trait" +author: '`r params$author`' +date: '`r format(Sys.time(), "%B %d, %Y")`' +output: + html_document: + theme: united + pdf_document: + toc: true + highlight: zenburn + word_document: + highlight: "tango" +params: + x: "no data" + author: "no data" +--- + +```{r, echo = FALSE} +# Some parameters +p1 <- length(params$x) +p2 <- max(table(params$x)) +p3 <- length(table(params$x)) +``` + +It looks like you have a numeric trait. You can see a descriptive summary below: +```{r, echo = FALSE} +output <- summary(params$x) +output +``` + +```{r, echo = FALSE} +sk <- 3*(mean(params$x) - median(params$x))/sd(params$x) +``` + +`r if(sk > 0.5) {"It looks like you have some positive skewness because your mean is quite larger than your median. Watch out with this if you want to fit a model that assumes normality." }` + +`r if(sk < -0.5) {"It looks like you have some negative skewness because your mean is quite smaller than your median. Watch out with this if you want to fit a model that assumes normality." }` + +`r if(p1 > 25 & (p1/p3 <= 2 | (p1/p3 > 2 & p3 > 20))) {"A boxplot could be a suitable plot for these data:"}` + +```{r, echo = FALSE} +if(p1 > 25 & (p1/p3 <= 2 | (p1/p3 > 2 & p3 > 20))) boxplot(params$x) +``` +`r if(p1 > 25 & p1/p3 > 2 & p3 <= 20) {"For this trait a frequency table could produce a good display of the data:"}` + +```{r, echo = FALSE} +if(p1 > 25 & p1/p3 > 2 & p3 <= 20) table(params$x) +``` + +`r if(p1 <= 25) {"A dotplot could be a suitable plot for these data:"}` + +```{r, echo = FALSE} +if(p1 <= 25) stripchart(params$x) +``` + +`r if(p1 > 25 & p1/p3 < 2 & p2/p1 > 0.05) {"Although your trait seems to be on a continuous scale, there are some values with a very high frequency. What out with this if you plan to fit a model that assumes normality. You can see these values and their frequency below:"}` + +```{r, echo = FALSE} +if(p1 > 25 & p1/p3 < 2 & p2/p1 > 0.05) table(params$x)[table(params$x)/p1 > 0.05] +``` diff --git a/inst/hidap_agrofims/reports/pesekbaker.Rmd b/inst/hidap_agrofims/reports/pesekbaker.Rmd new file mode 100644 index 0000000..a36a674 --- /dev/null +++ b/inst/hidap_agrofims/reports/pesekbaker.Rmd @@ -0,0 +1,74 @@ +--- +title: "Pesek Baker index" +author: '`r params$author`' +date: '`r format(Sys.time(), "%B %d, %Y")`' +output: + html_document: + theme: united + pdf_document: + toc: true + highlight: zenburn + word_document: + highlight: "tango" +params: + traits: "no data" + geno: "no data" + env: "no data" + rep: "no data" + data: "no data" + means: "no data" + dgg: "no data" + units: "no data" + sf: "no data" + author: "no data" +--- + +```{r, echo = FALSE} +traits <- params$traits +geno <- params$geno +env <- params$env +rep <- params$rep +data <- params$data +means <- params$means +dgg <- params$dgg +units <- params$units +sf <- params$sf + +pbindex <- pesekbaker(traits, geno, env, rep, data, means, dgg, units, sf) +``` + +### Desired genetic gains +You have computed the Pesek-Baker index for traits `r traits` with the following desired genetic gains in actual units: +```{r, echo = FALSE} +pbindex$Desired.Genetic.Gains +``` + +### Standard deviation +The estimated genotypic standard deviations for these traits are: +```{r, echo = FALSE} +pbindex$Standard.Deviations +``` + +### The Pesek-Baker index + +The index coefficients for the Pesek-Baker index are: +```{r, echo = FALSE} +pbindex$Index.Coefficients +``` + +With this, the Pesek-Baker index for each genotype is shown below. As you see, genotype `r (pbindex$Pesek.Baker.Index[sort(pbindex$Pesek.Baker.Index$PB.Index, decreasing = T, index.return = T)$ix, ])[1,1]` is the one with the highest value. +```{r, echo = FALSE} +pbindex$Pesek.Baker.Index[sort(pbindex$Pesek.Baker.Index$PB.Index, decreasing = T, + index.return = T)$ix, ] +``` + +### The response to selection + +For a selection fraction of `r sf`, the responses to selection in actual units are: +```{r, echo = FALSE} +pbindex$Response.to.Selection +``` +and in standardized units: +```{r, echo = FALSE} +pbindex$Std.Response.to.Selection +``` diff --git a/inst/hidap_agrofims/reports/pvs1.Rmd b/inst/hidap_agrofims/reports/pvs1.Rmd new file mode 100644 index 0000000..43abd78 --- /dev/null +++ b/inst/hidap_agrofims/reports/pvs1.Rmd @@ -0,0 +1,219 @@ +--- +title: "`r params$title`" +subtitle: '`r params$subtitle`' +author: '`r params$author`' +date: '`r format(Sys.time(), "%B %d, %Y")`' +output: + html_document: + theme: united + toc: true + toc_depth: 3 + pdf_document: + toc: true + toc_depth: 3 + highlight: zenburn + word_document: + toc: true + toc_depth: 3 + highlight: "tango" +params: + data: "no data" + form: "no data" + title: "no data" + subtitle: "no data" + author: "no data" +--- + +```{r echo=FALSE} + +## Data + +data <- params$data +data <- data[, c("PHASE", "IDENTIFIED_CRITERIA", "SCORE_MEN", "SCORE_WOMEN", "SCORE_GLOBAL")] +data$IDENTIFIED_CRITERIA <- as.character(data$IDENTIFIED_CRITERIA) +colnames(data) <- c("phase", "Criteria", "Men", "Women", "Global") +data <- tidyr::gather(data, group, value, Men:Global) + +## Split by phase + +flow <- data[data$phase == "Flowering", ] +harv <- data[data$phase == "Harvest", ] +stor <- data[data$phase == "Storage", ] + +## Sort by number of votes + +temp <- flow[flow$group == "Global", c("Criteria", "value")] +orden <- temp$Criteria[sort(temp$value, decreasing = T, index.return = T)$ix] +flow$Criteria <- factor(flow$Criteria, levels = orden) + +temp <- harv[harv$group == "Global", c("Criteria", "value")] +orden <- temp$Criteria[sort(temp$value, decreasing = T, index.return = T)$ix] +harv$Criteria <- factor(harv$Criteria, levels = orden) + +temp <- stor[stor$group == "Global", c("Criteria", "value")] +orden <- temp$Criteria[sort(temp$value, decreasing = T, index.return = T)$ix] +stor$Criteria <- factor(stor$Criteria, levels = orden) + +## Count number of votes + +nvmflow <- sum(flow[flow$group == "Men", "value"], na.rm = T) +nvmharv <- sum(harv[harv$group == "Men", "value"], na.rm = T) +nvmstor <- sum(stor[stor$group == "Men", "value"], na.rm = T) + +nvwflow <- sum(flow[flow$group == "Women", "value"], na.rm = T) +nvwharv <- sum(harv[harv$group == "Women", "value"], na.rm = T) +nvwstor <- sum(stor[stor$group == "Women", "value"], na.rm = T) + +## Count number of voters + +nmflow <- round(nvmflow / 6) +nmharv <- round(nvmharv / 6) +nmstor <- round(nvmstor / 6) + +nwflow <- round(nvwflow / 6) +nwharv <- round(nvwharv / 6) +nwstor <- round(nvwstor / 6) + +## Compute percentage adjusted by gender + +flowp <- flow[flow$group == "Global", ] +flowp$value <- flowp$value / (nvmflow + nvwflow) +temp <- flow[flow$group != "Global", ] +temp[temp$group == "Men", "value"] <- temp[temp$group == "Men", "value"] / nvmflow / 2 +temp[temp$group == "Women", "value"] <- temp[temp$group == "Women", "value"] / nvwflow / 2 +temp <- docomp("sum", "value", "Criteria", "phase", temp) +temp$group <- "Global adjusted" +flowp <- rbind(flowp, temp) +flowp$value <- round(flowp$value * 100, 1) + +harvp <- harv[harv$group == "Global", ] +harvp$value <- harvp$value / (nvmharv + nvwharv) +temp <- harv[harv$group != "Global", ] +temp[temp$group == "Men", "value"] <- temp[temp$group == "Men", "value"] / nvmharv / 2 +temp[temp$group == "Women", "value"] <- temp[temp$group == "Women", "value"] / nvwharv / 2 +temp <- docomp("sum", "value", "Criteria", "phase", temp) +temp$group <- "Global adjusted" +harvp <- rbind(harvp, temp) +harvp$value <- round(harvp$value * 100, 1) + +storp <- stor[stor$group == "Global", ] +storp$value <- storp$value / (nvmstor + nvwstor) +temp <- stor[stor$group != "Global", ] +temp[temp$group == "Men", "value"] <- temp[temp$group == "Men", "value"] / nvmstor / 2 +temp[temp$group == "Women", "value"] <- temp[temp$group == "Women", "value"] / nvwstor / 2 +temp <- docomp("sum", "value", "Criteria", "phase", temp) +temp$group <- "Global adjusted" +storp <- rbind(storp, temp) +storp$value <- round(storp$value * 100, 1) + +``` + +# 1. Identification of selection criteria and voting process + +A group of farmers, men and women, and other stakeholders are gathered and, after explanation of the overall objectives of the trial, they are asked: What do you look for in a new variety of potato when the crop is at the flowering/harvest/post-harvest stage? In other words: When do you say that a variety is good or bad, when evaluating at this stage? + +A list is compiled of all the criteria mentioned by the different participants (i.e. free listing). Each criterium is listed and written on a paper bag (or card with accompanying container). Then, in order to select the most important traits for farmers a voting process is conducted. + +Farmers are requested to select the three criteria that each considers the most important with the following scheme. They can give: + +- Three votes for the most important characteristic. +- Two votes for the second most important characteristic. +- One vote for the third most important characteristic. + +Votes are recorded for men and women. + +# 2. Selection criteria at flowering + +`r if (nrow(flow) == 0) {"There were no data for selection criteria at flowering."}` +`r if (all(is.na(flow$Criteria))) {"There were no data for selection criteria at flowering."}` + + +```{r echo = FALSE, fig.height = 5, fig.width = 8} +if (nrow(flow) > 0 && !all(is.na(flow$Criteria)) ){ + ggplot(flow, aes(x = group, y = value, fill = Criteria)) + + geom_bar(stat = "identity", position = "dodge", color = "black") + + labs(title = "Voting for selection criteria of new varieties at flowering stage", + x = "Group", y = "Number of votes") + + geom_text(aes(label = value), vjust = 1.6, color = "white", + position = position_dodge(0.9), size = 3) +} +``` + +`r if (nrow(flow) > 0 && !all(is.na(flow$Criteria)) ) {"Below a percentage graph is shown. On the right panel the percentages are adjusted by gender, thus trying to reflect what would have been obtained if the number of men and women would be the same in the sample."}` + + + + +```{r echo = FALSE, fig.height = 5, fig.width = 8} +if (nrow(flow) > 0 && !all(is.na(flow$Criteria)) ) { + ggplot(flowp, aes(x = group, y = value, fill = Criteria)) + + geom_bar(stat = "identity", position = "dodge", color = "black") + + labs(title = "Voting for selection criteria of new varieties at flowering stage", + subtitle = "Percentages unadjusted and adjusted by gender", + x = "Group", y = "Percentage of votes") + + geom_text(aes(label = value), vjust = 1.6, color = "white", + position = position_dodge(0.9), size = 3) +} +``` + +# 3. Selection criteria at harvest + +`r if (nrow(harv) == 0) {"There were no data for selection criteria at harvest."}` +`r if (all(is.na(harv$Criteria))) {"There were no data for selection criteria at harvest."}` + + +```{r echo = FALSE, fig.height = 5, fig.width = 8} +if (nrow(harv) > 0 && !all(is.na(harv$Criteria)) ) { + ggplot(harv, aes(x = group, y = value, fill = Criteria)) + + geom_bar(stat = "identity", position = "dodge", color = "black") + + labs(title = "Voting for selection criteria of new varieties at harvest stage", + x = "Group", y = "Number of votes") + + geom_text(aes(label = value), vjust = 1.6, color = "white", + position = position_dodge(0.9), size = 3) +} +``` + +`r if (nrow(harv) > 0 && !all(is.na(harv$Criteria)) ) {"Below a percentage graph is shown. On the right panel the percentages are adjusted by gender, thus trying to reflect what would have been obtained if the number of men and women would be the same in the sample."}` + +```{r echo = FALSE, fig.height = 5, fig.width = 8} +if (nrow(harv) > 0 && !all(is.na(harv$Criteria)) ) { + ggplot(harvp, aes(x = group, y = value, fill = Criteria)) + + geom_bar(stat = "identity", position = "dodge", color = "black") + + labs(title = "Voting for selection criteria of new varieties at harvest stage", + subtitle = "Percentages unadjusted and adjusted by gender", + x = "Group", y = "Percentage of votes") + + geom_text(aes(label = value), vjust = 1.6, color = "white", + position = position_dodge(0.9), size = 3) +} +``` + +# 4. Selection criteria at post-harvest (storage) + +`r if (nrow(stor) == 0) {"There were no data for selection criteria at post-harvest."}` +`r if (all(is.na(stor$Criteria))) {"There were no data for selection criteria at post-harvest."}` + + +```{r echo = FALSE, fig.height = 5, fig.width = 8} +if (nrow(stor) > 0 && !all(is.na(stor$Criteria)) ) { + ggplot(stor, aes(x = group, y = value, fill = Criteria)) + + geom_bar(stat = "identity", position = "dodge", color = "black") + + labs(title = "Voting for selection criteria of new varieties at post-harvest stage", + x = "Group", y = "Number of votes") + + geom_text(aes(label = value), vjust = 1.6, color = "white", + position = position_dodge(0.9), size = 3) +} +``` + +`r if (nrow(stor) > 0 && !all(is.na(stor$Criteria)) ) {"Below a percentage graph is shown. On the right panel the percentages are adjusted by gender, thus trying to reflect what would have been obtained if the number of men and women would be the same in the sample."}` + +```{r echo = FALSE, fig.height = 5, fig.width = 8} +if (nrow(stor) > 0 && !all(is.na(stor$Criteria)) ) { + ggplot(storp, aes(x = group, y = value, fill = Criteria)) + + geom_bar(stat = "identity", position = "dodge", color = "black") + + labs(title = "Voting for selection criteria of new varieties at post-harvest stage", + subtitle = "Percentages unadjusted and adjusted by gender", + x = "Group", y = "Percentage of votes") + + geom_text(aes(label = value), vjust = 1.6, color = "white", + position = position_dodge(0.9), size = 3) +} +``` diff --git a/inst/hidap_agrofims/reports/pvs23.Rmd b/inst/hidap_agrofims/reports/pvs23.Rmd new file mode 100644 index 0000000..6361aba --- /dev/null +++ b/inst/hidap_agrofims/reports/pvs23.Rmd @@ -0,0 +1,319 @@ +--- +title: "`r params$title`" +subtitle: '`r params$subtitle`' +author: '`r params$author`' +date: '`r format(Sys.time(), "%B %d, %Y")`' +output: + html_document: + theme: united + toc: true + toc_depth: 3 + pdf_document: + toc: true + toc_depth: 3 + highlight: zenburn + word_document: + toc: true + toc_depth: 3 + highlight: "tango" +params: + data: "no data" + form: "no data" + title: "no data" + subtitle: "no data" + author: "no data" +--- + +```{r echo = FALSE} + +## Form + +if (params$form == 2) stage <- "flowering" +if (params$form == 3) stage <- "harvest" + +## Data + +data <- params$data +temp <- data[!is.na(data$MSGLO), ] +nrm <- nlevels(factor(temp$REP)) +temp <- data[!is.na(data$BSGLO), ] +nrb <- nlevels(factor(temp$REP)) +ds <- docomp("sum", c("MSM", "MSWM", "MSGLO", "BSM", "BSWM", "BSGLO"), "INSTN", data = data) +ds <- tidyr::gather(ds, group, value, MSM:BSGLO) +ds[ds$group %in% c("MSM", "MSWM", "MSGLO"), "trial"] <- "mother" +ds[ds$group %in% c("BSM", "BSWM", "BSGLO"), "trial"] <- "baby" +ds[ds$group %in% c("MSM", "BSM"), "group"] <- "Men" +ds[ds$group %in% c("MSWM", "BSWM"), "group"] <- "Women" +ds[ds$group %in% c("MSGLO", "BSGLO"), "group"] <- "Global" + +## Split by trial + +moth <- ds[ds$trial == "mother", -4] +baby <- ds[ds$trial == "baby", -4] +both <- docomp("sum", "value", c("INSTN", "group"), data = ds) + +## Sort by number of votes + +temp <- moth[moth$group == "Global", c("INSTN", "value")] +orden <- temp$INSTN[sort(temp$value, decreasing = T, index.return = T)$ix] +moth$INSTN <- factor(moth$INSTN, levels = orden) + +temp <- baby[baby$group == "Global", c("INSTN", "value")] +orden <- temp$INSTN[sort(temp$value, decreasing = T, index.return = T)$ix] +baby$INSTN <- factor(baby$INSTN, levels = orden) + +temp <- both[both$group == "Global", c("INSTN", "value")] +orden <- temp$INSTN[sort(temp$value, decreasing = T, index.return = T)$ix] +both$INSTN <- factor(both$INSTN, levels = orden) + +## Count number of votes + +nvmmoth <- sum(moth[moth$group == "Men", "value"], na.rm = T) +nvmbaby <- sum(baby[baby$group == "Men", "value"], na.rm = T) +nvmboth <- nvmmoth + nvmbaby + +nvwmoth <- sum(moth[moth$group == "Women", "value"], na.rm = T) +nvwbaby <- sum(baby[baby$group == "Women", "value"], na.rm = T) +nvwboth <- nvwmoth + nvwbaby + +## Count number of voters + +nmmoth <- round(nvmmoth / 6 / nrm) +nmbaby <- round(nvmbaby / 6 / nrb) + +nwmoth <- round(nvwmoth / 6 / nrm) +nwbaby <- round(nvwbaby / 6 / nrb) + +## Compute percentage adjusted by gender + +mothp <- moth[moth$group == "Global", ] +mothp$value <- mothp$value / (nvmmoth + nvwmoth) +temp <- moth[moth$group != "Global", ] +temp[temp$group == "Men", "value"] <- temp[temp$group == "Men", "value"] / nvmmoth / 2 +temp[temp$group == "Women", "value"] <- temp[temp$group == "Women", "value"] / nvwmoth / 2 +temp <- docomp("sum", "value", "INSTN", data = temp) +temp$group <- "Global adjusted" +mothp <- rbind(mothp, temp) +mothp$value <- round(mothp$value * 100, 1) + +babyp <- baby[baby$group == "Global", ] +babyp$value <- babyp$value / (nvmbaby + nvwbaby) +temp <- baby[baby$group != "Global", ] +temp[temp$group == "Men", "value"] <- temp[temp$group == "Men", "value"] / nvmbaby / 2 +temp[temp$group == "Women", "value"] <- temp[temp$group == "Women", "value"] / nvwbaby / 2 +temp <- docomp("sum", "value", "INSTN", data = temp) +temp$group <- "Global adjusted" +babyp <- rbind(babyp, temp) +babyp$value <- round(babyp$value * 100, 1) + +bothp <- both[both$group == "Global", ] +bothp$value <- bothp$value / (nvmboth + nvwboth) +temp <- both[both$group != "Global", ] +temp[temp$group == "Men", "value"] <- temp[temp$group == "Men", "value"] / nvmboth / 2 +temp[temp$group == "Women", "value"] <- temp[temp$group == "Women", "value"] / nvwboth / 2 +temp <- docomp("sum", "value", "INSTN", data = temp) +temp$group <- "Global adjusted" +bothp <- rbind(bothp, temp) +bothp$value <- round(bothp$value * 100, 1) + +``` + +# 1. Voting process for the identification of best genotypes at `r stage` + +A group of farmers, men and women, and other stakeholders are gathered and, after explanation of the overall objectives of the trial, they are asked to identify their three personal favorite genotypes. Then, they are requested to vote by giving: + +- Three votes for the best genotype. +- Two votes for the second. +- One vote for the third. + +Votes are recorded for men and women. + +# 2. Best genotypes at the mother plot + +`r if (nrm == 0) {"There were no data for the mother plot."}` +`r if (nrm > 0) paste("The genotypes have been planted following a randomized complete block design with", nrm, "blocks. A group of men and women voted independently for the best genotypes at each block, so each men and women voted", nrm, "times.")` + +```{r echo = FALSE, fig.height = 5, fig.width = 8} +if (nrm > 0) { + ggplot(moth, aes(x = group, y = value, fill = INSTN)) + + geom_bar(stat = "identity", position = "dodge", color = "black") + + labs(title = paste("Voting for best genotypes at", stage, "stage in the mother plot"), + x = "Group", y = "Number of votes") + + geom_text(aes(label = value), vjust = 1.6, color = "white", + position = position_dodge(0.9), size = 3) +} +``` + +`r if (nrm > 0) {"Below a percentage graph is shown. On the right panel the percentages are adjusted by gender, thus trying to reflect what would have been obtained if the number of men and women would be the same in the sample."}` + +```{r echo = FALSE, fig.height = 5, fig.width = 8} +if (nrm > 0) { + ggplot(mothp, aes(x = group, y = value, fill = INSTN)) + + geom_bar(stat = "identity", position = "dodge", color = "black") + + labs(title = paste("Voting for best genotypes at", stage, "stage in the mother plot"), + subtitle = "Percentages unadjusted and adjusted by gender", + x = "Group", y = "Percentage of votes") + + geom_text(aes(label = value), vjust = 1.6, color = "white", + position = position_dodge(0.9), size = 3) +} +``` + +# 3. Best genotypes at the baby plots + +`r if (nrb == 0) {"There were no data for baby plots."}` +`r if (nrb > 0) paste("The genotypes have been planted in", nrb, "baby plots. At each baby plot the complete set of genotypes is planted. A group of men and women voted independently for the best genotypes at each baby plot.")` + +```{r echo = FALSE, fig.height = 5, fig.width = 8} +if (nrb > 0) { + ggplot(baby, aes(x = group, y = value, fill = INSTN)) + + geom_bar(stat = "identity", position = "dodge", color = "black") + + labs(title = paste("Voting for best genotypes at", stage, "stage in the baby plots"), + x = "Group", y = "Number of votes") + + geom_text(aes(label = value), vjust = 1.6, color = "white", + position = position_dodge(0.9), size = 3) +} +``` + +`r if (nrb > 0) {"Below a percentage graph is shown. On the right panel the percentages are adjusted by gender, thus trying to reflect what would have been obtained if the number of men and women would be the same in the sample."}` + +```{r echo = FALSE, fig.height = 5, fig.width = 8} +if (nrb > 0) { + ggplot(babyp, aes(x = group, y = value, fill = INSTN)) + + geom_bar(stat = "identity", position = "dodge", color = "black") + + labs(title = paste("Voting for best genotypes at", stage, "stage in the baby plots"), + subtitle = "Percentages unadjusted and adjusted by gender", + x = "Group", y = "Percentage of votes") + + geom_text(aes(label = value), vjust = 1.6, color = "white", + position = position_dodge(0.9), size = 3) +} +``` + +# 4. Best genotypes at both, mother and baby plots + +`r if (nrm == 0) {"There were no data for the mother plot."}` +`r if (nrb == 0) {"There were no data for baby plots."}` + +`r if (nrb > 0 & nrm > 0) {"Here all the votes on the mother and baby plots are pooled together."}` + +```{r echo = FALSE, fig.height = 5, fig.width = 8} +if (nrb > 0 & nrm > 0) { + ggplot(both, aes(x = group, y = value, fill = INSTN)) + + geom_bar(stat = "identity", position = "dodge", color = "black") + + labs(title = paste("Voting for best genotypes at", stage, "stage in the mother and baby plots"), + x = "Group", y = "Number of votes") + + geom_text(aes(label = value), vjust = 1.6, color = "white", + position = position_dodge(0.9), size = 3) +} +``` + +`r if (nrb > 0 & nrm > 0) {"Below a percentage graph is shown. On the right panel the percentages are adjusted by gender, thus trying to reflect what would have been obtained if the number of men and women would be the same in the sample."}` + +```{r echo = FALSE, fig.height = 5, fig.width = 8} +if (nrb > 0 & nrm > 0) { + ggplot(bothp, aes(x = group, y = value, fill = INSTN)) + + geom_bar(stat = "identity", position = "dodge", color = "black") + + labs(title = paste("Voting for best genotypes at", stage, "stage in the mother and baby plots"), + subtitle = "Percentages unadjusted and adjusted by gender", + x = "Group", y = "Percentage of votes") + + geom_text(aes(label = value), vjust = 1.6, color = "white", + position = position_dodge(0.9), size = 3) +} +``` + +# 5. Friedman test for genotypes + +## 5.1. Men's votes at mother trial + +```{r echo = FALSE} +check <- st4gi::check.rcbd("MSM", "INSTN", "REP", data) +if (max(check$tfreq) > 0 & check$c4 == 1) { + ft <- with(data, friedman(REP, INSTN, MSM, group = T)) + ft$statistics + ft$groups + ft <- with(data, friedman(REP, INSTN, MSM, group = F)) + ft$comparison +} +``` + +`r if (max(check$tfreq) == 0) {"There were no data for men on the mother plot."}` +`r if (max(check$tfreq) > 0 & check$c4 == 0) {"There are some missing values. The design must be balanced to run the Friedman test."}` + +## 5.2. Women's votes at mother trial + +```{r echo = FALSE} +check <- st4gi::check.rcbd("MSWM", "INSTN", "REP", data) +if (max(check$tfreq) > 0 & check$c4 == 1) { + ft <- with(data, friedman(REP, INSTN, MSWM, group = T)) + ft$statistics + ft$groups + ft <- with(data, friedman(REP, INSTN, MSWM, group = F)) + ft$comparison +} +``` + +`r if (max(check$tfreq) == 0) {"There were no data for women on the mother plot."}` +`r if (max(check$tfreq) > 0 & check$c4 == 0) {"There are some missing values. The design must be balanced to run the Friedman test."}` + +## 5.3. Total votes at mother trial + +```{r echo = FALSE} +check <- st4gi::check.rcbd("MSGLO", "INSTN", "REP", data) +if (max(check$tfreq) > 0 & check$c4 == 1) { + ft <- with(data, friedman(REP, INSTN, MSGLO, group = T)) + ft$statistics + ft$groups + ft <- with(data, friedman(REP, INSTN, MSGLO, group = F)) + ft$comparison +} +``` + +`r if (max(check$tfreq) == 0) {"There were no data on the mother plot."}` +`r if (max(check$tfreq) > 0 & check$c4 == 0) {"There are some missing values. The design must be balanced to run the Friedman test."}` + +## 5.4. Men's votes at baby trials + +```{r echo = FALSE} +check <- st4gi::check.rcbd("BSM", "INSTN", "REP", data) +if (max(check$tfreq) > 0 & check$c4 == 1) { + ft <- with(data, friedman(REP, INSTN, BSM, group = T)) + ft$statistics + ft$groups + ft <- with(data, friedman(REP, INSTN, BSM, group = F)) + ft$comparison +} +``` + +`r if (max(check$tfreq) == 0) {"There were no data for men on the baby plots."}` +`r if (max(check$tfreq) > 0 & check$c4 == 0) {"There are some missing values. The design must be balanced to run the Friedman test."}` + +## 5.5. Women's votes at baby trials + +```{r echo = FALSE} +check <- st4gi::check.rcbd("BSWM", "INSTN", "REP", data) +if (max(check$tfreq) > 0 & check$c4 == 1) { + ft <- with(data, friedman(REP, INSTN, BSWM, group = T)) + ft$statistics + ft$groups + ft <- with(data, friedman(REP, INSTN, BSWM, group = F)) + ft$comparison +} +``` + +`r if (max(check$tfreq) == 0) {"There were no data for women on the baby plots."}` +`r if (max(check$tfreq) > 0 & check$c4 == 0) {"There are some missing values. The design must be balanced to run the Friedman test."}` + +## 5.6. Total votes at baby trials + +```{r echo = FALSE} +check <- st4gi::check.rcbd("BSGLO", "INSTN", "REP", data) +if (max(check$tfreq) > 0 & check$c4 == 1) { + ft <- with(data, friedman(REP, INSTN, BSGLO, group = T)) + ft$statistics + ft$groups + ft <- with(data, friedman(REP, INSTN, BSGLO, group = F)) + ft$comparison +} +``` + +`r if (max(check$tfreq) == 0) {"There were no data on the baby plots."}` +`r if (max(check$tfreq) > 0 & check$c4 == 0) {"There are some missing values. The design must be balanced to run the Friedman test."}` diff --git a/inst/hidap_agrofims/reports/pvs67.Rmd b/inst/hidap_agrofims/reports/pvs67.Rmd new file mode 100644 index 0000000..20136cf --- /dev/null +++ b/inst/hidap_agrofims/reports/pvs67.Rmd @@ -0,0 +1,133 @@ +--- +title: "`r params$title`" +subtitle: '`r params$subtitle`' +author: '`r params$author`' +date: '`r format(Sys.time(), "%B %d, %Y")`' +output: + html_document: + theme: united + toc: true + toc_depth: 3 + pdf_document: + toc: true + toc_depth: 3 + highlight: zenburn + word_document: + toc: true + toc_depth: 3 + highlight: "tango" +params: + data: "no data" + form: "no data" + title: "no data" + subtitle: "no data" + author: "no data" +--- + +```{r echo=FALSE} + +## Data + +data <- params$data +colnames(data)[2:4] <- c("Appe", "Tast", "Text") + +## Count number of men and women + +temp <- data[data$Sex == "M" | data$Sex == "Male", ] +nm <- nlevels(factor(temp$PanelNo)) +temp <- data[data$Sex == "F" | data$Sex == "Female", ] +nw <- nlevels(factor(temp$PanelNo)) + +## Aggregate data for principal components + +adg <- docomp("sum", c("Appe", "Tast", "Text"), "INSTN", data = data) +temp <- docomp("sum", c("Appe", "Tast", "Text"), c("INSTN", "Sex"), data = data) +adm <- temp[temp$Sex == "M" | temp$Sex == "Male", ] +adf <- temp[temp$Sex == "F" | temp$Sex == "Female", ] +colnames(adm)[3:5] <- c("Appe-M", "Tast-M", "Text-M") +colnames(adf)[3:5] <- c("Appe-F", "Tast-F", "Text-F") +ads <- cbind(adm[, c(1, 3:5)], adf[, 3:5]) + +rownames(ads) <- ads$INSTN +rownames(adg) <- adg$INSTN + +ads <- ads[, -1] +adg <- adg[, -1] + +``` + +# 1. Gathering of data + +Samples of all genotypes are boiled and presented on plates. Each genotype is evaluated about appearance and taste with the options: + +- 5 excellent, +- 3 fair, +- 1 poor, + +and about texture with: + +- 5 mealy or floury, +- 3 intermediate, +- 1 soggy or watery. + +For the graphs below, the following abbreviations are used: + +- `Appe`: Appearance. +- `Tast`: Taste. +- `Text`: Texture. +- `Appe-M`: Men opinion on appearance. +- `Tast-M`: Men opinion on taste. +- `Text-M`: Men opinion on texture. +- `Appe-W`: Women opinion on appearance. +- `Tast-W`: Women opinion on taste. +- `Text-W`: Women opinion on texture. + +# 2. Results + +A principal components analysis is shown to see the associations among the genotypes and the attributes, first with all the panelists together and then with panelists opinions differentiated by gender. + +```{r echo = FALSE, fig.height = 6, fig.width = 6} +princip <- prcomp(adg, center = T, scale. = T) +summary(princip) +factoextra::fviz_pca(princip, repel = T, + title = "Biplot of genotypes and attributes") +``` + +```{r echo = FALSE, fig.height = 6, fig.width = 6} +princip <- prcomp(ads, center = T, scale. = T) +summary(princip) +factoextra::fviz_pca(princip, repel = T, + title = "Biplot of genotypes and attributes by gender") +``` + +# 3. Friedman test for genotypes + +## 3.1. Analysis for appearance + +```{r echo = FALSE} +ft <- with(data, friedman(PanelNo, INSTN, Appe, group = T)) +ft$statistics +ft$groups +ft <- with(data, friedman(PanelNo, INSTN, Appe, group = F)) +ft$comparison +``` + +## 3.2. Analysis for taste + +```{r echo = FALSE} +ft <- with(data, friedman(PanelNo, INSTN, Tast, group = T)) +ft$statistics +ft$groups +ft <- with(data, friedman(PanelNo, INSTN, Tast, group = F)) +ft$comparison +``` + +## 3.3. Analysis for texture + +```{r echo = FALSE} +ft <- with(data, friedman(PanelNo, INSTN, Text, group = T)) +ft$statistics +ft$groups +ft <- with(data, friedman(PanelNo, INSTN, Text, group = F)) +ft$comparison +``` diff --git a/inst/hidap_agrofims/reports/pvs9.Rmd b/inst/hidap_agrofims/reports/pvs9.Rmd new file mode 100644 index 0000000..7b97b02 --- /dev/null +++ b/inst/hidap_agrofims/reports/pvs9.Rmd @@ -0,0 +1,133 @@ +--- +title: "`r params$title`" +subtitle: '`r params$subtitle`' +author: '`r params$author`' +date: '`r format(Sys.time(), "%B %d, %Y")`' +output: + html_document: + theme: united + toc: true + toc_depth: 3 + pdf_document: + toc: true + toc_depth: 3 + highlight: zenburn + word_document: + toc: true + toc_depth: 3 + highlight: "tango" +params: + data: "no data" + form: "no data" + title: "no data" + subtitle: "no data" + author: "no data" +--- + +```{r echo=FALSE} + +## Data + +data <- params$data +data <- data[, c("REP","INSTN", "STYPE", "SCORE_MEN","SCORE_WOMEN" ,"SCORE_GLOBAL")] +colnames(data)[4:6] <- c("Men", "Women", "Global") +nr <- nlevels(factor(data$REP)) +ds <- docomp("sum", c("Men", "Women", "Global"), "INSTN", data = data) +ds <- tidyr::gather(ds, group, value, Men:Global) + +## Sort by number of votes + +temp <- ds[ds$group == "Global", c("INSTN", "value")] +orden <- temp$INSTN[sort(temp$value, decreasing = T, index.return = T)$ix] +ds$INSTN <- factor(ds$INSTN, levels = orden) + +## Count number of votes + +nvm <- sum(ds[ds$group == "Men", "value"], na.rm = T) +nvw <- sum(ds[ds$group == "Women", "value"], na.rm = T) + +## Count number of voters + +nm <- round(nvm / 6 / nr) +nw <- round(nvw / 6 / nr) + +## Compute percentage adjusted by gender + +dsp <- ds[ds$group == "Global", ] +dsp$value <- dsp$value / (nvm + nvw) +temp <- ds[ds$group != "Global", ] +temp[temp$group == "Men", "value"] <- temp[temp$group == "Men", "value"] / nvm / 2 +temp[temp$group == "Women", "value"] <- temp[temp$group == "Women", "value"] / nvw / 2 +temp <- docomp("sum", "value", "INSTN", data = temp) +temp$group <- "Global adjusted" +dsp <- rbind(dsp, temp) +dsp$value <- round(dsp$value * 100, 1) + +``` + +# 1. Voting process for the identification of best genotypes at post-harvest stage + +A group of farmers, men and women, and other stakeholders are gathered and, after explanation of the overall objectives of the trial, they are asked to identify their three personal favorite genotypes. Then, they are requested to vote by giving: + +- Three votes for the best genotype. +- Two votes for the second. +- One vote for the third. + +Votes are recorded for men and women. + +# 2. Best genotypes + +The genotypes have been planted following a randomized complete block design with `r nr` blocks. A group of men and women voted independently for the best genotypes at each block, so each men and women voted `r nr` times. + +```{r echo = FALSE, fig.height = 5, fig.width = 8} +ggplot(ds, aes(x = group, y = value, fill = INSTN)) + + geom_bar(stat = "identity", position = "dodge", color = "black") + + labs(title = "Voting for best genotypes at post-harvest stage", + x = "Group", y = "Number of votes") + + geom_text(aes(label = value), vjust = 1.6, color = "white", + position = position_dodge(0.9), size = 3) +``` + +Below a percentage graph is shown. On the right panel the percentages are adjusted by gender, thus trying to reflect what would have been obtained if the number of men and women would be the same in the sample. + +```{r echo = FALSE, fig.height = 5, fig.width = 8} +ggplot(dsp, aes(x = group, y = value, fill = INSTN)) + + geom_bar(stat = "identity", position = "dodge", color = "black") + + labs(title = "Voting for best genotypes at post-harvest stage", + subtitle = "Percentages unadjusted and adjusted by gender", + x = "Group", y = "Percentage of votes") + + geom_text(aes(label = value), vjust = 1.6, color = "white", + position = position_dodge(0.9), size = 3) +``` + +# 3. Friedman test for genotypes + +## 3.1. Men's votes + +```{r echo = FALSE} +ft <- with(data, friedman(REP, INSTN, Men, group = T)) +ft$statistics +ft$groups +ft <- with(data, friedman(REP, INSTN, Men, group = F)) +ft$comparison +``` + +## 3.2. Women's votes + +```{r echo = FALSE} +ft <- with(data, friedman(REP, INSTN, Women, group = T)) +ft$statistics +ft$groups +ft <- with(data, friedman(REP, INSTN, Women, group = F)) +ft$comparison +``` + +## 3.3. Total votes + +```{r echo = FALSE} +ft <- with(data, friedman(REP, INSTN, Global, group = T)) +ft$statistics +ft$groups +ft <- with(data, friedman(REP, INSTN, Global, group = F)) +ft$comparison +``` diff --git a/inst/hidap_agrofims/reports/pvssg.Rmd b/inst/hidap_agrofims/reports/pvssg.Rmd new file mode 100644 index 0000000..430b185 --- /dev/null +++ b/inst/hidap_agrofims/reports/pvssg.Rmd @@ -0,0 +1,59 @@ +--- +title: "`r params$title`" +subtitle: '`r params$subtitle`' +author: '`r params$author`' +date: '`r format(Sys.time(), "%B %d, %Y")`' +output: + html_document: + theme: united + toc: true + toc_depth: 3 + pdf_document: + toc: true + toc_depth: 3 + highlight: zenburn + word_document: + toc: true + toc_depth: 3 + highlight: "tango" +params: + traits: "no data" + data: "no data" + title: "no data" + subtitle: "no data" + author: "no data" +--- + +```{r echo=FALSE} + +## Data + +traits <- params$traits +data <- params$data +rownames(data) <- data[, "INSTN"] +data <- data[, traits] + +## Determine traits with missing values + +lit <- map(data, anyNA) %>% unlist() +lgc_lit <- lit %>% as.vector() +lgc_val <- any(lgc_lit == TRUE) +names_trait <- names(lit[lgc_lit]) +msg <- paste(names_trait, collapse = ", ") %>% paste("The next traits have missing values: ",., sep = "") +``` + +`r if(lgc_val) {"There are missing values in some traits. For this reason, we could not perform a principal components analysis"}` +```{r conditional, echo = FALSE, eval= lgc_val, echo = FALSE} +cat(msg) +``` + +`r if(!lgc_val) { "A principal components analysis is shown to see the associations among the genotypes and some attributes."} ` + + +```{r echo = FALSE, eval= !lgc_val , fig.height = 6, fig.width = 6} +princip <- prcomp(data, center = T, scale = T) +summary(princip) +print(princip$x) +factoextra::fviz_pca(princip, repel = T, + title = "Biplot of genotypes and attributes") +``` diff --git a/inst/hidap_agrofims/reports/rcbd.Rmd b/inst/hidap_agrofims/reports/rcbd.Rmd old mode 100755 new mode 100644 index 71fa009..0a8b300 --- a/inst/hidap_agrofims/reports/rcbd.Rmd +++ b/inst/hidap_agrofims/reports/rcbd.Rmd @@ -1,5 +1,6 @@ --- -title: "Automatic report for a Randomized Complete Block Design (RCBD)" +title: "`r params$title`" +subtitle: '`r params$subtitle`' author: '`r params$author`' date: '`r format(Sys.time(), "%B %d, %Y")`' output: @@ -21,6 +22,8 @@ params: rep: "no data" data: "no data" maxp: "no data" + title: "no data" + subtitle: "no data" author: "no data" --- @@ -33,12 +36,13 @@ rep <- params$rep data <- params$data maxp <- params$maxp -lc <- check.rcbd(traits[1], geno, rep, data) +data[, geno] <- as.character(data[, geno]) +data[, rep] <- as.character(data[, rep]) ``` # 1. Model specification and data description -There are data from `r lc$nt` genotypes evaluated using a randomize complete block design with `r lc$nr` blocks. The statistical model is +There are data from `r nlevels(as.factor(data[, geno]))` genotypes evaluated using a randomize complete block design with `r nlevels(as.factor(data[, rep]))` blocks. The statistical model is $$ y_{ij} = \mu + \tau_i + \beta_j + \epsilon_{ij} $$ @@ -54,8 +58,14 @@ In this model we assume that the errors are independent and have a normal distri ```{r, include = FALSE} out <- NULL -for (i in 1:length(traits)) - out <- c(out, knit_expand('child_rcbd.Rmd')) +for (i in 1:length(traits)) { + lc <- check.rcbd(traits[i], geno, rep, data) + if (lc$c1 == 1 & lc$c2 == 1 & lc$c3 == 1 & lc$pmis <= maxp) + out <- c(out, knit_expand('child_rcbd.Rmd')) + else + out <- c(out, knit_expand('child_rcbd_fail.Rmd')) +} + ``` `r paste(knit(text = out), collapse = '\n')` diff --git a/inst/hidap_agrofims/reports/report_anova.Rmd b/inst/hidap_agrofims/reports/report_anova.Rmd deleted file mode 100755 index f298f5d..0000000 --- a/inst/hidap_agrofims/reports/report_anova.Rmd +++ /dev/null @@ -1,189 +0,0 @@ ---- -title: "ANOVA for a RCBD trial: `r params$meta$title`" -author: '`r params$author`' -date: '`r format(Sys.time(), "%B %d, %Y, %H:%Mh")`' -output: - html_document: - toc: true - toc_depth: 4 - pdf_document: - toc_depth: 4 - toc: true - word_document: - toc_depth: 4 - toc: true - highlight: "tango" -params: - meta: "no data" - trait: "no data" - treat: "no data" - rep: "no data" - data: "no data" - maxp: "no data" - author: "no data" - formats: TRUE - host: "unknown" ---- - -```{r, echo = FALSE} -library(knitr) -library(st4gi) -#library(rmdformats) - - -traits <- params$trait -treat <- params$treat -rep <- params$rep -data <- params$data -maxp <- params$maxp -meta <- params$meta -host <- params$host - -geno <- treat - -``` - - -```{r} -# This is an automatedly created report. - -# See more details in section on materials. -``` - -# Abstract - -```{r , echo = FALSE, results='hide'} - phs_lbl = "Advanced Trial" - ttl <- stringr::str_sub(meta$title, 1, 2) - if (stringr::str_detect(ttl, "PT")) {phs_lbl = "Preliminary Trial"} - if (stringr::str_detect(ttl, "OT")) {phs_lbl = "Observation Trial"} - brp_lbl = "Yield Breeding Program" -``` - -This trial has the identifier `r meta$title`. It was conducted under the supervision of `r meta$contact` as a `r phs_lbl` as part of a `r brp_lbl` in `r meta$site`, `r meta$country` in `r meta$year`. A total of `r length(unique(data[, treat]))` clones (including reference clones) were evaluated for `r length(params$trait)` traits. - - -# Materials and Methods -## Model specification and data description - -There is data from `r length(unique(data[, treat]))` treatments, evaluated using a randomize complete block design with `r unique(data[, rep])` blocks. The statistical model is -$$ -y_{ij} = \mu + \tau_i + \beta_j + \epsilon_{ij} -$$ -where - -* $y_{ij}$ is the observed response with treatment $i$ and block $j$. -* $\mu$ is the mean response over all treatments and blocks. -* $\tau_i$ is the effect for treatment $i$. -* $\beta_j$ is the effect for block $j$. -* $\epsilon_{ij}$ is the error term. - -In this model we assume that the errors are independent and have a normal distribution with common variance, that is, $\epsilon_{ij} \sim N(0,\sigma_{\epsilon}^2)$. - -The following traits are analyzed: **`r paste(params$trait, collapse = ", ")`**. - -```{r , echo = FALSE, results='hide'} -gid = unique(data$germplasmDbId) -gnm = unique(data$germplasmName) - - - path = "/stock/" - - #TODO change for genotypes - out = paste0("",gnm,"") - txt = paste0("") # TODO make trait choosable - out = paste( out, collapse = ", ") - gidOut = paste(txt, out) -``` - -The following germplasm was analyzed: `r paste(gidOut)`. - -## Computational tools -```{r, results = 'hide', echo=FALSE} -s <- sessionInfo() -``` - -This report was created using `r s$R.version` on a `r s$platform` running `r s$running` in `r s$locacel`. The following base packages were loaded: -**`r paste(unlist(s$basePkgs), collapse = ", ")`** and the following additional packages: -**`r paste(names(s$otherPkgs), collapse = ", ")`**. - -# Results -## Raw data -## Trait summaries -## Trait analyses {.tabset} - -```{r , echo = FALSE, results='hide'} - - data = data[, c(treat, "REP", traits)] - # - data[, treat] <- as.factor(data[, treat]) - -# exclude the response variable and empty variable for RF imputation - datas <- names(data)[!names(data) %in% c(treat, "PED1")] # TODO replace "PED1" by a search - #datas <- names(data)[!names(data) %in% c(treat)] - - x <- data[, datas] - - # x <- data[, trait] - for(i in 1:ncol(x)){ - x[, i] <- as.numeric(x[, i]) - } - # - y <- data[, treat] - - # determine which traits are having more than 10% missing values - - mval = 0.1 - n = ncol(data) - m = nrow(data) - off = round(mval * m, 0) - mval = logical(n) - mvan = numeric(n) - - # Remove all complete NA first - # for(i in 1:n) { - # #mvan[i] = nrow(data[is.na(data[, i]), ]) - # mval[i] = nrow(data[is.na(data[, i]), ]) == nrow(data) - # } - - - for(i in 1:n) { - mvan[i] = nrow(data[is.na(data[, i]), ]) - mval[i] = nrow(data[is.na(data[, i]), ]) / m * 100 <= off - } - mvnm = names(data)[!mval] - dat = data - if (any(is.na(x))){ - #capture.output({ - dat <- randomForest::rfImpute(x = x, y = y ) - names(dat)[1] <- treat - dat = dat[, mval] - } - #names(data)[1] <- "REP" - # xnm = names(dat) - trts = names(dat)[-c(1,2)] - dat[, treat] <- as.character(dat[, treat]) - #lc <- st4gi::checkdata01(trts, treat, rep, dat) - tbl = dat - -``` - - -The following traits were not analyzed since they had too many missing values (>= 10%): `r paste(mvnm)`. For the remaining traits missing values were imputed using all available information. - -Valid traits: **`r paste(names(dat)[-c(1,2)])`**. - -```{r, include = FALSE} -out <- NULL -for (k in 1:length(trts)) { - lc <- st4gi::checkdata01(trts[k], treat, rep, tbl) - out <- c(out, knit_expand('child_rcbd2_old.Rmd')) -} -``` - -`r paste(knit(text = out), collapse = '\n')` - diff --git a/inst/hidap_agrofims/reports/report_location.Rmd b/inst/hidap_agrofims/reports/report_location.Rmd deleted file mode 100755 index 5582c57..0000000 --- a/inst/hidap_agrofims/reports/report_location.Rmd +++ /dev/null @@ -1,34 +0,0 @@ ---- -title: "Location report" -author: "Reinhard Simon" -date: '`r format(Sys.time(), "%B %d, %Y, %H:%Mh")`' -output: - html_document: - theme: united -params: - locs: "no data" ---- - - - -```{r, echo=FALSE} -locs = params$locs - -locs = locs[!is.na(locs$lat), ] - -n = nrow(locs) -``` - -There are a total of **`r n`** locations in your view. -Latitude range is **`r min(locs$lat)` to `r max(locs$lat)`**. - - -You can also embed plots, for example: - -```{r, echo=FALSE} -data <- locs$altitude - n = length(data) - data <- as.numeric(data) - if(n < 1) return("no data") - hist(data, main = "Elevation", xlim = c(0,3600)) -``` diff --git a/inst/hidap_agrofims/www/internal_files/20180621143935-MGcd2VArN5MOQoU-rcbd.docx b/inst/hidap_agrofims/www/internal_files/20180621143935-MGcd2VArN5MOQoU-rcbd.docx new file mode 100755 index 0000000..9a9dc8e Binary files /dev/null and b/inst/hidap_agrofims/www/internal_files/20180621143935-MGcd2VArN5MOQoU-rcbd.docx differ diff --git a/inst/hidap_agrofims/www/internal_files/20180621144100-r1KmzUfd4sE2gUw-rcbd.docx b/inst/hidap_agrofims/www/internal_files/20180621144100-r1KmzUfd4sE2gUw-rcbd.docx new file mode 100755 index 0000000..e3a52db Binary files /dev/null and b/inst/hidap_agrofims/www/internal_files/20180621144100-r1KmzUfd4sE2gUw-rcbd.docx differ diff --git a/inst/hidap_agrofims/www/internal_files/20180621180638-IpfvTHE4vgVOaA5-rcbd.docx b/inst/hidap_agrofims/www/internal_files/20180621180638-IpfvTHE4vgVOaA5-rcbd.docx new file mode 100755 index 0000000..8b2d693 Binary files /dev/null and b/inst/hidap_agrofims/www/internal_files/20180621180638-IpfvTHE4vgVOaA5-rcbd.docx differ diff --git a/inst/hidap_agrofims/www/internal_files/20180621181850-jHhmkBzwpm7ZjZm-rcbd.docx b/inst/hidap_agrofims/www/internal_files/20180621181850-jHhmkBzwpm7ZjZm-rcbd.docx new file mode 100755 index 0000000..e59ddd4 Binary files /dev/null and b/inst/hidap_agrofims/www/internal_files/20180621181850-jHhmkBzwpm7ZjZm-rcbd.docx differ diff --git a/inst/hidap_agrofims/www/internal_files/2fcrd.Rmd b/inst/hidap_agrofims/www/internal_files/2fcrd.Rmd new file mode 100644 index 0000000..e631877 --- /dev/null +++ b/inst/hidap_agrofims/www/internal_files/2fcrd.Rmd @@ -0,0 +1,76 @@ +--- +title: "`r params$title`" +subtitle: '`r params$subtitle`' +author: '`r params$author`' +date: '`r format(Sys.time(), "%B %d, %Y")`' +output: + html_document: + theme: united + toc: true + toc_depth: 3 + pdf_document: + toc: true + toc_depth: 3 + highlight: zenburn + word_document: + toc: true + toc_depth: 3 + highlight: "tango" +params: + traits: "no data" + A: "no data" + B: "no data" + rep: "no data" + design: "no data" + data: "no data" + maxp: "no data" + title: "no data" + subtitle: "no data" + author: "no data" +--- + +```{r, echo = FALSE} +library(knitr) + +traits <- params$traits +A <- params$A +B <- params$B +rep <- params$rep +design <- params$design +data <- params$data +maxp <- params$maxp + +data[, A] <- as.character(data[, A]) +data[, B] <- as.character(data[, B]) +data[, rep] <- as.character(data[, rep]) +``` + +# 1. Model specification and data description + +The data frame has two factors with `r nlevels(as.factor(data[, A]))` and `r nlevels(as.factor(data[, B]))` levels. The experimental design is a completely randomized design with `r nlevels(as.factor(data[, rep]))` replications. The statistical model is +$$ +y_{ijk} = \mu + \alpha_i + \beta_j + (\alpha\beta)_{ij} + \epsilon_{ijk} +$$ +where + +* $y_{ijk}$ is the observed response with level $i$ of factor A, level $j$ of factor B, and replication $k$. +* $\mu$ is the mean response over all levels of factor A, factor B, and replications. +* $\alpha_i$ is the effect for level $i$ of factor A. +* $\beta_j$ is the effect for level $j$ of factor B. +* $(\alpha\beta)_{ij}$ is the interaction effect between level $i$ of factor A and level $j$ of factor B. +* $\epsilon_{ijk}$ is the error term. + +In this model we assume that the errors are independent and have a normal distribution with common variance, that is, $\epsilon_{ijk} \sim N(0,\sigma_{\epsilon}^2)$. + +```{r, include = FALSE} +out <- NULL +for (i in 1:length(traits)) { + lc <- check.2f(traits[i], A, B, rep, data) + if (lc$c1 == 1 & lc$c2 == 1 & lc$c3 == 1 & lc$pmis <= maxp) + out <- c(out, knit_expand('child_2f.Rmd')) + else + out <- c(out, knit_expand('child_2f_fail.Rmd')) +} +``` + +`r paste(knit(text = out), collapse = '\n')` diff --git a/inst/hidap_agrofims/www/internal_files/2frcbd.Rmd b/inst/hidap_agrofims/www/internal_files/2frcbd.Rmd new file mode 100644 index 0000000..1f02ae2 --- /dev/null +++ b/inst/hidap_agrofims/www/internal_files/2frcbd.Rmd @@ -0,0 +1,77 @@ +--- +title: "`r params$title`" +subtitle: '`r params$subtitle`' +author: '`r params$author`' +date: '`r format(Sys.time(), "%B %d, %Y")`' +output: + html_document: + theme: united + toc: true + toc_depth: 3 + pdf_document: + toc: true + toc_depth: 3 + highlight: zenburn + word_document: + toc: true + toc_depth: 3 + highlight: "tango" +params: + traits: "no data" + A: "no data" + B: "no data" + rep: "no data" + design: "no data" + data: "no data" + maxp: "no data" + title: "no data" + subtitle: "no data" + author: "no data" +--- + +```{r, echo = FALSE} +library(knitr) + +traits <- params$traits +A <- params$A +B <- params$B +rep <- params$rep +design <- params$design +data <- params$data +maxp <- params$maxp + +data[, A] <- as.character(data[, A]) +data[, B] <- as.character(data[, B]) +data[, rep] <- as.character(data[, rep]) +``` + +# 1. Model specification and data description + +The data frame has two factors with `r nlevels(as.factor(data[, A]))` and `r nlevels(as.factor(data[, B]))` levels. The experimental design is a randomized complete block design with `r nlevels(as.factor(data[, rep]))` blocks. The statistical model is +$$ +y_{ijk} = \mu + \alpha_i + \beta_j + (\alpha\beta)_{ij} + \gamma_k + \epsilon_{ijk} +$$ +where + +* $y_{ijk}$ is the observed response with level $i$ of factor A, level $j$ of factor B, and block $k$. +* $\mu$ is the mean response over all levels of factor A, factor B, and blocks. +* $\alpha_i$ is the effect for level $i$ of factor A. +* $\beta_j$ is the effect for level $j$ of factor B. +* $(\alpha\beta)_{ij}$ is the interaction effect between level $i$ of factor A and level $j$ of factor B. +* $\gamma_k$ is the effect of block $k$. +* $\epsilon_{ijk}$ is the error term. + +In this model we assume that the errors are independent and have a normal distribution with common variance, that is, $\epsilon_{ijk} \sim N(0,\sigma_{\epsilon}^2)$. + +```{r, include = FALSE} +out <- NULL +for (i in 1:length(traits)) { + lc <- check.2f(traits[i], A, B, rep, data) + if (lc$c1 == 1 & lc$c2 == 1 & lc$c3 == 1 & lc$pmis <= maxp) + out <- c(out, knit_expand('child_2f.Rmd')) + else + out <- c(out, knit_expand('child_2f_fail.Rmd')) +} +``` + +`r paste(knit(text = out), collapse = '\n')` diff --git a/inst/hidap_agrofims/www/internal_files/a01d.Rmd b/inst/hidap_agrofims/www/internal_files/a01d.Rmd new file mode 100644 index 0000000..b17a30e --- /dev/null +++ b/inst/hidap_agrofims/www/internal_files/a01d.Rmd @@ -0,0 +1,65 @@ +--- +title: "`r params$title`" +subtitle: '`r params$subtitle`' +author: '`r params$author`' +date: '`r format(Sys.time(), "%B %d, %Y")`' +output: + html_document: + theme: united + toc: true + toc_depth: 3 + pdf_document: + toc: true + toc_depth: 3 + highlight: zenburn + word_document: + highlight: "tango" + toc: true + toc_depth: 3 +params: + traits: "no data" + geno: "no data" + rep: "no data" + block: "no data" + k: "no data" + data: "no data" + title: "no data" + subtitle: "no data" + author: "no data" +--- + +```{r, echo = FALSE} +library(knitr) + +traits <- params$traits +geno <- params$geno +rep <- params$rep +block <- params$block +k <- params$k +data <- params$data +``` + +# 1. Model specification and data description + +There are data for `r nlevels(as.factor(data[, geno]))` genotypes tested using an alpha (0,1) design with `r nlevels(as.factor(data[, rep]))` replications and `r nlevels(as.factor(data[, block]))` incomplete blocks. In this design each replication is a complete block for the genotypes that is splitted in several incomplete blocks. The statistical model is +$$ +y_{ijk} = \mu + \tau_i + \gamma_j + \rho_{k(j)} + \epsilon_{ijk} +$$ +where + +* $y_{ijk}$ is the observed response with genotype $i$, replication $j$, incomplete block $k$. +* $\mu$ is the mean response over all genotypes and replications. +* $\tau_i$ is the effect for genotype $i$. +* $\gamma_j$ is the effect for replication $j$. +* $\rho_{k(j)}$ is the effect of the incomplete block $k$ which is nested into replication $j$. +* $\epsilon_{ijk}$ is the error term. + +In this model we assume that the errors are independent and have a normal distribution with common variance, that is, $\epsilon_{ijk} \sim N(0,\sigma_{\epsilon}^2)$. + +```{r, include = FALSE} +out <- NULL +for (i in 1:length(traits)) + out <- c(out, knit_expand('child_a01d.Rmd')) +``` + +`r paste(knit(text = out), collapse = '\n')` diff --git a/inst/hidap_agrofims/www/internal_files/abd.Rmd b/inst/hidap_agrofims/www/internal_files/abd.Rmd new file mode 100644 index 0000000..b5690c1 --- /dev/null +++ b/inst/hidap_agrofims/www/internal_files/abd.Rmd @@ -0,0 +1,71 @@ +--- +title: "`r params$title`" +subtitle: '`r params$subtitle`' +author: '`r params$author`' +date: '`r format(Sys.time(), "%B %d, %Y")`' +output: + html_document: + theme: united + toc: true + toc_depth: 3 + pdf_document: + toc: true + toc_depth: 3 + highlight: zenburn + word_document: + highlight: "tango" + toc: true + toc_depth: 3 +params: + traits: "no data" + geno: "no data" + rep: "no data" + data: "no data" + title: "no data" + subtitle: "no data" + author: "no data" +--- + +```{r, echo = FALSE} +library(knitr) + +traits <- params$traits +geno <- params$geno +rep <- params$rep +data <- params$data + +lc <- check.abd(traits[1], geno, rep, data) +``` + +# 1. Model specification and data description + +There are data for `r lc$nt.new` genotypes tested using an augmented block design with `r lc$nr` blocks and `r lc$nt.check` checks in each block. The statistical model is +$$ +y_{ij} = \mu + \tau_i + \beta_j + \epsilon_{ij} +$$ +where + +* $y_{ij}$ is the observed response with genotype $i$ and block $j$. +* $\mu$ is the mean response over all genotypes and blocks. +* $\tau_i$ is the effect for genotype $i$. +* $\beta_j$ is the effect for block $j$. +* $\epsilon_{ij}$ is the error term. + +In this model we assume that the errors are independent and have a normal distribution with common variance, that is, $\epsilon_{ij} \sim N(0,\sigma_{\epsilon}^2)$. + +```{r, include = FALSE} +out <- NULL + +for (i in 1:length(traits)) { + + lc <- check.abd(traits[i], geno, rep, data) + + if (lc$nt.check.2 > 1) { + out <- c(out, knit_expand('child_abd.Rmd')) + } else { + out <- c(out, knit_expand('child_abd_fail.Rmd')) + } +} +``` + +`r paste(knit(text = out), collapse = '\n')` diff --git a/inst/hidap_agrofims/www/internal_files/aov.Rmd b/inst/hidap_agrofims/www/internal_files/aov.Rmd new file mode 100644 index 0000000..d1d2492 --- /dev/null +++ b/inst/hidap_agrofims/www/internal_files/aov.Rmd @@ -0,0 +1,31 @@ +--- +title: "Report for an aov or lm object" +author: '`r params$author`' +date: '`r format(Sys.time(), "%B %d, %Y")`' +output: + html_document: + theme: united + pdf_document: + toc: true + highlight: zenburn + word_document: + highlight: "tango" +params: + x: "no data" + author: "no data" +--- + +Congratulations! You have fitted a linear model. The ANOVA table for your model is +```{r, echo = FALSE} +anova(params$x) +noterms <- dim(anova(params$x))[1] - 1 +pvalues <- anova(params$x)[1:noterms, 5] +``` + +`r if(noterms == 1 & sum(pvalues < 0.05) > 0) {"Your model has 1 term and it is significant. That is really good! Have you checked your assumptions?"}` + +`r if(noterms > 1 & sum(pvalues < 0.05) > 0) {paste("Your model has", noterms, "terms and some of them are significant. That is really good! Have you checked your assumptions?")}` + +`r if(noterms == 1 & sum(pvalues < 0.05) == 0) {"Your model has 1 term but it is not significant. I am really sorry, but don't forget that p-values are a function of sample size, so maybe you can try with more replications or a larger sample size next time."}` + +`r if(noterms > 1 & sum(pvalues < 0.05) == 0) {paste("Your model has", noterms, "terms but none of them are significant. I am really sorry, but don't forget that p-values are a function of sample size, so maybe you can try with more replications or a larger sample size next time.")}` diff --git a/inst/hidap_agrofims/www/internal_files/aovmet.Rmd b/inst/hidap_agrofims/www/internal_files/aovmet.Rmd new file mode 100644 index 0000000..ef9ca92 --- /dev/null +++ b/inst/hidap_agrofims/www/internal_files/aovmet.Rmd @@ -0,0 +1,71 @@ +--- +title: "ANOVA for a MET with a RCBD" +author: '`r params$author`' +date: '`r format(Sys.time(), "%B %d, %Y")`' +output: + html_document: + theme: united + pdf_document: + toc: true + highlight: zenburn + word_document: + highlight: "tango" +params: + trait: "no data" + geno: "no data" + env: "no data" + rep: "no data" + data: "no data" + maxp: "no data" + author: "no data" +--- + +```{r, echo = FALSE} +trait <- params$trait +geno <- params$geno +env <- params$env +rep <- params$rep +data <- params$data +maxp <- params$maxp + +lc <- check.2f(trait, geno, env, rep, data) +at <- suppressWarnings(aov.met(trait, geno, env, rep, data, maxp)) +if (lc$c4 == 0) + data[, trait] <- mve.met(trait, geno, env, rep, data, maxp)[, 5] +model <- aov(data[, trait] ~ data[, geno] + data[, env] + + data[, rep] %in% data[, env] + data[, geno]:data[, env]) +``` + +`r if(lc$c1 == 1 & lc$c2 == 1) {"You have fitted a linear model for a multi environment trial (MET) with a RCBD in each environment. The ANOVA table for your model is:"}` + +```{r, echo = FALSE} +at +``` + +`r if(lc$c4 == 0) paste("You have some missing values (", format(lc$pmis * 100, digits = 3), "%) and they have been estimated before running ANOVA.")` + +The p-values for your model are: + +- `r format(at[1, 5], digits = 4)` for genotypes `r if(at[1, 5] < 0.05) {"which is significant at the 5% level."} else {"which is not significant at the 5% level."}` +- `r format(at[2, 5], digits = 4)` for environments `r if(at[2, 5] < 0.05) {"which is significant at the 5% level."} else {"which is not significant at the 5% level."}` +- `r format(at[4, 5], digits = 4)` for the genotypes by environments interaction `r if(at[4, 5] < 0.05) {"which is significant at the 5% level."} else {"which is not significant at the 5% level."}` + +`r if(at[4, 5] < 0.05) {"Because interaction is significant you should want to run a stability analysis. Keep also in mind that a significant interaction means that the differences in response of the genotypes are not the same in all the environments. Therefore, on an individual analysis you could find significant differences among genotypes for some environments and non-significant differences for some others, and the difference for any pair of genotypes could be in different directions and magnitudes depending on the environment."}` + +Below you can see a table of means for genotypes, environments, and interaction: + +```{r, echo = FALSE} +tapply(data[, trait], data[, geno], mean) +tapply(data[, trait], data[, env], mean) +tapply(data[, trait], list(data[, geno], data[, env]), mean) +``` + +Don't forget the assumptions of the model. It is supposed that the error has a normal distribution with the same variance for all the genotypes and evironments. The following plots must help you evaluate this: + +```{r, echo = FALSE, fig.height = 5, fig.width = 10} +par(mfrow = c(1, 2)) +plot(model, which = 1) +plot(model, which = 2) +``` + +Funnel shapes for the first plot may suggest heterogeneity of variances while departures from the theoretical normal line are symptoms of lack of normality. diff --git a/inst/hidap_agrofims/www/internal_files/child_2f.Rmd b/inst/hidap_agrofims/www/internal_files/child_2f.Rmd new file mode 100644 index 0000000..4a7940f --- /dev/null +++ b/inst/hidap_agrofims/www/internal_files/child_2f.Rmd @@ -0,0 +1,59 @@ +`r i = {{i}}` + +```{r, echo = FALSE} +lc <- check.2f(traits[i], A, B, rep, data) +if (lc$c4 == 0) + data$est <- mve.2f(traits[i], A, B, rep, design, data, maxp)[, 5] else + data$est <- data[, traits[i]] +``` + +# {{i+1}}. Analysis for trait `r traits[i]` + +`r if (lc$c4 == 1) {"There are no missing values for this trait; the design is balanced."}` + +`r if (lc$c4 == 0) paste("There are some missing values (", format(lc$pmis * 100, digits = 3), "%) and they have been estimated for the descriptive statistics and ANOVA.", sep = "")` + +## {{i+1}}.1. Descriptive statistics + +### {{i+1}}.1.1. Means by factor A levels + +```{r, echo = FALSE} +tapply(data$est, data[, A], mean) +``` + +### {{i+1}}.1.2. Means by factor B levels + +```{r, echo = FALSE} +tapply(data$est, data[, B], mean) +``` + +### {{i+1}}.1.3. Means by factor A and factor B levels + +```{r, echo = FALSE} +tapply(data$est, list(data[, A], data[, B]), mean) +``` + +## {{i+1}}.2. ANOVA + +### {{i+1}}.2.1. Checking assumptions + +As it was stated in section 1, it is supposed that the error has a normal distribution with the same variance for all the combinations among the levels of both factors. The following plots help to evaluate this assumptions: + +```{r, echo = FALSE, fig.height = 5, fig.width = 10} +if (design == "crd") + model <- aov(data[, traits[i]] ~ data[, A] * data[, B]) +if (design == "rcbd") + model <- aov(data[, traits[i]] ~ data[, A] * data[, B] + data[, rep]) +par(mfrow = c(1, 2)) +suppressWarnings(plot(model, which = 1)) +suppressWarnings(plot(model, which = 2)) +``` + +Funnel shapes for the first plot may suggest heterogeneity of variances while departures from the theoretical normal line are symptoms of lack of normality. + +### {{i+1}}.2.2. ANOVA table + +```{r, echo = FALSE} +at <- suppressWarnings(aov.2f(traits[i], A, B, rep, design, data, maxp)) +at +``` diff --git a/inst/hidap_agrofims/www/internal_files/child_2f_fail.Rmd b/inst/hidap_agrofims/www/internal_files/child_2f_fail.Rmd new file mode 100644 index 0000000..31e7871 --- /dev/null +++ b/inst/hidap_agrofims/www/internal_files/child_2f_fail.Rmd @@ -0,0 +1,22 @@ +`r i = {{i}}` + +# {{i+1}}. Analysis for trait `r traits[i]` + +```{r, echo = FALSE} +lc <- check.2f(traits[i], A, B, rep, data) +``` + +`r if (lc$c2 == 0) {"There is only one replication. Analysis is not possible with one replication."}` + +`r if (lc$c2 == 1 & lc$c3 == 0) {"There is more than one datum for at least on combination of the factors in at least one replication. This could be the result of a mislabeling for the levels of the factors. The table below shows the frequencies of valid data for each combination of the levels of the factors in each replication. Solve this to proceed."}` + +`r if (lc$c1 == 0 & lc$c2 == 1 & lc$c3 == 1) {"There is at least one combination of the factors without data. The table below shows the frequencies of valid data for each combination of the levels of the factors. The analysis cannot be produced if there are combinations of the factors without data. Solve this to proceed."}` + +`r if (lc$pmis > maxp & lc$c1 == 1 & lc$c2 == 1 & lc$c3 == 1) paste("There are too many missing values (", format(lc$pmis * 100, digits = 3), "%). The table below shows the frequencies of valid data for each combination of the levels of the factors. This procedure estimates up to 10%. Solve this to proceed.", sep = "")` + +```{r, echo = FALSE} +if (lc$c2 == 1 & lc$c3 == 1) + lc$tfreq +if (lc$c2 == 1 & lc$c3 == 0) + lc$tfreqr +``` diff --git a/inst/hidap_agrofims/www/internal_files/child_a01d.Rmd b/inst/hidap_agrofims/www/internal_files/child_a01d.Rmd new file mode 100644 index 0000000..13fb0a4 --- /dev/null +++ b/inst/hidap_agrofims/www/internal_files/child_a01d.Rmd @@ -0,0 +1,43 @@ +`r i = {{i}}` + +# {{i+1}}. Analysis for trait `r traits[i]` + +```{r, echo = FALSE, results = 'hide'} +y <- data[, traits[i]] +n_geno <- length(unique(data[, geno])) + +data[, block] <- factor(data[, block]) +data[, geno] <- factor(data[, geno]) +data[, rep] <- factor(data[, rep]) + + + +if(n_geno>=50){ + model <- pepa::PBIB.test.mod(data[, block], data[, geno], data[, rep], y, k, method = "VC") +} else { + model <- agricolae::PBIB.test(data[, block], data[, geno], data[, rep], y, k, method = "VC") +} +``` + +## {{i+1}}.1. ANOVA + +```{r, echo = FALSE} +model$ANOVA +model$statistics +``` + +## {{i+1}}.2. Adjusted means + +```{r, echo = FALSE} +model$means +``` + +## {{i+1}}.3. LSD test + +```{r, echo = FALSE} +if(n_geno>= 50){ + model$groups[,-3] +} else { + model$groups +} +``` diff --git a/inst/hidap_agrofims/www/internal_files/child_abd.Rmd b/inst/hidap_agrofims/www/internal_files/child_abd.Rmd new file mode 100644 index 0000000..3116cf8 --- /dev/null +++ b/inst/hidap_agrofims/www/internal_files/child_abd.Rmd @@ -0,0 +1,62 @@ +`r i = {{i}}` + +# {{i+1}}. Analysis for trait `r traits[i]` + +```{r, echo = FALSE} +lc <- check.abd(traits[i], geno, rep, data) + +if (lc$nt.check.0 > 0) { + cond <- !(data[, geno] %in% lc$check.0) & !is.na(data[, traits[i]]) + temp <- subset(data, cond) + } else { + cond <- !is.na(data[, traits[i]]) + temp <- subset(data, cond) + } + +if (lc$nt.check.1 > 0){ + cond <- !(temp[, geno] %in% lc$check.1) + temp <- subset(temp, cond) +} + +y <- temp[, traits[i]] +model <- agricolae::DAU.test(temp[, rep], temp[, geno], y) +``` + +## {{i+1}}.1. General setting + +`r if(lc$nmis.new == 0 & lc$nmis.check == 0) {"For this trait there is no missing values."}` +`r if(lc$nmis.new == 1) {"There is one genotype with missing value. This genotype has been removed."}` +`r if(lc$nmis.new > 1) paste("There are", lc$nmis.new, "genotypes with missing values. These genotypes have been removed.")` +`r if(lc$nmis.new > 0) paste("Therefore, there are", lc$nt.new - lc$nmis.new, "genotypes included in the analysis.")` + +`r if(lc$nt.check.0 == 1) paste("There is one check without data: ", lc$check.0, ". This check has been removed.", sep = "")` +`r if(lc$nt.check.0 > 1) paste("There are ", lc$nt.check.0, " checks without data: ", sep = "")` +```{r, echo = FALSE} +if(lc$nt.check.0 > 1) lc$check.0 +``` +`r if(lc$nt.check.0 > 1) {"These checks have been removed."}` + +`r if(lc$nt.check.1 == 1) paste("There is one check with data in only one block: ", lc$check.1, ". Checks need at least two replications so this check has been removed.", sep = "")` +`r if(lc$nt.check.1 > 1) paste("There are ", lc$nt.check.1, " checks with data in only one block: ", sep = "")` +```{r, echo = FALSE} +if(lc$nt.check.1 > 1) lc$check.1 +``` +`r if(lc$nt.check.1 > 1) {"Checks need at least two replications so these checks have been removed."}` + +## {{i+1}}.2. Adjusted means + +```{r, echo = FALSE} +model$means +``` + +## {{i+1}}.3. Overall mean and CV + +```{r, echo = FALSE} +model$statistics +``` + +## {{i+1}}.4. LSD test + +```{r, echo = FALSE} +model$groups +``` diff --git a/inst/hidap_agrofims/www/internal_files/child_abd_fail.Rmd b/inst/hidap_agrofims/www/internal_files/child_abd_fail.Rmd new file mode 100644 index 0000000..6b60199 --- /dev/null +++ b/inst/hidap_agrofims/www/internal_files/child_abd_fail.Rmd @@ -0,0 +1,5 @@ +`r i = {{i}}` + +# {{i+1}}. Analysis for trait `r traits[i]` + +You need at least two checks with at least two valid replications to run ABD. diff --git a/inst/hidap_agrofims/www/internal_files/child_crd.Rmd b/inst/hidap_agrofims/www/internal_files/child_crd.Rmd new file mode 100644 index 0000000..ad23992 --- /dev/null +++ b/inst/hidap_agrofims/www/internal_files/child_crd.Rmd @@ -0,0 +1,69 @@ +`r i = {{i}}` + +# {{i+1}}. Analysis for trait `r traits[i]` + +```{r, echo = FALSE} +nt <- nlevels(as.factor(data[, geno])) +model <- aov(data[, traits[i]] ~ data[, geno]) +model$terms[[2]] <- traits[i] +at <- anova(model) +rownames(at)[1] <- geno +``` + +## {{i+1}}.1. ANOVA + +You have fitted a linear model for a CRD. The ANOVA table for your model is: + +```{r, echo = FALSE} +at +``` + +The coefficient of variation for this experiment is `r format(agricolae::cv.model(model), digits = 4)`%. +The p-value for genotypes is `r format(at[1, 5], digits = 4)` +`r if(at[1, 5] < 0.05) {"which is significant at the 5% level."} else {"which is not significant at the 5% level."}` + +## {{i+1}}.2. Assumptions + +Don't forget the assumptions of the model. It is supposed that the errors are independent with a normal distribution and with the same variance for all the genotypes. The following residuals plots must help you evaluate this: + +```{r, echo = FALSE, fig.height = 5, fig.width = 10} +par(mfrow = c(1, 2)) +plot(model, which = 1) +plot(model, which = 2) +``` + +Any trend in the residuals in the left plot would violate the assumption of independence while a trend in the variability of the residuals --for instance a funnel shape-- suggests heterogeneity of variances. Departures from the theoretical normal line on the right plot are symptoms of lack of normality. + +## {{i+1}}.3. Genotype means + +`r if(at[1, 5] < 0.05) {"Below are the sorted means for each genotype with letters indicating if there are significant differences using the multiple comparisons method of Tukey at the 5% level."} else {"The means of your genotypes are:"}` + +```{r, echo = FALSE} +if (at[1, 5] < 0.05) + agricolae::HSD.test(data[, traits[i]], data[, geno], at[2, 1], at[2, 3])$groups else + tapply(data[, traits[i]], data[, geno], mean, na.rm = TRUE) +``` + +`r if(nt < 10) {"It is always good to have some visualization of the data. Because the number of genotypes in your experiment is not so big, we can plot the data for each genotypes:"}` + +```{r, echo = FALSE} +if (nt < 10) msdplot(traits[i], geno, data, conf = 1) +``` + +## {{i+1}}.4. Variance components + +Below are the variance components for this model, under the assumption that genotypes are random. Here the model is fitted using REML. + +```{r, echo = FALSE} +y <- data[, traits[i]] +fg <- data[, geno] +ff <- as.formula(y ~ (1|fg)) +model <- lme4::lmer(ff) +vc <- data.frame(lme4::VarCorr(model)) +vc[1, 1] <- geno +rownames(vc) <- vc[, 1] +vc <- vc[, c(4, 5)] +colnames(vc) <- c("Variance", "Std.Dev.") +vc +``` + diff --git a/inst/hidap_agrofims/www/internal_files/child_lxt.Rmd b/inst/hidap_agrofims/www/internal_files/child_lxt.Rmd new file mode 100644 index 0000000..dff3fe7 --- /dev/null +++ b/inst/hidap_agrofims/www/internal_files/child_lxt.Rmd @@ -0,0 +1,42 @@ +`r i = {{i}}` + +# {{i}}. Analysis for trait `r traits[i]` + +```{r, echo = FALSE} +model <- aov.lxt(traits[i], lines, testers, rep, data) +``` + +#### GCA effects for lines plot + +```{r, echo = FALSE} +barplot(model$GCA.le[, 1], col = "lightblue", las = 2, cex.names = 0.8, + ylab = "GCA effects") +``` + +#### Mid parent heterosis increment plot + +```{r, echo = FALSE} +# Means + +means <- docomp('mean', traits[i], c(lines, testers), data = data) +hhh <- means[!is.na(means[, lines]) & !is.na(means[, testers]), ] +line.means <- means[!is.na(means[, lines]) & is.na(means[, testers]), ] +test.means <- means[is.na(means[, lines]) & !is.na(means[, testers]), ] + +# Colnames + +colnames(line.means)[3] <- paste(lines, 'means', sep = "_") +colnames(test.means)[3] <- paste(testers, 'means', sep = "_") + +# Merge data frames + +hhh <- merge(hhh, line.means[, -2], by = lines) +hhh <- merge(hhh, test.means[, -1], by = testers) +hhh$het <- hhh[, 3] / (hhh[, 4] + hhh[, 5]) * 200 - 100 + +# Graph + +barplot(hhh$het, col = "lightblue", las = 2, cex.names = 0.8, + ylab = "Heterosis increment (%)", + names.arg = paste(hhh[, lines], hhh[, testers], sep = "-")) +``` diff --git a/inst/hidap_agrofims/www/internal_files/child_met.Rmd b/inst/hidap_agrofims/www/internal_files/child_met.Rmd new file mode 100644 index 0000000..3709251 --- /dev/null +++ b/inst/hidap_agrofims/www/internal_files/child_met.Rmd @@ -0,0 +1,242 @@ +`r i = {{i}}` + +```{r, echo = FALSE} +lc <- check.2f(traits[i], geno, env, rep, data) +if (lc$c4 == 0) + data$est <- mve.met(traits[i], geno, env, rep, data, maxp)[, 5] else + data$est <- data[, traits[i]] +``` + +# {{i+1}}. Analysis for trait `r traits[i]` + +`r if (lc$c4 == 1) {"There are no missing values for this trait; the design is balanced."}` + +`r if (lc$c4 == 0) paste("There are some missing values (", format(lc$pmis * 100, digits = 3), "%) and they have been estimated for the descriptive statistics, ANOVA, regression stability analysis and Tai sections.", sep = "")` + +## {{i+1}}.1. Descriptive statistics + +### {{i+1}}.1.1. Means by genotypes + +```{r, echo = FALSE} +tapply(data$est, data[, geno], mean) +``` + +### {{i+1}}.1.2. Means by environments + +```{r, echo = FALSE} +tapply(data$est, data[, env], mean) +``` + +### {{i+1}}.1.3. Means by genotypes and environments + +```{r, echo = FALSE} +tapply(data$est, list(data[, geno], data[, env]), mean) +``` + +## {{i+1}}.2. ANOVA + +### {{i+1}}.2.1. Checking assumptions + +As it was stated in section 1, it is supposed that the error has a normal distribution with the same variance for all the genotypes and environments. The following plots help to evaluate this assumptions: + +```{r, echo = FALSE, fig.height = 5, fig.width = 10} +model <- aov(data[, traits[i]] ~ data[, geno] + data[, env] + + data[, rep] %in% data[, env] + data[, geno]:data[, env]) +par(mfrow = c(1, 2)) +suppressWarnings(plot(model, which = 1)) +suppressWarnings(plot(model, which = 2)) +``` + +Funnel shapes for the first plot may suggest heterogeneity of variances while departures from the theoretical normal line are symptoms of lack of normality. + +### {{i+1}}.2.2. ANOVA table + +For this analysis it is assumed that genotypes and environments have fixed effects and that the blocks are random. + +```{r, echo = FALSE} +at <- suppressWarnings(aov.met(traits[i], geno, env, rep, data, maxp)) +at +``` + +The coefficient of variation for this experiment is `r format(agricolae::cv.model(model), digits = 4)`%. The p-values for the model are: `r format(at[1, 5], digits = 4)` for genotypes `r if (at[1, 5] < 0.05) {" which is significant at the 5% level, "} else {" which is not significant at the 5% level, "}` `r format(at[2, 5], digits = 4)` for environments `r if (at[2, 5] < 0.05) {" which is significant at the 5% level,"} else {" which is not significant at the 5% level,"}` and `r format(at[4, 5], digits = 4)` for the genotypes by environments interaction `r if (at[4, 5] < 0.05) {" which is significant at the 5% level."} else {" which is not significant at the 5% level."}` + +`r if(at[1, 5] < 0.05) {"In the next two sections the least significance difference method and the multiple comparisons method of Tukey are used to evaluate differences among genotypes, both at the 5% level. However take into account that differences among genotypes can be obscured by the interaction effects, and that in the case of strong interaction, differences among genotypes must depend on the specific environments."} else {"Because the effect of genotypes was not significant in the ANOVA, multiple comparison tests are not presented."}` + +`r if (at[1, 5] < 0.05) {paste("### ", {{i+1}}, ".2.3. LSD test", sep = "")}` + +```{r, echo = FALSE} +if (at[1, 5] < 0.05) + agricolae::LSD.test(data[, traits[i]], data[, geno], at[5, 1], at[5, 3])$groups +``` + +`r if (at[1, 5] < 0.05) {paste("### ", {{i+1}}, ".2.4. Tukey test", sep = "")}` + +```{r, echo = FALSE} +if (at[1, 5] < 0.05) + agricolae::HSD.test(data[, traits[i]], data[, geno], at[5, 1], at[5, 3])$groups +``` + +`r if (at[1, 5] < 0.05) {paste("### ", {{i+1}}, ".2.5. Variance components estimation", sep = "")} else {paste("### ", {{i+1}}, ".2.3. Variance components estimation", sep = "")}` + +Under the assumption that all the factors (genotypes, environments, and blocks) have random effects, below it is shown the variance components estimation. Here the model is estimated by REML (Restricted Maximum Likelihood) and the original data without the estimation of missing values is used. + +```{r, echo = FALSE} +y <- data[, traits[i]] +fg <- data[, geno] +fe <- data[, env] +fr <- data[, rep] +ff <- as.formula(y ~ (1|fg) + (1|fg:fe) + (1|fe/fr)) +model.reml <- lme4::lmer(ff) +vc <- data.frame(lme4::VarCorr(model.reml)) +vg <- vc[vc[, 1] == "fg", 4] +vgxe <- vc[vc[, 1] == "fg:fe", 4] +vr <- vc[vc[, 1] == "Residual", 4] +vc[vc[, 1] == "fg", 1] <- geno +vc[vc[, 1] == "fe", 1] <- env +vc[vc[, 1] == "fg:fe", 1] <- paste(geno, ":", env, sep = "") +vc[vc[, 1] == "fr:fe", 1] <- paste(rep, "(", env, ")", sep = "") +rownames(vc) <- vc[, 1] +vc <- vc[, c(4, 5)] +colnames(vc) <- c("Variance", "Std.Dev.") +h2 <- vg / (vg + vgxe / lc$nb + vr / lc$nb / lc$nr) * 100 +vc +``` + +With these variance estimates, the broad sense heritability results `r paste(format(h2, digits = 4), "%", sep = "")`. + +## {{i+1}}.3. Stability analysis + +`r if (at[4, 5] > 0.05 | lc$nb <= 2) {"This analysis is not shown because:"}` + +`r if (at[4, 5] > 0.05) {"- Interaction is non significant."}` +`r if (lc$nb <= 2) {"- There are only 2 environments. At least 3 are needed."}` + +`r if (at[4, 5] < 0.05 & lc$nb > 2) {"Because interaction is significant a stability analysis is presented."}` + +`r if (at[4, 5] < 0.05 & lc$nb > 2) {paste("### ", {{i+1}}, ".3.1. AMMI", sep = "")}` + +`r if (at[4, 5] < 0.05 & lc$nb > 2) {"#### AMMI biplots"}` + +```{r, echo = FALSE, fig.align = 'center', fig.width = 8, fig.height = 8} +if (at[4, 5] < 0.05 & lc$nb > 2) { + ammimodel <- suppressWarnings(ammi(traits[i], geno, env, rep, data)) + plot(ammimodel, biplot = 1) +} +``` + +```{r, echo = FALSE, fig.align = 'center', fig.height = 8, fig.width = 8} +if (at[4, 5] < 0.05 & lc$nb > 2) { + plot(ammimodel, biplot = 2) +} +``` + +`r if (at[4, 5] < 0.05 & lc$nb > 2) {"#### Interaction effects"}` +```{r, echo = FALSE} +if (at[4, 5] < 0.05 & lc$nb > 2) ammimodel$Interaction_effects +``` + +`r if (at[4, 5] < 0.05 & lc$nb > 2) {"#### PC-values for genotypes"}` + +```{r, echo = FALSE} +if (at[4, 5] < 0.05 & lc$nb > 2) ammimodel$PC_values_genotypes +``` + +`r if (at[4, 5] < 0.05 & lc$nb > 2) {"#### PC-values for environments"}` + +```{r, echo = FALSE} +if (at[4, 5] < 0.05 & lc$nb > 2) ammimodel$PC_values_environments +``` + +`r if (at[4, 5] < 0.05 & lc$nb > 2) {"#### PC contributions"}` + +```{r, echo = FALSE} +if (at[4, 5] < 0.05 & lc$nb > 2) ammimodel$Contribution_PCs +``` + +`r if (at[4, 5] < 0.05 & lc$nb > 2) {paste("### ", {{i+1}}, ".3.2. GGE", sep = "")}` + +`r if (at[4, 5] < 0.05 & lc$nb > 2) {"#### GGE biplots"}` + +```{r, echo = FALSE, fig.align = 'center', fig.height = 8, fig.width = 8} +if (at[4, 5] < 0.05 & lc$nb > 2) { + ggemodel <- suppressWarnings(ammi(traits[i], geno, env, rep, data, method = "gge")) + plot(ggemodel, biplot = 1) +} +``` + +```{r, echo = FALSE, fig.align = 'center', fig.height = 8, fig.width = 8} +if (at[4, 5] < 0.05 & lc$nb > 2) { + plot(ggemodel, biplot = 2) +} +``` + +`r if (at[4, 5] < 0.05 & lc$nb > 2) {"#### PC-values for genotypes"}` + +```{r, echo = FALSE} +if (at[4, 5] < 0.05 & lc$nb > 2) ggemodel$PC_values_genotypes +``` + +`r if (at[4, 5] < 0.05 & lc$nb > 2) {"#### PC-values for environments"}` + +```{r, echo = FALSE} +if (at[4, 5] < 0.05 & lc$nb > 2) ggemodel$PC_values_environments +``` + +`r if (at[4, 5] < 0.05 & lc$nb > 2) {"#### PC contributions"}` + +```{r, echo = FALSE} +if (at[4, 5] < 0.05 & lc$nb > 2) ggemodel$Contribution_PCs +``` + +`r if (at[4, 5] < 0.05 & lc$nb > 2) {paste("### ", {{i+1}}, ".3.3. Regression Stability Analysis", sep = "")}` + +```{r, echo = FALSE} +if (at[4, 5] < 0.05 & lc$nb > 2) { + rsamodel <- suppressWarnings(rsa(traits[i], geno, env, rep, data)) +} +``` + +`r if (at[4, 5] < 0.05 & lc$nb > 2) {"#### ANOVA"}` + +```{r, echo = FALSE} +if (at[4, 5] < 0.05 & lc$nb > 2) rsamodel$ANOVA +``` + +`r if (at[4, 5] < 0.05 & lc$nb > 2) {"#### Stability measures for genotypes"}` + +```{r, echo = FALSE} +if (at[4, 5] < 0.05 & lc$nb > 2) rsamodel$Stability_for_genotypes +``` + +`r if (at[4, 5] < 0.05 & lc$nb > 2) {"Here: \n +- a is the linear regression intercept, \n +- b is the linear regression slope, \n +- se is the slope standard error, \n +- MSe is the error mean square, \n +- MSentry is the variance of the means, and \n +- MSinter is the variance of the interaction effects. \n +The same is shown in the next section for each environment."}` + +`r if (at[4, 5] < 0.05 & lc$nb > 2) {"#### Stability measures for environments"}` + +```{r, echo = FALSE} +if (at[4, 5] < 0.05 & lc$nb > 2) rsamodel$Stability_for_environments +``` + +`r if (at[4, 5] < 0.05 & lc$nb > 2) {paste("### ", {{i+1}}, ".3.4. Tai stability analysis", sep = "")}` + +`r if (at[4, 5] < 0.05 & lc$nb > 2) {"#### Tai plot"}` + +```{r, echo = FALSE, fig.align = 'center', fig.height = 8, fig.width = 8} +if (at[4, 5] < 0.05 & lc$nb > 2) { + taimodel <- suppressWarnings(tai(traits[i], geno, env, rep, data)) + plot(taimodel) +} +``` + +`r if (at[4, 5] < 0.05 & lc$nb > 2) {"#### Tai alpha and lambda values"}` + +```{r, echo = FALSE} +if (at[4, 5] < 0.05 & lc$nb > 2) + taimodel$Tai_values +``` diff --git a/inst/hidap_agrofims/www/internal_files/child_met_fail.Rmd b/inst/hidap_agrofims/www/internal_files/child_met_fail.Rmd new file mode 100644 index 0000000..9cc64b2 --- /dev/null +++ b/inst/hidap_agrofims/www/internal_files/child_met_fail.Rmd @@ -0,0 +1,22 @@ +`r i = {{i}}` + +# {{i+1}}. Analysis for trait `r traits[i]` + +```{r, echo = FALSE} +lc <- check.2f(traits[i], geno, env, rep, data) +``` + +`r if (lc$c2 == 0) {"There is only one replication. Analysis is not possible with one replication."}` + +`r if (lc$c2 == 1 & lc$c3 == 0) {"There is more than one datum for at least one combination of the genotypes and environments in at least one replication. This could be the result of a mislabeling for the levels of the factors. The table below shows the frequencies of valid data for each genotype and environment in each replication. Solve this to proceed."}` + +`r if (lc$c1 == 0 & lc$c2 == 1 & lc$c3 == 1) {"There is at least one genotype without data in at least one environment. The table below shows the frequencies of valid data for each genotype in each environment. A MET analysis cannot be produced if there are combination of genotypes and environments without data. Solve this to proceed."}` + +`r if (lc$pmis > maxp & lc$c1 == 1 & lc$c2 == 1 & lc$c3 == 1) paste("There are too many missing values (", format(lc$pmis * 100, digits = 3), "%). The table below shows the frequencies of valid data for each genotype in each environment. This procedure estimates up to 10%. Solve this to proceed.", sep = "")` + +```{r, echo = FALSE} +if (lc$c2 == 1 & lc$c3 == 1) + lc$tfreq +if (lc$c2 == 1 & lc$c3 == 0) + lc$tfreqr +``` diff --git a/inst/hidap_agrofims/www/internal_files/child_nc.Rmd b/inst/hidap_agrofims/www/internal_files/child_nc.Rmd new file mode 100644 index 0000000..f9a3262 --- /dev/null +++ b/inst/hidap_agrofims/www/internal_files/child_nc.Rmd @@ -0,0 +1,26 @@ +`r i = {{i}}` + +# {{i}}. Analysis for trait `r traits[i]` + +```{r, echo = FALSE} +if (model == 1) { + ddd <- data.frame ( + set = data[, set], + male = data[, male], + female = data[, female], + progeny = data[, progeny], + rep = data[, rep], + yield = data[, traits[i]]) +} + +if (model == 2 | model == 3) { + ddd <- data.frame ( + set = data[, set], + male = data[, male], + female = data[, female], + rep = data[, rep], + yield = data[, traits[i]]) +} + +agricolae::carolina(model, ddd) +``` diff --git a/inst/hidap_agrofims/www/internal_files/child_rcbd.Rmd b/inst/hidap_agrofims/www/internal_files/child_rcbd.Rmd new file mode 100644 index 0000000..34fa04a --- /dev/null +++ b/inst/hidap_agrofims/www/internal_files/child_rcbd.Rmd @@ -0,0 +1,86 @@ +`r i = {{i}}` + +# {{i+1}}. Analysis for trait `r traits[i]` + +```{r, echo = FALSE} +lc <- check.rcbd(traits[i], geno, rep, data) +at <- suppressWarnings(aov.rcbd(traits[i], geno, rep, data, maxp)) +model <- aov(data[, traits[i]] ~ data[, geno] + data[, rep]) +``` + +## {{i+1}}.1. ANOVA + +You have fitted a linear model for a RCBD. The ANOVA table for your model is: + +```{r, echo = FALSE} +at +``` + +`r if(lc$c4 == 0) paste("You have some missing values (", format(lc$pmis * 100, digits = 3), "%) and they have been estimated before running ANOVA.", sep = "")` + +The coefficient of variation for this experiment is `r format(agricolae::cv.model(model), digits = 4)`%. +The p-value for genotypes is `r format(at[1, 5], digits = 4)` +`r if(at[1, 5] < 0.05) {"which is significant at the 5% level."} else {"which is not significant at the 5% level."}` + +## {{i+1}}.2. Assumptions + +Don't forget the assumptions of the model. It is supposed that the errors are independent with a normal distribution and with the same variance for all the genotypes. The following plots must help you evaluate this: + +```{r, echo = FALSE, fig.height = 5, fig.width = 10} +par(mfrow = c(1, 2)) + +plot(model, which = 1) +plot(model, which = 2) +``` + +Any trend in the residuals in the left plot would violate the assumption of independence while a trend in the variability of the residuals --for instance a funnel shape-- suggests heterogeneity of variances. Departures from the theoretical normal line on the right plot are symptoms of lack of normality. + +## {{i+1}}.3. Genotype means + +`r if(at[1, 5] < 0.05) {"Below are the sorted means for each genotype with letters indicating if there are significant differences using the least significance difference method and the multiple comparisons method of Tukey, both at the 5% level."} else {"Because the effect of genotypes was not significant in the ANOVA, multiple comparison tests are not presented. The means of your genotypes are:"}` + +`r if (at[1, 5] < 0.05) {paste("### ", {{i+1}}, ".3.1. LSD test", sep = "")}` + +```{r, echo = FALSE} +if (at[1, 5] < 0.05) + agricolae::LSD.test(data[, traits[i]], data[, geno], at[3, 1], at[3, 3])$groups +``` + +`r if (at[1, 5] < 0.05) {paste("### ", {{i+1}}, ".3.2. Tukey test", sep = "")}` + +```{r, echo = FALSE} +if (at[1, 5] < 0.05) + agricolae::HSD.test(data[, traits[i]], data[, geno], at[3, 1], at[3, 3])$groups +``` + +```{r, echo = FALSE} +if (at[1, 5] > 0.05) + tapply(data[, traits[i]], data[, geno], mean) +``` + +`r if (lc$nt < 10 & at[1, 5] < 0.05) {paste("### ", {{i+1}}, ".3.3. Plot of means", sep = "")}` + +`r if(lc$nt < 10) {"It is always good to have some visualization of the data. Because the number of genotypes in your experiment is not so big, we can plot the data for each genotype:"}` + +```{r, echo = FALSE} +if (lc$nt < 10) msdplot(traits[i], geno, data, conf = 1) +``` + +## {{i+1}}.4. Variance components + +Below are the variance components for this model, under the assumption that genotypes and blocks are random. Here the model is fitted using REML and missing values are not estimated. + +```{r, echo = FALSE} +y <- data[, traits[i]] +fg <- data[, geno] +fr <- data[, rep] +ff <- as.formula(y ~ (1|fg) + (1|fr)) +model <- lme4::lmer(ff) +vc <- data.frame(lme4::VarCorr(model)) +vc[vc[, 1] == "fg", 1] <- geno +vc[vc[, 1] == "fr", 1] <- rep +rownames(vc) <- vc[, 1] +vc <- vc[, c(4, 5)] +colnames(vc) <- c("Variance", "Std.Dev.") +vc +``` diff --git a/inst/hidap_agrofims/www/internal_files/child_rcbd_fail.Rmd b/inst/hidap_agrofims/www/internal_files/child_rcbd_fail.Rmd new file mode 100644 index 0000000..dd3ab3f --- /dev/null +++ b/inst/hidap_agrofims/www/internal_files/child_rcbd_fail.Rmd @@ -0,0 +1,20 @@ +`r i = {{i}}` + +# {{i+1}}. Analysis for trait `r traits[i]` + +```{r, echo = FALSE} +lc <- check.rcbd(traits[i], geno, rep, data) +``` + +`r if (lc$c2 == 0) {"There is only one replication. Analysis is not possible with one replication."}` + +`r if (lc$c2 == 1 & lc$c3 == 0) {"There is more than one datum for at least one genotype in at least one replication. This could be the result of a mislabeling for the levels of the factors. The table below shows the frequencies of valid data for each genotype in each replication. Solve this to proceed."}` + +`r if (lc$c1 == 0 & lc$c2 == 1 & lc$c3 == 1) {"There is at least one genotype without data. The table below shows the frequencies of valid data for each genotype in each replication. The analysis cannot be produced if there are genotypes without data. Solve this to proceed."}` + +`r if (lc$pmis > maxp & lc$c1 == 1 & lc$c2 == 1 & lc$c3 == 1) paste("There are too many missing values (", format(lc$pmis * 100, digits = 3), "%). The table below shows the frequencies of valid data for each genotype in each replication. This procedure estimates up to 10%. Solve this to proceed.", sep = "")` + +```{r, echo = FALSE} +if (lc$c2 == 1) + lc$tfreq +``` diff --git a/inst/hidap_agrofims/www/internal_files/crd.Rmd b/inst/hidap_agrofims/www/internal_files/crd.Rmd new file mode 100644 index 0000000..9e2d0ed --- /dev/null +++ b/inst/hidap_agrofims/www/internal_files/crd.Rmd @@ -0,0 +1,61 @@ +--- +title: "`r params$title`" +subtitle: '`r params$subtitle`' +author: '`r params$author`' +date: '`r format(Sys.time(), "%B %d, %Y")`' +output: + html_document: + theme: united + toc: true + toc_depth: 3 + pdf_document: + toc: true + toc_depth: 3 + highlight: zenburn + word_document: + highlight: "tango" + toc: true + toc_depth: 3 +params: + traits: "no data" + geno: "no data" + data: "no data" + maxp: "no data" + title: "no data" + subtitle: "no data" + author: "no data" +--- + +```{r, echo = FALSE} +library(knitr) + +traits <- params$traits +geno <- params$geno +data <- params$data +maxp <- params$maxp + +data[, geno] <- as.character(data[, geno]) +``` + +# 1. Model specification and data description + +There are data from `r nlevels(as.factor(data[, geno]))` genotypes, evaluated using a completely randomized design. The statistical model is +$$ +y_{ij} = \mu + \tau_i + \epsilon_{ij} +$$ +where + +* $y_{ij}$ is the observed response with genotype $i$ and replication $j$. +* $\mu$ is the mean response over all genotypes and replications. +* $\tau_i$ is the effect for genotype $i$. +* $\epsilon_{ij}$ is the error term. + +In this model we assume that the errors are independent and have a normal distribution with common variance, that is, $\epsilon_{ij} \sim N(0,\sigma_{\epsilon}^2)$. + +```{r, include = FALSE} +out <- NULL +for (i in 1:length(traits)) + out <- c(out, knit_expand('child_crd.Rmd')) +``` + +`r paste(knit(text = out), collapse = '\n')` diff --git a/inst/hidap_agrofims/www/internal_files/df.Rmd b/inst/hidap_agrofims/www/internal_files/df.Rmd new file mode 100644 index 0000000..6a055ef --- /dev/null +++ b/inst/hidap_agrofims/www/internal_files/df.Rmd @@ -0,0 +1,27 @@ +--- +title: "Report for a data table" +author: '`r params$author`' +date: '`r format(Sys.time(), "%B %d, %Y")`' +output: + html_document: + theme: united + pdf_document: + toc: true + highlight: zenburn + word_document: + highlight: "tango" +params: + x: "no data" + author: "no data" +--- + +You have a nice data table with `r dim(params$x)[1]` rows and `r dim(params$x)[2]` columns. The first six rows are shown below: +```{r, echo = FALSE} +head(params$x) +``` +Remember that the table is the standard format for data analysis; it is the kind of data structure that any statistical package prefers. In a table you have: + +* one row for each observation (e.g. a plot, a pot or a plant) and +* one column for each variable (e.g. a trait like root yield or a factor like genotypes). + +Maybe you would like to read [this](https://github.com/reyzaguirre/MoreStats/tree/master/GoodDataPractices). diff --git a/inst/hidap_agrofims/www/internal_files/elston.Rmd b/inst/hidap_agrofims/www/internal_files/elston.Rmd new file mode 100644 index 0000000..f2193de --- /dev/null +++ b/inst/hidap_agrofims/www/internal_files/elston.Rmd @@ -0,0 +1,41 @@ +--- +title: "Elston index" +author: '`r params$author`' +date: '`r format(Sys.time(), "%B %d, %Y")`' +output: + html_document: + theme: united + pdf_document: + toc: true + highlight: zenburn + word_document: + highlight: "tango" +params: + traits: "no data" + geno: "no data" + env: "no data" + rep: "no data" + data: "no data" + means: "no data" + lb: "no data" + author: "no data" +--- + +```{r, echo = FALSE} +traits <- params$traits +geno <- params$geno +env <- params$env +rep <- params$rep +data <- params$data +means <- params$means +lb <- params$lb + +eindex <- elston(traits, geno, env, rep, data, means, lb) +``` + +### The Elston index + +The Elston index for each genotype is shown below. As you see, genotype `r (eindex[sort(eindex$E.Index, decreasing = T, index.return = T)$ix, ])[1,1]` is the one with the highest value. +```{r, echo = FALSE} +eindex[sort(eindex$E.Index, decreasing = T, index.return = T)$ix, ] +``` diff --git a/inst/hidap_agrofims/www/internal_files/lxt.Rmd b/inst/hidap_agrofims/www/internal_files/lxt.Rmd new file mode 100644 index 0000000..ad24aee --- /dev/null +++ b/inst/hidap_agrofims/www/internal_files/lxt.Rmd @@ -0,0 +1,47 @@ +--- +title: "`r params$title`" +subtitle: '`r params$subtitle`' +author: '`r params$author`' +date: '`r format(Sys.time(), "%B %d, %Y")`' +output: + html_document: + theme: united + toc: true + toc_depth: 3 + pdf_document: + toc: true + toc_depth: 3 + highlight: zenburn + word_document: + highlight: "tango" + toc: true + toc_depth: 3 +params: + traits: "no data" + lines: "no data" + testers: "no data" + rep: "no data" + data: "no data" + title: "no data" + subtitle: "no data" + author: "no data" +--- + +```{r, echo = FALSE} +library(knitr) + +traits <- params$traits +lines <- params$lines +testers <- params$testers +rep <- params$rep +data <- params$data +``` + +```{r, include = FALSE} +out <- NULL + +for (i in 1:length(traits)) + out <- c(out, knit_expand('child_lxt.Rmd')) +``` + +`r paste(knit(text = out), collapse = '\n')` diff --git a/inst/hidap_agrofims/www/internal_files/met.Rmd b/inst/hidap_agrofims/www/internal_files/met.Rmd new file mode 100644 index 0000000..286379a --- /dev/null +++ b/inst/hidap_agrofims/www/internal_files/met.Rmd @@ -0,0 +1,75 @@ +--- +title: "`r params$title`" +subtitle: '`r params$subtitle`' +author: '`r params$author`' +date: '`r format(Sys.time(), "%B %d, %Y")`' +output: + html_document: + theme: united + toc: true + toc_depth: 3 + pdf_document: + toc: true + toc_depth: 3 + highlight: zenburn + word_document: + toc: true + toc_depth: 3 + highlight: "tango" +params: + traits: "no data" + geno: "no data" + env: "no data" + rep: "no data" + data: "no data" + maxp: "no data" + title: "no data" + subtitle: "no data" + author: "no data" +--- + +```{r, echo = FALSE} +library(knitr) + +traits <- params$traits +geno <- params$geno +env <- params$env +rep <- params$rep +data <- params$data +maxp <- params$maxp + +data[, geno] <- as.character(data[, geno]) +data[, env] <- as.character(data[, env]) +data[, rep] <- as.character(data[, rep]) +``` + +# 1. Model specification and data description + +The data frame has `r nlevels(as.factor(data[, env]))` environments and `r nlevels(as.factor(data[, geno]))` genotypes. In each environment the genotypes were evaluated using a randomized complete block design with `r nlevels(as.factor(data[, rep]))` blocks. The statistical model is +$$ +y_{ijk} = \mu + \alpha_i + \beta_j + (\alpha\beta)_{ij} + \gamma_{k(j)} + \epsilon_{ijk} +$$ +where + +* $y_{ijk}$ is the observed response with genotype $i$, environment $j$, and block $k$ nested in environment $j$. +* $\mu$ is the mean response over all genotypes, environments and blocks. +* $\alpha_i$ is the effect for genotype $i$. +* $\beta_j$ is the effect for environment $j$. +* $(\alpha\beta)_{ij}$ is the interaction effect between genotype $i$ and environment $j$. +* $\gamma_{k(j)}$ is the effect of block $k$ nested in environment $j$. +* $\epsilon_{ijk}$ is the error term. + +In this model we assume that the errors are independent and have a normal distribution with common variance, that is, $\epsilon_{ijk} \sim N(0,\sigma_{\epsilon}^2)$. + +```{r, include = FALSE} +out <- NULL +for (i in 1:length(traits)) { + lc <- check.2f(traits[i], geno, env, rep, data) + if (lc$c1 == 1 & lc$c2 == 1 & lc$c3 == 1 & lc$pmis <= maxp) + out <- c(out, knit_expand('child_met.Rmd')) + else + out <- c(out, knit_expand('child_met_fail.Rmd')) +} +``` + +`r paste(knit(text = out), collapse = '\n')` diff --git a/inst/hidap_agrofims/www/internal_files/na.Rmd b/inst/hidap_agrofims/www/internal_files/na.Rmd new file mode 100644 index 0000000..bb59225 --- /dev/null +++ b/inst/hidap_agrofims/www/internal_files/na.Rmd @@ -0,0 +1,18 @@ +--- +title: "Report for unknown object" +author: '`r params$author`' +date: '`r format(Sys.time(), "%B %d, %Y")`' +output: + html_document: + theme: united + pdf_document: + toc: true + highlight: zenburn + word_document: + highlight: "tango" +params: + x: "no data" + author: "no data" +--- + +I am sorry, this object is not in my list. diff --git a/inst/hidap_agrofims/www/internal_files/nc.Rmd b/inst/hidap_agrofims/www/internal_files/nc.Rmd new file mode 100644 index 0000000..cba2fea --- /dev/null +++ b/inst/hidap_agrofims/www/internal_files/nc.Rmd @@ -0,0 +1,53 @@ +--- +title: "`r params$title`" +subtitle: '`r params$subtitle`' +author: '`r params$author`' +date: '`r format(Sys.time(), "%B %d, %Y")`' +output: + html_document: + theme: united + toc: true + toc_depth: 3 + pdf_document: + toc: true + toc_depth: 3 + highlight: zenburn + word_document: + highlight: "tango" + toc: true + toc_depth: 3 +params: + traits: "no data" + set: "no data" + male: "no data" + female: "no data" + progeny: "no data" + rep: "no data" + model: "no data" + data: "no data" + title: "no data" + subtitle: "no data" + author: "no data" +--- + +```{r, echo = FALSE} +library(knitr) + +traits <- params$traits +set <- params$set +male <- params$male +female <- params$female +progeny <- params$progeny +rep <- params$rep +model <- params$model +data <- params$data +``` + +```{r, include = FALSE} +out <- NULL + +for (i in 1:length(traits)) + out <- c(out, knit_expand('child_nc.Rmd')) +``` + +`r paste(knit(text = out), collapse = '\n')` diff --git a/inst/hidap_agrofims/www/internal_files/nt.Rmd b/inst/hidap_agrofims/www/internal_files/nt.Rmd new file mode 100644 index 0000000..ab5c3a9 --- /dev/null +++ b/inst/hidap_agrofims/www/internal_files/nt.Rmd @@ -0,0 +1,60 @@ +--- +title: "Report for a numeric trait" +author: '`r params$author`' +date: '`r format(Sys.time(), "%B %d, %Y")`' +output: + html_document: + theme: united + pdf_document: + toc: true + highlight: zenburn + word_document: + highlight: "tango" +params: + x: "no data" + author: "no data" +--- + +```{r, echo = FALSE} +# Some parameters +p1 <- length(params$x) +p2 <- max(table(params$x)) +p3 <- length(table(params$x)) +``` + +It looks like you have a numeric trait. You can see a descriptive summary below: +```{r, echo = FALSE} +output <- summary(params$x) +output +``` + +```{r, echo = FALSE} +sk <- 3*(mean(params$x) - median(params$x))/sd(params$x) +``` + +`r if(sk > 0.5) {"It looks like you have some positive skewness because your mean is quite larger than your median. Watch out with this if you want to fit a model that assumes normality." }` + +`r if(sk < -0.5) {"It looks like you have some negative skewness because your mean is quite smaller than your median. Watch out with this if you want to fit a model that assumes normality." }` + +`r if(p1 > 25 & (p1/p3 <= 2 | (p1/p3 > 2 & p3 > 20))) {"A boxplot could be a suitable plot for these data:"}` + +```{r, echo = FALSE} +if(p1 > 25 & (p1/p3 <= 2 | (p1/p3 > 2 & p3 > 20))) boxplot(params$x) +``` +`r if(p1 > 25 & p1/p3 > 2 & p3 <= 20) {"For this trait a frequency table could produce a good display of the data:"}` + +```{r, echo = FALSE} +if(p1 > 25 & p1/p3 > 2 & p3 <= 20) table(params$x) +``` + +`r if(p1 <= 25) {"A dotplot could be a suitable plot for these data:"}` + +```{r, echo = FALSE} +if(p1 <= 25) stripchart(params$x) +``` + +`r if(p1 > 25 & p1/p3 < 2 & p2/p1 > 0.05) {"Although your trait seems to be on a continuous scale, there are some values with a very high frequency. What out with this if you plan to fit a model that assumes normality. You can see these values and their frequency below:"}` + +```{r, echo = FALSE} +if(p1 > 25 & p1/p3 < 2 & p2/p1 > 0.05) table(params$x)[table(params$x)/p1 > 0.05] +``` diff --git a/inst/hidap_agrofims/www/internal_files/pesekbaker.Rmd b/inst/hidap_agrofims/www/internal_files/pesekbaker.Rmd new file mode 100644 index 0000000..a36a674 --- /dev/null +++ b/inst/hidap_agrofims/www/internal_files/pesekbaker.Rmd @@ -0,0 +1,74 @@ +--- +title: "Pesek Baker index" +author: '`r params$author`' +date: '`r format(Sys.time(), "%B %d, %Y")`' +output: + html_document: + theme: united + pdf_document: + toc: true + highlight: zenburn + word_document: + highlight: "tango" +params: + traits: "no data" + geno: "no data" + env: "no data" + rep: "no data" + data: "no data" + means: "no data" + dgg: "no data" + units: "no data" + sf: "no data" + author: "no data" +--- + +```{r, echo = FALSE} +traits <- params$traits +geno <- params$geno +env <- params$env +rep <- params$rep +data <- params$data +means <- params$means +dgg <- params$dgg +units <- params$units +sf <- params$sf + +pbindex <- pesekbaker(traits, geno, env, rep, data, means, dgg, units, sf) +``` + +### Desired genetic gains +You have computed the Pesek-Baker index for traits `r traits` with the following desired genetic gains in actual units: +```{r, echo = FALSE} +pbindex$Desired.Genetic.Gains +``` + +### Standard deviation +The estimated genotypic standard deviations for these traits are: +```{r, echo = FALSE} +pbindex$Standard.Deviations +``` + +### The Pesek-Baker index + +The index coefficients for the Pesek-Baker index are: +```{r, echo = FALSE} +pbindex$Index.Coefficients +``` + +With this, the Pesek-Baker index for each genotype is shown below. As you see, genotype `r (pbindex$Pesek.Baker.Index[sort(pbindex$Pesek.Baker.Index$PB.Index, decreasing = T, index.return = T)$ix, ])[1,1]` is the one with the highest value. +```{r, echo = FALSE} +pbindex$Pesek.Baker.Index[sort(pbindex$Pesek.Baker.Index$PB.Index, decreasing = T, + index.return = T)$ix, ] +``` + +### The response to selection + +For a selection fraction of `r sf`, the responses to selection in actual units are: +```{r, echo = FALSE} +pbindex$Response.to.Selection +``` +and in standardized units: +```{r, echo = FALSE} +pbindex$Std.Response.to.Selection +``` diff --git a/inst/hidap_agrofims/www/internal_files/pvs1.Rmd b/inst/hidap_agrofims/www/internal_files/pvs1.Rmd new file mode 100644 index 0000000..43abd78 --- /dev/null +++ b/inst/hidap_agrofims/www/internal_files/pvs1.Rmd @@ -0,0 +1,219 @@ +--- +title: "`r params$title`" +subtitle: '`r params$subtitle`' +author: '`r params$author`' +date: '`r format(Sys.time(), "%B %d, %Y")`' +output: + html_document: + theme: united + toc: true + toc_depth: 3 + pdf_document: + toc: true + toc_depth: 3 + highlight: zenburn + word_document: + toc: true + toc_depth: 3 + highlight: "tango" +params: + data: "no data" + form: "no data" + title: "no data" + subtitle: "no data" + author: "no data" +--- + +```{r echo=FALSE} + +## Data + +data <- params$data +data <- data[, c("PHASE", "IDENTIFIED_CRITERIA", "SCORE_MEN", "SCORE_WOMEN", "SCORE_GLOBAL")] +data$IDENTIFIED_CRITERIA <- as.character(data$IDENTIFIED_CRITERIA) +colnames(data) <- c("phase", "Criteria", "Men", "Women", "Global") +data <- tidyr::gather(data, group, value, Men:Global) + +## Split by phase + +flow <- data[data$phase == "Flowering", ] +harv <- data[data$phase == "Harvest", ] +stor <- data[data$phase == "Storage", ] + +## Sort by number of votes + +temp <- flow[flow$group == "Global", c("Criteria", "value")] +orden <- temp$Criteria[sort(temp$value, decreasing = T, index.return = T)$ix] +flow$Criteria <- factor(flow$Criteria, levels = orden) + +temp <- harv[harv$group == "Global", c("Criteria", "value")] +orden <- temp$Criteria[sort(temp$value, decreasing = T, index.return = T)$ix] +harv$Criteria <- factor(harv$Criteria, levels = orden) + +temp <- stor[stor$group == "Global", c("Criteria", "value")] +orden <- temp$Criteria[sort(temp$value, decreasing = T, index.return = T)$ix] +stor$Criteria <- factor(stor$Criteria, levels = orden) + +## Count number of votes + +nvmflow <- sum(flow[flow$group == "Men", "value"], na.rm = T) +nvmharv <- sum(harv[harv$group == "Men", "value"], na.rm = T) +nvmstor <- sum(stor[stor$group == "Men", "value"], na.rm = T) + +nvwflow <- sum(flow[flow$group == "Women", "value"], na.rm = T) +nvwharv <- sum(harv[harv$group == "Women", "value"], na.rm = T) +nvwstor <- sum(stor[stor$group == "Women", "value"], na.rm = T) + +## Count number of voters + +nmflow <- round(nvmflow / 6) +nmharv <- round(nvmharv / 6) +nmstor <- round(nvmstor / 6) + +nwflow <- round(nvwflow / 6) +nwharv <- round(nvwharv / 6) +nwstor <- round(nvwstor / 6) + +## Compute percentage adjusted by gender + +flowp <- flow[flow$group == "Global", ] +flowp$value <- flowp$value / (nvmflow + nvwflow) +temp <- flow[flow$group != "Global", ] +temp[temp$group == "Men", "value"] <- temp[temp$group == "Men", "value"] / nvmflow / 2 +temp[temp$group == "Women", "value"] <- temp[temp$group == "Women", "value"] / nvwflow / 2 +temp <- docomp("sum", "value", "Criteria", "phase", temp) +temp$group <- "Global adjusted" +flowp <- rbind(flowp, temp) +flowp$value <- round(flowp$value * 100, 1) + +harvp <- harv[harv$group == "Global", ] +harvp$value <- harvp$value / (nvmharv + nvwharv) +temp <- harv[harv$group != "Global", ] +temp[temp$group == "Men", "value"] <- temp[temp$group == "Men", "value"] / nvmharv / 2 +temp[temp$group == "Women", "value"] <- temp[temp$group == "Women", "value"] / nvwharv / 2 +temp <- docomp("sum", "value", "Criteria", "phase", temp) +temp$group <- "Global adjusted" +harvp <- rbind(harvp, temp) +harvp$value <- round(harvp$value * 100, 1) + +storp <- stor[stor$group == "Global", ] +storp$value <- storp$value / (nvmstor + nvwstor) +temp <- stor[stor$group != "Global", ] +temp[temp$group == "Men", "value"] <- temp[temp$group == "Men", "value"] / nvmstor / 2 +temp[temp$group == "Women", "value"] <- temp[temp$group == "Women", "value"] / nvwstor / 2 +temp <- docomp("sum", "value", "Criteria", "phase", temp) +temp$group <- "Global adjusted" +storp <- rbind(storp, temp) +storp$value <- round(storp$value * 100, 1) + +``` + +# 1. Identification of selection criteria and voting process + +A group of farmers, men and women, and other stakeholders are gathered and, after explanation of the overall objectives of the trial, they are asked: What do you look for in a new variety of potato when the crop is at the flowering/harvest/post-harvest stage? In other words: When do you say that a variety is good or bad, when evaluating at this stage? + +A list is compiled of all the criteria mentioned by the different participants (i.e. free listing). Each criterium is listed and written on a paper bag (or card with accompanying container). Then, in order to select the most important traits for farmers a voting process is conducted. + +Farmers are requested to select the three criteria that each considers the most important with the following scheme. They can give: + +- Three votes for the most important characteristic. +- Two votes for the second most important characteristic. +- One vote for the third most important characteristic. + +Votes are recorded for men and women. + +# 2. Selection criteria at flowering + +`r if (nrow(flow) == 0) {"There were no data for selection criteria at flowering."}` +`r if (all(is.na(flow$Criteria))) {"There were no data for selection criteria at flowering."}` + + +```{r echo = FALSE, fig.height = 5, fig.width = 8} +if (nrow(flow) > 0 && !all(is.na(flow$Criteria)) ){ + ggplot(flow, aes(x = group, y = value, fill = Criteria)) + + geom_bar(stat = "identity", position = "dodge", color = "black") + + labs(title = "Voting for selection criteria of new varieties at flowering stage", + x = "Group", y = "Number of votes") + + geom_text(aes(label = value), vjust = 1.6, color = "white", + position = position_dodge(0.9), size = 3) +} +``` + +`r if (nrow(flow) > 0 && !all(is.na(flow$Criteria)) ) {"Below a percentage graph is shown. On the right panel the percentages are adjusted by gender, thus trying to reflect what would have been obtained if the number of men and women would be the same in the sample."}` + + + + +```{r echo = FALSE, fig.height = 5, fig.width = 8} +if (nrow(flow) > 0 && !all(is.na(flow$Criteria)) ) { + ggplot(flowp, aes(x = group, y = value, fill = Criteria)) + + geom_bar(stat = "identity", position = "dodge", color = "black") + + labs(title = "Voting for selection criteria of new varieties at flowering stage", + subtitle = "Percentages unadjusted and adjusted by gender", + x = "Group", y = "Percentage of votes") + + geom_text(aes(label = value), vjust = 1.6, color = "white", + position = position_dodge(0.9), size = 3) +} +``` + +# 3. Selection criteria at harvest + +`r if (nrow(harv) == 0) {"There were no data for selection criteria at harvest."}` +`r if (all(is.na(harv$Criteria))) {"There were no data for selection criteria at harvest."}` + + +```{r echo = FALSE, fig.height = 5, fig.width = 8} +if (nrow(harv) > 0 && !all(is.na(harv$Criteria)) ) { + ggplot(harv, aes(x = group, y = value, fill = Criteria)) + + geom_bar(stat = "identity", position = "dodge", color = "black") + + labs(title = "Voting for selection criteria of new varieties at harvest stage", + x = "Group", y = "Number of votes") + + geom_text(aes(label = value), vjust = 1.6, color = "white", + position = position_dodge(0.9), size = 3) +} +``` + +`r if (nrow(harv) > 0 && !all(is.na(harv$Criteria)) ) {"Below a percentage graph is shown. On the right panel the percentages are adjusted by gender, thus trying to reflect what would have been obtained if the number of men and women would be the same in the sample."}` + +```{r echo = FALSE, fig.height = 5, fig.width = 8} +if (nrow(harv) > 0 && !all(is.na(harv$Criteria)) ) { + ggplot(harvp, aes(x = group, y = value, fill = Criteria)) + + geom_bar(stat = "identity", position = "dodge", color = "black") + + labs(title = "Voting for selection criteria of new varieties at harvest stage", + subtitle = "Percentages unadjusted and adjusted by gender", + x = "Group", y = "Percentage of votes") + + geom_text(aes(label = value), vjust = 1.6, color = "white", + position = position_dodge(0.9), size = 3) +} +``` + +# 4. Selection criteria at post-harvest (storage) + +`r if (nrow(stor) == 0) {"There were no data for selection criteria at post-harvest."}` +`r if (all(is.na(stor$Criteria))) {"There were no data for selection criteria at post-harvest."}` + + +```{r echo = FALSE, fig.height = 5, fig.width = 8} +if (nrow(stor) > 0 && !all(is.na(stor$Criteria)) ) { + ggplot(stor, aes(x = group, y = value, fill = Criteria)) + + geom_bar(stat = "identity", position = "dodge", color = "black") + + labs(title = "Voting for selection criteria of new varieties at post-harvest stage", + x = "Group", y = "Number of votes") + + geom_text(aes(label = value), vjust = 1.6, color = "white", + position = position_dodge(0.9), size = 3) +} +``` + +`r if (nrow(stor) > 0 && !all(is.na(stor$Criteria)) ) {"Below a percentage graph is shown. On the right panel the percentages are adjusted by gender, thus trying to reflect what would have been obtained if the number of men and women would be the same in the sample."}` + +```{r echo = FALSE, fig.height = 5, fig.width = 8} +if (nrow(stor) > 0 && !all(is.na(stor$Criteria)) ) { + ggplot(storp, aes(x = group, y = value, fill = Criteria)) + + geom_bar(stat = "identity", position = "dodge", color = "black") + + labs(title = "Voting for selection criteria of new varieties at post-harvest stage", + subtitle = "Percentages unadjusted and adjusted by gender", + x = "Group", y = "Percentage of votes") + + geom_text(aes(label = value), vjust = 1.6, color = "white", + position = position_dodge(0.9), size = 3) +} +``` diff --git a/inst/hidap_agrofims/www/internal_files/pvs23.Rmd b/inst/hidap_agrofims/www/internal_files/pvs23.Rmd new file mode 100644 index 0000000..6361aba --- /dev/null +++ b/inst/hidap_agrofims/www/internal_files/pvs23.Rmd @@ -0,0 +1,319 @@ +--- +title: "`r params$title`" +subtitle: '`r params$subtitle`' +author: '`r params$author`' +date: '`r format(Sys.time(), "%B %d, %Y")`' +output: + html_document: + theme: united + toc: true + toc_depth: 3 + pdf_document: + toc: true + toc_depth: 3 + highlight: zenburn + word_document: + toc: true + toc_depth: 3 + highlight: "tango" +params: + data: "no data" + form: "no data" + title: "no data" + subtitle: "no data" + author: "no data" +--- + +```{r echo = FALSE} + +## Form + +if (params$form == 2) stage <- "flowering" +if (params$form == 3) stage <- "harvest" + +## Data + +data <- params$data +temp <- data[!is.na(data$MSGLO), ] +nrm <- nlevels(factor(temp$REP)) +temp <- data[!is.na(data$BSGLO), ] +nrb <- nlevels(factor(temp$REP)) +ds <- docomp("sum", c("MSM", "MSWM", "MSGLO", "BSM", "BSWM", "BSGLO"), "INSTN", data = data) +ds <- tidyr::gather(ds, group, value, MSM:BSGLO) +ds[ds$group %in% c("MSM", "MSWM", "MSGLO"), "trial"] <- "mother" +ds[ds$group %in% c("BSM", "BSWM", "BSGLO"), "trial"] <- "baby" +ds[ds$group %in% c("MSM", "BSM"), "group"] <- "Men" +ds[ds$group %in% c("MSWM", "BSWM"), "group"] <- "Women" +ds[ds$group %in% c("MSGLO", "BSGLO"), "group"] <- "Global" + +## Split by trial + +moth <- ds[ds$trial == "mother", -4] +baby <- ds[ds$trial == "baby", -4] +both <- docomp("sum", "value", c("INSTN", "group"), data = ds) + +## Sort by number of votes + +temp <- moth[moth$group == "Global", c("INSTN", "value")] +orden <- temp$INSTN[sort(temp$value, decreasing = T, index.return = T)$ix] +moth$INSTN <- factor(moth$INSTN, levels = orden) + +temp <- baby[baby$group == "Global", c("INSTN", "value")] +orden <- temp$INSTN[sort(temp$value, decreasing = T, index.return = T)$ix] +baby$INSTN <- factor(baby$INSTN, levels = orden) + +temp <- both[both$group == "Global", c("INSTN", "value")] +orden <- temp$INSTN[sort(temp$value, decreasing = T, index.return = T)$ix] +both$INSTN <- factor(both$INSTN, levels = orden) + +## Count number of votes + +nvmmoth <- sum(moth[moth$group == "Men", "value"], na.rm = T) +nvmbaby <- sum(baby[baby$group == "Men", "value"], na.rm = T) +nvmboth <- nvmmoth + nvmbaby + +nvwmoth <- sum(moth[moth$group == "Women", "value"], na.rm = T) +nvwbaby <- sum(baby[baby$group == "Women", "value"], na.rm = T) +nvwboth <- nvwmoth + nvwbaby + +## Count number of voters + +nmmoth <- round(nvmmoth / 6 / nrm) +nmbaby <- round(nvmbaby / 6 / nrb) + +nwmoth <- round(nvwmoth / 6 / nrm) +nwbaby <- round(nvwbaby / 6 / nrb) + +## Compute percentage adjusted by gender + +mothp <- moth[moth$group == "Global", ] +mothp$value <- mothp$value / (nvmmoth + nvwmoth) +temp <- moth[moth$group != "Global", ] +temp[temp$group == "Men", "value"] <- temp[temp$group == "Men", "value"] / nvmmoth / 2 +temp[temp$group == "Women", "value"] <- temp[temp$group == "Women", "value"] / nvwmoth / 2 +temp <- docomp("sum", "value", "INSTN", data = temp) +temp$group <- "Global adjusted" +mothp <- rbind(mothp, temp) +mothp$value <- round(mothp$value * 100, 1) + +babyp <- baby[baby$group == "Global", ] +babyp$value <- babyp$value / (nvmbaby + nvwbaby) +temp <- baby[baby$group != "Global", ] +temp[temp$group == "Men", "value"] <- temp[temp$group == "Men", "value"] / nvmbaby / 2 +temp[temp$group == "Women", "value"] <- temp[temp$group == "Women", "value"] / nvwbaby / 2 +temp <- docomp("sum", "value", "INSTN", data = temp) +temp$group <- "Global adjusted" +babyp <- rbind(babyp, temp) +babyp$value <- round(babyp$value * 100, 1) + +bothp <- both[both$group == "Global", ] +bothp$value <- bothp$value / (nvmboth + nvwboth) +temp <- both[both$group != "Global", ] +temp[temp$group == "Men", "value"] <- temp[temp$group == "Men", "value"] / nvmboth / 2 +temp[temp$group == "Women", "value"] <- temp[temp$group == "Women", "value"] / nvwboth / 2 +temp <- docomp("sum", "value", "INSTN", data = temp) +temp$group <- "Global adjusted" +bothp <- rbind(bothp, temp) +bothp$value <- round(bothp$value * 100, 1) + +``` + +# 1. Voting process for the identification of best genotypes at `r stage` + +A group of farmers, men and women, and other stakeholders are gathered and, after explanation of the overall objectives of the trial, they are asked to identify their three personal favorite genotypes. Then, they are requested to vote by giving: + +- Three votes for the best genotype. +- Two votes for the second. +- One vote for the third. + +Votes are recorded for men and women. + +# 2. Best genotypes at the mother plot + +`r if (nrm == 0) {"There were no data for the mother plot."}` +`r if (nrm > 0) paste("The genotypes have been planted following a randomized complete block design with", nrm, "blocks. A group of men and women voted independently for the best genotypes at each block, so each men and women voted", nrm, "times.")` + +```{r echo = FALSE, fig.height = 5, fig.width = 8} +if (nrm > 0) { + ggplot(moth, aes(x = group, y = value, fill = INSTN)) + + geom_bar(stat = "identity", position = "dodge", color = "black") + + labs(title = paste("Voting for best genotypes at", stage, "stage in the mother plot"), + x = "Group", y = "Number of votes") + + geom_text(aes(label = value), vjust = 1.6, color = "white", + position = position_dodge(0.9), size = 3) +} +``` + +`r if (nrm > 0) {"Below a percentage graph is shown. On the right panel the percentages are adjusted by gender, thus trying to reflect what would have been obtained if the number of men and women would be the same in the sample."}` + +```{r echo = FALSE, fig.height = 5, fig.width = 8} +if (nrm > 0) { + ggplot(mothp, aes(x = group, y = value, fill = INSTN)) + + geom_bar(stat = "identity", position = "dodge", color = "black") + + labs(title = paste("Voting for best genotypes at", stage, "stage in the mother plot"), + subtitle = "Percentages unadjusted and adjusted by gender", + x = "Group", y = "Percentage of votes") + + geom_text(aes(label = value), vjust = 1.6, color = "white", + position = position_dodge(0.9), size = 3) +} +``` + +# 3. Best genotypes at the baby plots + +`r if (nrb == 0) {"There were no data for baby plots."}` +`r if (nrb > 0) paste("The genotypes have been planted in", nrb, "baby plots. At each baby plot the complete set of genotypes is planted. A group of men and women voted independently for the best genotypes at each baby plot.")` + +```{r echo = FALSE, fig.height = 5, fig.width = 8} +if (nrb > 0) { + ggplot(baby, aes(x = group, y = value, fill = INSTN)) + + geom_bar(stat = "identity", position = "dodge", color = "black") + + labs(title = paste("Voting for best genotypes at", stage, "stage in the baby plots"), + x = "Group", y = "Number of votes") + + geom_text(aes(label = value), vjust = 1.6, color = "white", + position = position_dodge(0.9), size = 3) +} +``` + +`r if (nrb > 0) {"Below a percentage graph is shown. On the right panel the percentages are adjusted by gender, thus trying to reflect what would have been obtained if the number of men and women would be the same in the sample."}` + +```{r echo = FALSE, fig.height = 5, fig.width = 8} +if (nrb > 0) { + ggplot(babyp, aes(x = group, y = value, fill = INSTN)) + + geom_bar(stat = "identity", position = "dodge", color = "black") + + labs(title = paste("Voting for best genotypes at", stage, "stage in the baby plots"), + subtitle = "Percentages unadjusted and adjusted by gender", + x = "Group", y = "Percentage of votes") + + geom_text(aes(label = value), vjust = 1.6, color = "white", + position = position_dodge(0.9), size = 3) +} +``` + +# 4. Best genotypes at both, mother and baby plots + +`r if (nrm == 0) {"There were no data for the mother plot."}` +`r if (nrb == 0) {"There were no data for baby plots."}` + +`r if (nrb > 0 & nrm > 0) {"Here all the votes on the mother and baby plots are pooled together."}` + +```{r echo = FALSE, fig.height = 5, fig.width = 8} +if (nrb > 0 & nrm > 0) { + ggplot(both, aes(x = group, y = value, fill = INSTN)) + + geom_bar(stat = "identity", position = "dodge", color = "black") + + labs(title = paste("Voting for best genotypes at", stage, "stage in the mother and baby plots"), + x = "Group", y = "Number of votes") + + geom_text(aes(label = value), vjust = 1.6, color = "white", + position = position_dodge(0.9), size = 3) +} +``` + +`r if (nrb > 0 & nrm > 0) {"Below a percentage graph is shown. On the right panel the percentages are adjusted by gender, thus trying to reflect what would have been obtained if the number of men and women would be the same in the sample."}` + +```{r echo = FALSE, fig.height = 5, fig.width = 8} +if (nrb > 0 & nrm > 0) { + ggplot(bothp, aes(x = group, y = value, fill = INSTN)) + + geom_bar(stat = "identity", position = "dodge", color = "black") + + labs(title = paste("Voting for best genotypes at", stage, "stage in the mother and baby plots"), + subtitle = "Percentages unadjusted and adjusted by gender", + x = "Group", y = "Percentage of votes") + + geom_text(aes(label = value), vjust = 1.6, color = "white", + position = position_dodge(0.9), size = 3) +} +``` + +# 5. Friedman test for genotypes + +## 5.1. Men's votes at mother trial + +```{r echo = FALSE} +check <- st4gi::check.rcbd("MSM", "INSTN", "REP", data) +if (max(check$tfreq) > 0 & check$c4 == 1) { + ft <- with(data, friedman(REP, INSTN, MSM, group = T)) + ft$statistics + ft$groups + ft <- with(data, friedman(REP, INSTN, MSM, group = F)) + ft$comparison +} +``` + +`r if (max(check$tfreq) == 0) {"There were no data for men on the mother plot."}` +`r if (max(check$tfreq) > 0 & check$c4 == 0) {"There are some missing values. The design must be balanced to run the Friedman test."}` + +## 5.2. Women's votes at mother trial + +```{r echo = FALSE} +check <- st4gi::check.rcbd("MSWM", "INSTN", "REP", data) +if (max(check$tfreq) > 0 & check$c4 == 1) { + ft <- with(data, friedman(REP, INSTN, MSWM, group = T)) + ft$statistics + ft$groups + ft <- with(data, friedman(REP, INSTN, MSWM, group = F)) + ft$comparison +} +``` + +`r if (max(check$tfreq) == 0) {"There were no data for women on the mother plot."}` +`r if (max(check$tfreq) > 0 & check$c4 == 0) {"There are some missing values. The design must be balanced to run the Friedman test."}` + +## 5.3. Total votes at mother trial + +```{r echo = FALSE} +check <- st4gi::check.rcbd("MSGLO", "INSTN", "REP", data) +if (max(check$tfreq) > 0 & check$c4 == 1) { + ft <- with(data, friedman(REP, INSTN, MSGLO, group = T)) + ft$statistics + ft$groups + ft <- with(data, friedman(REP, INSTN, MSGLO, group = F)) + ft$comparison +} +``` + +`r if (max(check$tfreq) == 0) {"There were no data on the mother plot."}` +`r if (max(check$tfreq) > 0 & check$c4 == 0) {"There are some missing values. The design must be balanced to run the Friedman test."}` + +## 5.4. Men's votes at baby trials + +```{r echo = FALSE} +check <- st4gi::check.rcbd("BSM", "INSTN", "REP", data) +if (max(check$tfreq) > 0 & check$c4 == 1) { + ft <- with(data, friedman(REP, INSTN, BSM, group = T)) + ft$statistics + ft$groups + ft <- with(data, friedman(REP, INSTN, BSM, group = F)) + ft$comparison +} +``` + +`r if (max(check$tfreq) == 0) {"There were no data for men on the baby plots."}` +`r if (max(check$tfreq) > 0 & check$c4 == 0) {"There are some missing values. The design must be balanced to run the Friedman test."}` + +## 5.5. Women's votes at baby trials + +```{r echo = FALSE} +check <- st4gi::check.rcbd("BSWM", "INSTN", "REP", data) +if (max(check$tfreq) > 0 & check$c4 == 1) { + ft <- with(data, friedman(REP, INSTN, BSWM, group = T)) + ft$statistics + ft$groups + ft <- with(data, friedman(REP, INSTN, BSWM, group = F)) + ft$comparison +} +``` + +`r if (max(check$tfreq) == 0) {"There were no data for women on the baby plots."}` +`r if (max(check$tfreq) > 0 & check$c4 == 0) {"There are some missing values. The design must be balanced to run the Friedman test."}` + +## 5.6. Total votes at baby trials + +```{r echo = FALSE} +check <- st4gi::check.rcbd("BSGLO", "INSTN", "REP", data) +if (max(check$tfreq) > 0 & check$c4 == 1) { + ft <- with(data, friedman(REP, INSTN, BSGLO, group = T)) + ft$statistics + ft$groups + ft <- with(data, friedman(REP, INSTN, BSGLO, group = F)) + ft$comparison +} +``` + +`r if (max(check$tfreq) == 0) {"There were no data on the baby plots."}` +`r if (max(check$tfreq) > 0 & check$c4 == 0) {"There are some missing values. The design must be balanced to run the Friedman test."}` diff --git a/inst/hidap_agrofims/www/internal_files/pvs67.Rmd b/inst/hidap_agrofims/www/internal_files/pvs67.Rmd new file mode 100644 index 0000000..20136cf --- /dev/null +++ b/inst/hidap_agrofims/www/internal_files/pvs67.Rmd @@ -0,0 +1,133 @@ +--- +title: "`r params$title`" +subtitle: '`r params$subtitle`' +author: '`r params$author`' +date: '`r format(Sys.time(), "%B %d, %Y")`' +output: + html_document: + theme: united + toc: true + toc_depth: 3 + pdf_document: + toc: true + toc_depth: 3 + highlight: zenburn + word_document: + toc: true + toc_depth: 3 + highlight: "tango" +params: + data: "no data" + form: "no data" + title: "no data" + subtitle: "no data" + author: "no data" +--- + +```{r echo=FALSE} + +## Data + +data <- params$data +colnames(data)[2:4] <- c("Appe", "Tast", "Text") + +## Count number of men and women + +temp <- data[data$Sex == "M" | data$Sex == "Male", ] +nm <- nlevels(factor(temp$PanelNo)) +temp <- data[data$Sex == "F" | data$Sex == "Female", ] +nw <- nlevels(factor(temp$PanelNo)) + +## Aggregate data for principal components + +adg <- docomp("sum", c("Appe", "Tast", "Text"), "INSTN", data = data) +temp <- docomp("sum", c("Appe", "Tast", "Text"), c("INSTN", "Sex"), data = data) +adm <- temp[temp$Sex == "M" | temp$Sex == "Male", ] +adf <- temp[temp$Sex == "F" | temp$Sex == "Female", ] +colnames(adm)[3:5] <- c("Appe-M", "Tast-M", "Text-M") +colnames(adf)[3:5] <- c("Appe-F", "Tast-F", "Text-F") +ads <- cbind(adm[, c(1, 3:5)], adf[, 3:5]) + +rownames(ads) <- ads$INSTN +rownames(adg) <- adg$INSTN + +ads <- ads[, -1] +adg <- adg[, -1] + +``` + +# 1. Gathering of data + +Samples of all genotypes are boiled and presented on plates. Each genotype is evaluated about appearance and taste with the options: + +- 5 excellent, +- 3 fair, +- 1 poor, + +and about texture with: + +- 5 mealy or floury, +- 3 intermediate, +- 1 soggy or watery. + +For the graphs below, the following abbreviations are used: + +- `Appe`: Appearance. +- `Tast`: Taste. +- `Text`: Texture. +- `Appe-M`: Men opinion on appearance. +- `Tast-M`: Men opinion on taste. +- `Text-M`: Men opinion on texture. +- `Appe-W`: Women opinion on appearance. +- `Tast-W`: Women opinion on taste. +- `Text-W`: Women opinion on texture. + +# 2. Results + +A principal components analysis is shown to see the associations among the genotypes and the attributes, first with all the panelists together and then with panelists opinions differentiated by gender. + +```{r echo = FALSE, fig.height = 6, fig.width = 6} +princip <- prcomp(adg, center = T, scale. = T) +summary(princip) +factoextra::fviz_pca(princip, repel = T, + title = "Biplot of genotypes and attributes") +``` + +```{r echo = FALSE, fig.height = 6, fig.width = 6} +princip <- prcomp(ads, center = T, scale. = T) +summary(princip) +factoextra::fviz_pca(princip, repel = T, + title = "Biplot of genotypes and attributes by gender") +``` + +# 3. Friedman test for genotypes + +## 3.1. Analysis for appearance + +```{r echo = FALSE} +ft <- with(data, friedman(PanelNo, INSTN, Appe, group = T)) +ft$statistics +ft$groups +ft <- with(data, friedman(PanelNo, INSTN, Appe, group = F)) +ft$comparison +``` + +## 3.2. Analysis for taste + +```{r echo = FALSE} +ft <- with(data, friedman(PanelNo, INSTN, Tast, group = T)) +ft$statistics +ft$groups +ft <- with(data, friedman(PanelNo, INSTN, Tast, group = F)) +ft$comparison +``` + +## 3.3. Analysis for texture + +```{r echo = FALSE} +ft <- with(data, friedman(PanelNo, INSTN, Text, group = T)) +ft$statistics +ft$groups +ft <- with(data, friedman(PanelNo, INSTN, Text, group = F)) +ft$comparison +``` diff --git a/inst/hidap_agrofims/www/internal_files/pvs9.Rmd b/inst/hidap_agrofims/www/internal_files/pvs9.Rmd new file mode 100644 index 0000000..7b97b02 --- /dev/null +++ b/inst/hidap_agrofims/www/internal_files/pvs9.Rmd @@ -0,0 +1,133 @@ +--- +title: "`r params$title`" +subtitle: '`r params$subtitle`' +author: '`r params$author`' +date: '`r format(Sys.time(), "%B %d, %Y")`' +output: + html_document: + theme: united + toc: true + toc_depth: 3 + pdf_document: + toc: true + toc_depth: 3 + highlight: zenburn + word_document: + toc: true + toc_depth: 3 + highlight: "tango" +params: + data: "no data" + form: "no data" + title: "no data" + subtitle: "no data" + author: "no data" +--- + +```{r echo=FALSE} + +## Data + +data <- params$data +data <- data[, c("REP","INSTN", "STYPE", "SCORE_MEN","SCORE_WOMEN" ,"SCORE_GLOBAL")] +colnames(data)[4:6] <- c("Men", "Women", "Global") +nr <- nlevels(factor(data$REP)) +ds <- docomp("sum", c("Men", "Women", "Global"), "INSTN", data = data) +ds <- tidyr::gather(ds, group, value, Men:Global) + +## Sort by number of votes + +temp <- ds[ds$group == "Global", c("INSTN", "value")] +orden <- temp$INSTN[sort(temp$value, decreasing = T, index.return = T)$ix] +ds$INSTN <- factor(ds$INSTN, levels = orden) + +## Count number of votes + +nvm <- sum(ds[ds$group == "Men", "value"], na.rm = T) +nvw <- sum(ds[ds$group == "Women", "value"], na.rm = T) + +## Count number of voters + +nm <- round(nvm / 6 / nr) +nw <- round(nvw / 6 / nr) + +## Compute percentage adjusted by gender + +dsp <- ds[ds$group == "Global", ] +dsp$value <- dsp$value / (nvm + nvw) +temp <- ds[ds$group != "Global", ] +temp[temp$group == "Men", "value"] <- temp[temp$group == "Men", "value"] / nvm / 2 +temp[temp$group == "Women", "value"] <- temp[temp$group == "Women", "value"] / nvw / 2 +temp <- docomp("sum", "value", "INSTN", data = temp) +temp$group <- "Global adjusted" +dsp <- rbind(dsp, temp) +dsp$value <- round(dsp$value * 100, 1) + +``` + +# 1. Voting process for the identification of best genotypes at post-harvest stage + +A group of farmers, men and women, and other stakeholders are gathered and, after explanation of the overall objectives of the trial, they are asked to identify their three personal favorite genotypes. Then, they are requested to vote by giving: + +- Three votes for the best genotype. +- Two votes for the second. +- One vote for the third. + +Votes are recorded for men and women. + +# 2. Best genotypes + +The genotypes have been planted following a randomized complete block design with `r nr` blocks. A group of men and women voted independently for the best genotypes at each block, so each men and women voted `r nr` times. + +```{r echo = FALSE, fig.height = 5, fig.width = 8} +ggplot(ds, aes(x = group, y = value, fill = INSTN)) + + geom_bar(stat = "identity", position = "dodge", color = "black") + + labs(title = "Voting for best genotypes at post-harvest stage", + x = "Group", y = "Number of votes") + + geom_text(aes(label = value), vjust = 1.6, color = "white", + position = position_dodge(0.9), size = 3) +``` + +Below a percentage graph is shown. On the right panel the percentages are adjusted by gender, thus trying to reflect what would have been obtained if the number of men and women would be the same in the sample. + +```{r echo = FALSE, fig.height = 5, fig.width = 8} +ggplot(dsp, aes(x = group, y = value, fill = INSTN)) + + geom_bar(stat = "identity", position = "dodge", color = "black") + + labs(title = "Voting for best genotypes at post-harvest stage", + subtitle = "Percentages unadjusted and adjusted by gender", + x = "Group", y = "Percentage of votes") + + geom_text(aes(label = value), vjust = 1.6, color = "white", + position = position_dodge(0.9), size = 3) +``` + +# 3. Friedman test for genotypes + +## 3.1. Men's votes + +```{r echo = FALSE} +ft <- with(data, friedman(REP, INSTN, Men, group = T)) +ft$statistics +ft$groups +ft <- with(data, friedman(REP, INSTN, Men, group = F)) +ft$comparison +``` + +## 3.2. Women's votes + +```{r echo = FALSE} +ft <- with(data, friedman(REP, INSTN, Women, group = T)) +ft$statistics +ft$groups +ft <- with(data, friedman(REP, INSTN, Women, group = F)) +ft$comparison +``` + +## 3.3. Total votes + +```{r echo = FALSE} +ft <- with(data, friedman(REP, INSTN, Global, group = T)) +ft$statistics +ft$groups +ft <- with(data, friedman(REP, INSTN, Global, group = F)) +ft$comparison +``` diff --git a/inst/hidap_agrofims/www/internal_files/pvssg.Rmd b/inst/hidap_agrofims/www/internal_files/pvssg.Rmd new file mode 100644 index 0000000..430b185 --- /dev/null +++ b/inst/hidap_agrofims/www/internal_files/pvssg.Rmd @@ -0,0 +1,59 @@ +--- +title: "`r params$title`" +subtitle: '`r params$subtitle`' +author: '`r params$author`' +date: '`r format(Sys.time(), "%B %d, %Y")`' +output: + html_document: + theme: united + toc: true + toc_depth: 3 + pdf_document: + toc: true + toc_depth: 3 + highlight: zenburn + word_document: + toc: true + toc_depth: 3 + highlight: "tango" +params: + traits: "no data" + data: "no data" + title: "no data" + subtitle: "no data" + author: "no data" +--- + +```{r echo=FALSE} + +## Data + +traits <- params$traits +data <- params$data +rownames(data) <- data[, "INSTN"] +data <- data[, traits] + +## Determine traits with missing values + +lit <- map(data, anyNA) %>% unlist() +lgc_lit <- lit %>% as.vector() +lgc_val <- any(lgc_lit == TRUE) +names_trait <- names(lit[lgc_lit]) +msg <- paste(names_trait, collapse = ", ") %>% paste("The next traits have missing values: ",., sep = "") +``` + +`r if(lgc_val) {"There are missing values in some traits. For this reason, we could not perform a principal components analysis"}` +```{r conditional, echo = FALSE, eval= lgc_val, echo = FALSE} +cat(msg) +``` + +`r if(!lgc_val) { "A principal components analysis is shown to see the associations among the genotypes and some attributes."} ` + + +```{r echo = FALSE, eval= !lgc_val , fig.height = 6, fig.width = 6} +princip <- prcomp(data, center = T, scale = T) +summary(princip) +print(princip$x) +factoextra::fviz_pca(princip, repel = T, + title = "Biplot of genotypes and attributes") +``` diff --git a/inst/hidap_agrofims/www/internal_files/rcbd.Rmd b/inst/hidap_agrofims/www/internal_files/rcbd.Rmd new file mode 100644 index 0000000..0a8b300 --- /dev/null +++ b/inst/hidap_agrofims/www/internal_files/rcbd.Rmd @@ -0,0 +1,71 @@ +--- +title: "`r params$title`" +subtitle: '`r params$subtitle`' +author: '`r params$author`' +date: '`r format(Sys.time(), "%B %d, %Y")`' +output: + html_document: + theme: united + toc: true + toc_depth: 3 + pdf_document: + toc: true + toc_depth: 3 + highlight: zenburn + word_document: + highlight: "tango" + toc: true + toc_depth: 3 +params: + traits: "no data" + geno: "no data" + rep: "no data" + data: "no data" + maxp: "no data" + title: "no data" + subtitle: "no data" + author: "no data" +--- + +```{r, echo = FALSE} +library(knitr) + +traits <- params$traits +geno <- params$geno +rep <- params$rep +data <- params$data +maxp <- params$maxp + +data[, geno] <- as.character(data[, geno]) +data[, rep] <- as.character(data[, rep]) +``` + +# 1. Model specification and data description + +There are data from `r nlevels(as.factor(data[, geno]))` genotypes evaluated using a randomize complete block design with `r nlevels(as.factor(data[, rep]))` blocks. The statistical model is +$$ +y_{ij} = \mu + \tau_i + \beta_j + \epsilon_{ij} +$$ +where + +* $y_{ij}$ is the observed response with genotype $i$ and block $j$. +* $\mu$ is the mean response over all genotypes and blocks. +* $\tau_i$ is the effect for genotype $i$. +* $\beta_j$ is the effect for block $j$. +* $\epsilon_{ij}$ is the error term. + +In this model we assume that the errors are independent and have a normal distribution with common variance, that is, $\epsilon_{ij} \sim N(0,\sigma_{\epsilon}^2)$. + +```{r, include = FALSE} +out <- NULL +for (i in 1:length(traits)) { + lc <- check.rcbd(traits[i], geno, rep, data) + if (lc$c1 == 1 & lc$c2 == 1 & lc$c3 == 1 & lc$pmis <= maxp) + out <- c(out, knit_expand('child_rcbd.Rmd')) + else + out <- c(out, knit_expand('child_rcbd_fail.Rmd')) +} + +``` + +`r paste(knit(text = out), collapse = '\n')` diff --git a/inst/hidap_agrofims/www/internal_files/rcbd.docx b/inst/hidap_agrofims/www/internal_files/rcbd.docx new file mode 100644 index 0000000..e59ddd4 Binary files /dev/null and b/inst/hidap_agrofims/www/internal_files/rcbd.docx differ diff --git a/inst/hidap_agrofims/www/loginModule/login.R b/inst/hidap_agrofims/www/loginModule/login.R index 3fcb85f..0d69c3d 100755 --- a/inst/hidap_agrofims/www/loginModule/login.R +++ b/inst/hidap_agrofims/www/loginModule/login.R @@ -205,6 +205,15 @@ observe({ menuSubItem("Open fieldbook", tabName = "openFieldbook", icon = icon("file-o")), menuSubItem("Check fieldbook", tabName = "checkFieldbook", icon = icon("eraser"))#, ), + + menuItem("Single Trial Analysis", icon = icon("chart-bar"), + #menuSubItem("Single trial graph",tabName = "SingleChart", icon = icon("calculator")), + menuSubItem("Single report", tabName = "singleAnalysisReportAgrofims", icon = icon("file-text-o"))#, + #menuSubItem("Genetic report", tabName = "geneticAnalysisReport", icon = icon("file-text-o")) + + #menuSubItem("Data Transformation", tabName = "singleAnalysisTrans", icon = icon("file-text-o")) + ), + menuItem("Documentation", icon = icon("copy") ), @@ -272,6 +281,14 @@ observe({ menuSubItem("Check fieldbook", tabName = "checkFieldbook", icon = icon("eraser"))#, ), + menuItem("Single Trial Analysis", icon = icon("chart-bar"), + #menuSubItem("Single trial graph",tabName = "SingleChart", icon = icon("calculator")), + menuSubItem("Single report", tabName = "singleAnalysisReportAgrofims", icon = icon("file-text-o"))#, + #menuSubItem("Genetic report", tabName = "geneticAnalysisReport", icon = icon("file-text-o")) + + #menuSubItem("Data Transformation", tabName = "singleAnalysisTrans", icon = icon("file-text-o")) + ), + menuItem("Documentation", icon = icon("copy") ), diff --git a/inst/hidap_sbase/app.R b/inst/hidap_sbase/app.R index c54622b..2989312 100755 --- a/inst/hidap_sbase/app.R +++ b/inst/hidap_sbase/app.R @@ -1,4 +1,6 @@ #library(d3heatmap) +library(devtools) +install_github("jrowen/rhandsontable", ref = "v0.3.1") library(shinysky) library(data.table) library(httr) @@ -80,6 +82,7 @@ library(tidyr) library(shinyjs) library(shinyalert) +library(stringi) print("WD de APP") getwd() diff --git a/inst/hidap_sbase/index.html b/inst/hidap_sbase/index.html new file mode 100644 index 0000000..5b6dbf1 --- /dev/null +++ b/inst/hidap_sbase/index.html @@ -0,0 +1,119 @@ + + + + + Interfacing R and Google maps + + + + + + + + + + + + + + + +

Interfacing R with Google maps

+ + + + + + + + + + + + + +
+ +
+
+

Instructions

+

The map is not zoomable. This is because otherwise you won't be able to click on the invisible markers.
+To use the app just select one of the two available maps from the buttons below the title. Click on one of the pixels to update the ID field, and then click "enter" twice to submit the change and update the plot

+ + \ No newline at end of file diff --git a/inst/hidap_sbase/www/internal_files/20180531215741-xZOcEq6MJTz2AS6-crd.Rmd b/inst/hidap_sbase/www/internal_files/20180531215741-xZOcEq6MJTz2AS6-crd.Rmd new file mode 100755 index 0000000..9e2d0ed --- /dev/null +++ b/inst/hidap_sbase/www/internal_files/20180531215741-xZOcEq6MJTz2AS6-crd.Rmd @@ -0,0 +1,61 @@ +--- +title: "`r params$title`" +subtitle: '`r params$subtitle`' +author: '`r params$author`' +date: '`r format(Sys.time(), "%B %d, %Y")`' +output: + html_document: + theme: united + toc: true + toc_depth: 3 + pdf_document: + toc: true + toc_depth: 3 + highlight: zenburn + word_document: + highlight: "tango" + toc: true + toc_depth: 3 +params: + traits: "no data" + geno: "no data" + data: "no data" + maxp: "no data" + title: "no data" + subtitle: "no data" + author: "no data" +--- + +```{r, echo = FALSE} +library(knitr) + +traits <- params$traits +geno <- params$geno +data <- params$data +maxp <- params$maxp + +data[, geno] <- as.character(data[, geno]) +``` + +# 1. Model specification and data description + +There are data from `r nlevels(as.factor(data[, geno]))` genotypes, evaluated using a completely randomized design. The statistical model is +$$ +y_{ij} = \mu + \tau_i + \epsilon_{ij} +$$ +where + +* $y_{ij}$ is the observed response with genotype $i$ and replication $j$. +* $\mu$ is the mean response over all genotypes and replications. +* $\tau_i$ is the effect for genotype $i$. +* $\epsilon_{ij}$ is the error term. + +In this model we assume that the errors are independent and have a normal distribution with common variance, that is, $\epsilon_{ij} \sim N(0,\sigma_{\epsilon}^2)$. + +```{r, include = FALSE} +out <- NULL +for (i in 1:length(traits)) + out <- c(out, knit_expand('child_crd.Rmd')) +``` + +`r paste(knit(text = out), collapse = '\n')` diff --git a/inst/hidap_sbase/www/internal_files/20180531221025-ncBsFJsR2aLGyES-crd.docx b/inst/hidap_sbase/www/internal_files/20180531221025-ncBsFJsR2aLGyES-crd.docx new file mode 100755 index 0000000..741b482 Binary files /dev/null and b/inst/hidap_sbase/www/internal_files/20180531221025-ncBsFJsR2aLGyES-crd.docx differ diff --git a/inst/hidap_sbase/www/internal_files/20180531221218-mMUDxEuAVaSuwJ2-crd.docx b/inst/hidap_sbase/www/internal_files/20180531221218-mMUDxEuAVaSuwJ2-crd.docx new file mode 100755 index 0000000..7912294 Binary files /dev/null and b/inst/hidap_sbase/www/internal_files/20180531221218-mMUDxEuAVaSuwJ2-crd.docx differ diff --git a/inst/hidap_sbase/www/internal_files/20180604192231-PvuET3tjr4HrnyM-crd.docx b/inst/hidap_sbase/www/internal_files/20180604192231-PvuET3tjr4HrnyM-crd.docx new file mode 100755 index 0000000..84caaf3 Binary files /dev/null and b/inst/hidap_sbase/www/internal_files/20180604192231-PvuET3tjr4HrnyM-crd.docx differ diff --git a/inst/hidap_sbase/www/internal_files/crd.docx b/inst/hidap_sbase/www/internal_files/crd.docx new file mode 100755 index 0000000..84caaf3 Binary files /dev/null and b/inst/hidap_sbase/www/internal_files/crd.docx differ diff --git a/inst/hidap_sbase/www/internal_files/fbappdatapath.rds b/inst/hidap_sbase/www/internal_files/fbappdatapath.rds index dd7d9d8..4085409 100755 Binary files a/inst/hidap_sbase/www/internal_files/fbappdatapath.rds and b/inst/hidap_sbase/www/internal_files/fbappdatapath.rds differ diff --git a/inst/hidap_sbase/www/internal_files/hot_fieldbook_sbase.rds b/inst/hidap_sbase/www/internal_files/hot_fieldbook_sbase.rds index 77f0ece..9ec097c 100755 Binary files a/inst/hidap_sbase/www/internal_files/hot_fieldbook_sbase.rds and b/inst/hidap_sbase/www/internal_files/hot_fieldbook_sbase.rds differ diff --git a/inst/rmd/.gitignore b/inst/rmd/.gitignore deleted file mode 100755 index 39d4964..0000000 --- a/inst/rmd/.gitignore +++ /dev/null @@ -1,4 +0,0 @@ -report_location.pdf -report_location.docx -report_location.html -report_location_cache diff --git a/inst/rmd/report_aov.Rmd b/inst/rmd/report_aov.Rmd deleted file mode 100755 index b7070ec..0000000 --- a/inst/rmd/report_aov.Rmd +++ /dev/null @@ -1,34 +0,0 @@ ---- -title: "ANOVA report" -author: "International Potato Center" -date: "September 18, 2015" -output: - html_document: - theme: united - pdf_document: - toc: true - highlight: zenburn - word_document: - highlight: "tango" -params: - fieldbook: "no data" - dependent: "no data" - independent: "no data" ---- - - -```{r, echo=FALSE} -library(agricolae) -library(xtable) - -fb = params$fieldbook -dp = params$dependent -id = params$independent - -fb$INSTN <- as.factor(fb$INSTN) - -``` - -Some ANOVA analysis to be done. - - diff --git a/inst/rmd/report_descriptive.Rmd b/inst/rmd/report_descriptive.Rmd deleted file mode 100755 index 238f969..0000000 --- a/inst/rmd/report_descriptive.Rmd +++ /dev/null @@ -1,50 +0,0 @@ ---- -title: "Descriptive report: trial `r params$meta$title`" -author: '`r params$author`' -date: '`r format(Sys.time(), "%B %d, %Y, %H:%Mh")`' -output: - html_document: - theme: united - pdf_document: - toc: true - highlight: zenburn - word_document: - highlight: "tango" -params: - meta: "no data" - trait: "no data" - treat: "no data" - rep: "no data" - data: "no data" - maxp: "no data" - author: "no data" - ---- - - -```{r, echo=FALSE} - -fb = params$data -tr = params$trait -gt = params$treat -rp = params$rep -au = params$author -mp = params$maxp -meta = params$meta - -#fb$CODE <- as.factor(fb$CODE) - -``` - -The trait variable(s) is/are **`r paste(tr, collapse = ", ")`**; the genotype factor is **`r gt`**. -The replication factor is **`r rp`**. - -Summary of traits: - -```{r, echo=FALSE, comment = NA, results = 'asis'} -DF <- summary(fb[, tr]) -pander::pandoc.table(DF, justify = "llll") -``` - - - diff --git a/inst/rmd/report_location.Rmd b/inst/rmd/report_location.Rmd deleted file mode 100755 index 5f17080..0000000 --- a/inst/rmd/report_location.Rmd +++ /dev/null @@ -1,36 +0,0 @@ ---- -title: "location_report" -author: HIDAP -date: '`r format(Sys.time(), "%B %d, %Y, %H:%Mh")`' -output: - html_document: - theme: united - pdf_document: - toc: true - highlight: zenburn - word_document: - highlight: "tango" -params: - locs: "no data" ---- - - - -```{r, echo=FALSE} -locs = params$locs -n = nrow(locs) -``` - -There are a total of **`r n`** locations in your view. -Latitude range is **`r min(locs$LATD)` to `r max(locs$LATD)`**. - - -You can also embed plots, for example: - -```{r, echo=FALSE} -data <- locsInBounds()$ELEV - n = length(data) - data <- as.numeric(data) - if(n < 1) return("no data") - hist(data, main = "Elevation", xlim = c(0,3600)) -```