#' make.iyt function
#'
#' This function allows you to make ity/AYT trials which differ from VT because they have checks
#' @description This is a wraper for FldTrial's design.rcbd fucntion, sepcificly for maing a standard IYT/AYT type trial,
#' in a RCB design where within experiemnt fills are done with Checks ,
#' one set of checks per block
#' which may induce duplicaes witin blocks but makes for better planting files,
#' adds functions to allow export of planting order and maps,
#' it will also ad ZURN codes, and strips out uneeded extra columns, will also export a filed book type sheet for data collection.
#' @param loc.to.use REQUIRED is the name of the location useing hte code naem ie "crk"
#' @param loc.ids REQUIRED is a csv file with the first column being "loc.number"which is the zurn number for the location, the second column"location" is the full name of the locatoin, the third column has the codeded location name i.e. "crk" must match input to loc.to.use, the fourth column "beds" has the number of beds i.e. rows of that location
#' @param trial.ids REQUIRED is a csv file with teh first column "trial.number" has the trial id's fromt he zunr number,second column has the coded trail name i.e. "VT"
#' @param experiment REQUIRED is the name of the experiment you are making ie "VT" must match trail.ids coded name
#' @param entries REQUIRED is a csv file i.e.("18 VT 9jan18.csv") with one column "line" which has the list of the entries for the VT
#' @param plot.start OPTIONAL the number of the first plot i.e. 0 or 1 or 1000 which ever, Default is 1
#' @param number.blocks OPTIONALis the number of blocks to use i.e. 0 or 1 or 2 or 3. Defalut is 3
#' @param year REQUIRED is the year of the planting i.e. 2018
#' @param zurn.seed REQUIRED is the zurn code for the crop i.e. 5 for oat or 3 for barley
#' @param checks REQUIRED a csv file i.e.("18 VT 9jan18.csv") with one column "check" which has the list of the chekcs
#'
#' @examples
#'
#'
#'
#' @export
make.iyt <- function(
loc.to.use=NULL,
loc.ids=NULL,
trial.ids=NULL,
experiment=NULL,
entries= NULL,
plot.start=NULL,
number.blocks=NULL,
num.beds=NULL,
year=NULL,
zurn.seed=NULL,
checks =NULL,
num.reps.chk=NULL){
#
#pacakges needed
library(BreedR)
library(plyr)
library(stringr)
#
# from user inputs
loc.to.use<-loc.to.use
loc.ids<-read.csv(loc.ids)
trial.ids<-read.csv(trial.ids)
experiment<-experiment
entries<-read.csv(entries)
plot.start<-plot.start
number.blocks<-number.blocks
year<-year
zurn.seed<-zurn.seed
checks<-read.csv(checks)
num.beds<-num.beds
num.reps.chk<-num.reps.chk
#
# deduced from user inputs
location.list<-loc.ids$environment # will make a file for each locatio i nthe loc.ids file
#bed.list<-loc.ids$beds
#bed.list<-num.beds
### testing if the number of checks was good between 10% and 25%
# interval test function
in_interval <- function(x, interval){
stopifnot(length(interval) == 2L)
interval[1] <= x & x <= interval[2]
}
# if(in_interval(dim(checks)[1], c(ceiling ((dim(entries)[1] *.1)/num.reps.chk), ceiling ((dim(entries)[1] *.25)/num.reps.chk))) == F ) {
# stop("suggested number of checks is ",ceiling ((dim(entries)[1] *.1)/num.reps.chk), " to ", ceiling ((dim(entries)[1] *.25)/num.reps.chk),
# " change value of num.reps.chk or number of checks")}
#checking if the checks are not a entry
conflicts<-checks$line %in% entries$line
conflict.chk<-checks$line [which(conflicts == TRUE)]
if(any(conflicts == TRUE)) {warning("checks must not appear in the entry list, suggest add '_chk' to ", conflict.chk)}
if(any(conflicts == TRUE)) {stop(" ")}
#
###
i<-which(location.list ==loc.to.use) # get postion of the name of the locatoin
enviro<-location.list[i] # geting the enviroemnt to use
rcbd <- design.rcbd(enviro = location.list[i], exp.name = experiment, chks = checks, nChkReps =num.reps.chk,
nBlks = number.blocks, entries = entries, nChks = 0, nFieldRows = num.beds,
plot.start = plot.start, fillWithEntry = FALSE, fillWithChk = TRUE)
# makin the map file
plot.lay<-rcbd$plot.layout
plot.lay<-as.data.frame(plot.lay)
rep.lay<-rcbd$rep.layout
rep.lay<-as.data.frame(rep.lay)
check.lay<-rcbd$check.layout
check.lay<-as.data.frame(check.lay)
map<-cbind(loc=rep(enviro, nrow(plot.lay)), plot.lay, rep.lay,check.lay )
#
#making the data file
dgn<-rcbd$rcbd.dg
dgn$environment<-as.character(dgn$environment)
dgn<-join(dgn, loc.ids, by= "environment")
dgn$experiment<-rep(experiment, nrow(dgn))
dgn<-join(dgn, trial.ids, by= "experiment")
#makes the zurn code
dgn$zurn<-paste((zurn.seed*100)+dgn$loc.number,formatC(dgn$trial.number, width=2, flag="0"), dgn$replication, str_pad(dgn$plot, 4, pad = 0), sep="")
dgn <- within(dgn, zurn[replication == "FILLER"] <- NA) # if replication is FILLER than make zurn code NA
#dgn <- within(dgn, replication[replication == "FILLER"] <- NA) # if replication is FILLER than make it NA
#
# making a plating order
junk<-dgn
junk<-junk[,c("row", "column", "plant_order")]
junk2<-reshape(junk, idvar = "row", timevar = "column", direction = "wide")
junk2<-junk2[ order(-junk2[,1]), ]
rm(junk)
#
map<-map[-nrow(map),]
map2<-cbind(map, junk2)
number_cols<- 1:length(unique(dgn$column))
colnames(map2)<-c("loc","row",paste("column",number_cols, sep="_"), "row", paste("column",number_cols, sep="_"),"row",
paste("column",number_cols, sep="_"), "row", paste("column",number_cols, sep="_") )
#colnames(map2)<-c("loc","row",number_cols, "row", number_cols,"row", number_cols )
map<-map2
map2<-map
map2[] <- lapply(map2, as.character)
map2[nrow(map2) + 1,] = c(
NA,NA,rep("plot_order", max(number_cols)),
NA, rep("rep_order", max(number_cols)),
NA, rep("check_order", max(number_cols)),
NA, rep("plant_order", max(number_cols)))
map<-map2
rm(map2)
#######################################################
# house keeping making the files better to order
dgn$trial<-paste(c(experiment,year,as.character(enviro[1])),collapse="_") # adding data based trail naems
dgn<-dgn[,-c(2, 4, 12 ,13 ,14, 15 )] # droping unndded cols
#dgn<-dgn[,-c(2, 4, 12 ,13 ,14, 15, 16 )] # droping unndded cols
dgn<-dgn[ order(dgn$line_name,dgn$plant_order ) , ] # reorder for packing
return(list(data.book=dgn, map.file=map))
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.