Skip to content

Commit

Permalink
new method for wrong westcott layout
Browse files Browse the repository at this point in the history
  • Loading branch information
@reyzaguirre
reyzaguirre committed Jun 18, 2018
1 parent 084c01d commit ab10db1
Show file tree
Hide file tree
Showing 4 changed files with 180 additions and 154 deletions.
301 changes: 165 additions & 136 deletions R/aj_westcott.R
View file
Original file line number Diff line number Diff line change
@@ -1,8 +1,8 @@
#' Adjust values with a grid of checks
#' Adjust values following the method of Westcott
#'
#' This function adjust the observed values of an experiment planted following
#' the method described by Westcott (1981) with a grid of checks.
#' @param trait The trait to analyze.
#' @param trait The trait to adjust.
#' @param geno The genotypes.
#' @param ch1 Name of check 1.
#' @param ch2 Name of check 2.
Expand Down Expand Up @@ -30,6 +30,9 @@
#' proportion that the checks vary around the field. For values lower than 1
#' the values are adjusted based on that proportion over the checks variation.
#' If \code{p = 0} then there is no adjustment.
#'
#' If the layout does not correspond with the Westcott method, then the observed values
#' are adjusted with the values of the checks planted nearby and a warning is issued.
#' @return It returns the adjusted values.
#' @references
#' Westcott, B. (1981). Two methods for early generation yield assessment in winter wheat.
Expand All @@ -40,7 +43,7 @@
aj.w <- function(trait, geno, ch1, ch2, row, col, nr = 5, ncb = 10, method = 2,
p = 0.5, ind = TRUE, data) {

# Error messages
# Error and warning messages

out <- ck.pos(row, col, data = data)

Expand All @@ -50,19 +53,20 @@ aj.w <- function(trait, geno, ch1, ch2, row, col, nr = 5, ncb = 10, method = 2,
out <- ck.w(trait, geno, ch1, ch2, row, col, ncb, data)

if (out$c1 == 1)
stop("There are plots in the columns of checks with other genotypes planted.")
warning("There are plots in the columns of checks with other genotypes planted.
Adjusted values are obtained with the values of the checks nearby.")

if (out$c2 == 1)
stop("The last column in the field does not have checks.")
warning("There are plots in the columns of genotypes with checks planted.
Adjusted values are obtained with the values of the checks nearby.")

if (out$c3 == 1)
stop("There are plots in the columns of genotypes with checks planted.")
warning("There are columns of checks without alternating checks.
Adjusted values are obtained with the values of the checks nearby.")

if (out$c4 == 1)
stop("There are columns of checks without alternating checks.")

if (out$c5 == 1)
stop("There are plots with genotypes without a check plot to the left or to the right.")
warning("There are plots with genotypes without a check plot to the left or to the right.
Adjusted values are obtained with the values of the checks nearby.")

# Save column names

Expand Down Expand Up @@ -95,157 +99,182 @@ aj.w <- function(trait, geno, ch1, ch2, row, col, nr = 5, ncb = 10, method = 2,

data[data[, geno] %in% c(ch1, ch2) & is.na(data[, trait.aj]), trait.aj] <- 0

# Create columns for check centered values
# Run Westcott adjustment or modify adjustment

data[, ch1] <- NA
data[, ch2] <- NA

# Create columns for prior and posterior check centered values

ch1.pri.1 <- paste(ch1, 'pri.1', sep = '.')
data[, ch1.pri.1] <- NA
ch1.pri.2 <- paste(ch1, 'pri.2', sep = '.')
data[, ch1.pri.2] <- NA
ch1.pos.1 <- paste(ch1, 'pos.1', sep = '.')
data[, ch1.pos.1] <- NA
ch1.pos.2 <- paste(ch1, 'pos.2', sep = '.')
data[, ch1.pos.2] <- NA
ch2.pri.1 <- paste(ch2, 'pri.1', sep = '.')
data[, ch2.pri.1] <- NA
ch2.pri.2 <- paste(ch2, 'pri.2', sep = '.')
data[, ch2.pri.2] <- NA
ch2.pos.1 <- paste(ch2, 'pos.1', sep = '.')
data[, ch2.pos.1] <- NA
ch2.pos.2 <- paste(ch2, 'pos.2', sep = '.')
data[, ch2.pos.2] <- NA

# Create columns for weigths

ch1.w <- paste(ch1, 'w', sep = '.')
data[, ch1.w] <- NA
ch2.w <- paste(ch2, 'w', sep = '.')
data[, ch2.w] <- NA

# Arrange check values and weights

for(i in 1:dim(data)[1]) {

geno.row <- data[i, row]
geno.col <- data[i, col]
columns <- (geno.col - ncb):(geno.col + ncb)
if (out$c1 == 0 & out$c2 == 0 & out$c3 == 0 & out$c4 == 0){

cond1 <- data[, col] %in% columns
cond2 <- data[, geno] %in% c(ch1, ch2)

temp <- data[data[, row] == geno.row & cond1 & cond2, c(geno, trait.aj, col)]

if (dim(temp)[1] == 2) {
# Create columns for check centered values

data[, ch1] <- NA
data[, ch2] <- NA

# Create columns for prior and posterior check centered values

ch1.pri.1 <- paste(ch1, 'pri.1', sep = '.')
data[, ch1.pri.1] <- NA
ch1.pri.2 <- paste(ch1, 'pri.2', sep = '.')
data[, ch1.pri.2] <- NA
ch1.pos.1 <- paste(ch1, 'pos.1', sep = '.')
data[, ch1.pos.1] <- NA
ch1.pos.2 <- paste(ch1, 'pos.2', sep = '.')
data[, ch1.pos.2] <- NA
ch2.pri.1 <- paste(ch2, 'pri.1', sep = '.')
data[, ch2.pri.1] <- NA
ch2.pri.2 <- paste(ch2, 'pri.2', sep = '.')
data[, ch2.pri.2] <- NA
ch2.pos.1 <- paste(ch2, 'pos.1', sep = '.')
data[, ch2.pos.1] <- NA
ch2.pos.2 <- paste(ch2, 'pos.2', sep = '.')
data[, ch2.pos.2] <- NA

# Create columns for weigths

ch1.w <- paste(ch1, 'w', sep = '.')
data[, ch1.w] <- NA
ch2.w <- paste(ch2, 'w', sep = '.')
data[, ch2.w] <- NA

# Arrange check values and weights

for(i in 1:dim(data)[1]) {

# Checks on the row
geno.row <- data[i, row]
geno.col <- data[i, col]
columns <- (geno.col - ncb):(geno.col + ncb)

data[i, ch1] <- temp[temp[, geno] == ch1, trait.aj]
data[i, ch2] <- temp[temp[, geno] == ch2, trait.aj]
cond1 <- data[, col] %in% columns
cond2 <- data[, geno] %in% c(ch1, ch2)

# Checks on row -2
temp <- data[data[, row] == geno.row & cond1 & cond2, c(geno, trait.aj, col)]

temp.pri <- data[data[, row] == geno.row - 2 & cond1 & cond2, c(geno, trait.aj, col)]
if (dim(temp)[1] == 2) {

# Checks on the row

data[i, ch1] <- temp[temp[, geno] == ch1, trait.aj]
data[i, ch2] <- temp[temp[, geno] == ch2, trait.aj]

# Checks on row -2

temp.pri <- data[data[, row] == geno.row - 2 & cond1 & cond2, c(geno, trait.aj, col)]

if (dim(temp.pri)[1] == 2) {
data[i, ch1.pri.2] <- temp.pri[temp.pri[, geno] == ch1, trait.aj]
data[i, ch2.pri.2] <- temp.pri[temp.pri[, geno] == ch2, trait.aj]
}

# Checks on row -1

temp.pri <- data[data[, row] == geno.row - 1 & cond1 & cond2, c(geno, trait.aj, col)]

if (dim(temp.pri)[1] == 2) {
data[i, ch1.pri.1] <- temp.pri[temp.pri[, geno] == ch2, trait.aj]
data[i, ch2.pri.1] <- temp.pri[temp.pri[, geno] == ch1, trait.aj]
}

# Checks on row +1

temp.pos <- data[data[, row] == geno.row + 1 & cond1 & cond2, c(geno, trait.aj, col)]

if (dim(temp.pos)[1] == 2) {
data[i, ch1.pos.1] <- temp.pos[temp.pos[, geno] == ch2, trait.aj]
data[i, ch2.pos.1] <- temp.pos[temp.pos[, geno] == ch1, trait.aj]
}

# Checks on row +2

temp.pos <- data[data[, row] == geno.row + 2 & cond1 & cond2, c(geno, trait.aj, col)]

if (dim(temp.pos)[1] == 2) {
data[i, ch1.pos.2] <- temp.pos[temp.pos[, geno] == ch1, trait.aj]
data[i, ch2.pos.2] <- temp.pos[temp.pos[, geno] == ch2, trait.aj]
}

# Weights for closest checks

if (dim(temp.pri)[1] == 2) {
data[i, ch1.pri.2] <- temp.pri[temp.pri[, geno] == ch1, trait.aj]
data[i, ch2.pri.2] <- temp.pri[temp.pri[, geno] == ch2, trait.aj]
data[i, ch1.w] <- ncb + 1 - abs(temp[temp[, geno] == ch1, col] - geno.col)
data[i, ch2.w] <- ncb + 1 - abs(temp[temp[, geno] == ch2, col] - geno.col)
}
}

# Adjust values with method 1

if (method == 1) {
chs <- c(ch1, ch2, ch1.pri.1, ch2.pri.1, ch1.pos.1, ch2.pos.1)
if (nr == 5)
chs <- c(chs, ch1.pri.2, ch2.pri.2, ch1.pos.2, ch2.pos.2)
af <- apply(data[, chs], 1, mean, na.rm = TRUE)
}

# Adjust values with method 2

if (method == 2) {

# Checks on row -1

temp.pri <- data[data[, row] == geno.row - 1 & cond1 & cond2, c(geno, trait.aj, col)]

if (dim(temp.pri)[1] == 2) {
data[i, ch1.pri.1] <- temp.pri[temp.pri[, geno] == ch2, trait.aj]
data[i, ch2.pri.1] <- temp.pri[temp.pri[, geno] == ch1, trait.aj]
if (nr == 3) {
ch1.m.pri <- apply(data[, c(ch1, ch1.pri.1)], 1, mean, na.rm = TRUE)
ch2.m.pri <- apply(data[, c(ch2, ch2.pri.1)], 1, mean, na.rm = TRUE)
ch1.m.pos <- apply(data[, c(ch1, ch1.pos.1)], 1, mean, na.rm = TRUE)
ch2.m.pos <- apply(data[, c(ch2, ch2.pos.1)], 1, mean, na.rm = TRUE)
}

# Checks on row +1

temp.pos <- data[data[, row] == geno.row + 1 & cond1 & cond2, c(geno, trait.aj, col)]
if (nr == 5) {
foo <- function(x) x * c(1.5, 2, 1)
ch1.w.pri <- t(apply(!is.na(data[, c(ch1, ch1.pri.1, ch1.pri.2)]), 1, foo))
ch2.w.pri <- t(apply(!is.na(data[, c(ch2, ch2.pri.1, ch2.pri.2)]), 1, foo))
ch1.w.pos <- t(apply(!is.na(data[, c(ch1, ch1.pos.1, ch1.pos.2)]), 1, foo))
ch2.w.pos <- t(apply(!is.na(data[, c(ch2, ch2.pos.1, ch2.pos.2)]), 1, foo))

ch1.m.pri <- data[, c(ch1, ch1.pri.1, ch1.pri.2)] * ch1.w.pri
ch2.m.pri <- data[, c(ch2, ch2.pri.1, ch2.pri.2)] * ch2.w.pri
ch1.m.pos <- data[, c(ch1, ch1.pos.1, ch1.pos.2)] * ch1.w.pos
ch2.m.pos <- data[, c(ch2, ch2.pos.1, ch2.pos.2)] * ch2.w.pos

ch1.m.pri <- apply(ch1.m.pri, 1, sum, na.rm = TRUE)
ch2.m.pri <- apply(ch2.m.pri, 1, sum, na.rm = TRUE)
ch1.m.pos <- apply(ch1.m.pos, 1, sum, na.rm = TRUE)
ch2.m.pos <- apply(ch2.m.pos, 1, sum, na.rm = TRUE)

if (dim(temp.pos)[1] == 2) {
data[i, ch1.pos.1] <- temp.pos[temp.pos[, geno] == ch2, trait.aj]
data[i, ch2.pos.1] <- temp.pos[temp.pos[, geno] == ch1, trait.aj]
ch1.w.pri <- apply(ch1.w.pri, 1, sum, na.rm = TRUE)
ch2.w.pri <- apply(ch2.w.pri, 1, sum, na.rm = TRUE)
ch1.w.pos <- apply(ch1.w.pos, 1, sum, na.rm = TRUE)
ch2.w.pos <- apply(ch2.w.pos, 1, sum, na.rm = TRUE)

ch1.m.pri <- ch1.m.pri / ch1.w.pri
ch2.m.pri <- ch2.m.pri / ch2.w.pri
ch1.m.pos <- ch1.m.pos / ch1.w.pos
ch2.m.pos <- ch2.m.pos / ch2.w.pos
}

# Checks on row +2

temp.pos <- data[data[, row] == geno.row + 2 & cond1 & cond2, c(geno, trait.aj, col)]

if (dim(temp.pos)[1] == 2) {
data[i, ch1.pos.2] <- temp.pos[temp.pos[, geno] == ch1, trait.aj]
data[i, ch2.pos.2] <- temp.pos[temp.pos[, geno] == ch2, trait.aj]
}
l.pri <- (ch1.m.pri * data[, ch1.w] + ch2.m.pri * data[, ch2.w]) / (data[, ch1.w] + data[, ch2.w])
l.pos <- (ch1.m.pos * data[, ch1.w] + ch2.m.pos * data[, ch2.w]) / (data[, ch1.w] + data[, ch2.w])

# Weights for closest checks

data[i, ch1.w] <- ncb + 1 - abs(temp[temp[, geno] == ch1, col] - geno.col)
data[i, ch2.w] <- ncb + 1 - abs(temp[temp[, geno] == ch2, col] - geno.col)
af <- apply(cbind(l.pri, l.pos), 1, mean)
}
}

# Adjust values with method 1
# Make adjustment

if (method == 1) {
chs <- c(ch1, ch2, ch1.pri.1, ch2.pri.1, ch1.pos.1, ch2.pos.1)
if (nr == 5)
chs <- c(chs, ch1.pri.2, ch2.pri.2, ch1.pos.2, ch2.pos.2)
af <- apply(data[, chs], 1, mean, na.rm = TRUE)
}
data[, trait.aj] <- data[, trait.aj] / (1 + af)

# Adjust values with method 2

if (method == 2) {

if (nr == 3) {
ch1.m.pri <- apply(data[, c(ch1, ch1.pri.1)], 1, mean, na.rm = TRUE)
ch2.m.pri <- apply(data[, c(ch2, ch2.pri.1)], 1, mean, na.rm = TRUE)
ch1.m.pos <- apply(data[, c(ch1, ch1.pos.1)], 1, mean, na.rm = TRUE)
ch2.m.pos <- apply(data[, c(ch2, ch2.pos.1)], 1, mean, na.rm = TRUE)
}

if (nr == 5) {
foo <- function(x) x * c(1.5, 2, 1)
ch1.w.pri <- t(apply(!is.na(data[, c(ch1, ch1.pri.1, ch1.pri.2)]), 1, foo))
ch2.w.pri <- t(apply(!is.na(data[, c(ch2, ch2.pri.1, ch2.pri.2)]), 1, foo))
ch1.w.pos <- t(apply(!is.na(data[, c(ch1, ch1.pos.1, ch1.pos.2)]), 1, foo))
ch2.w.pos <- t(apply(!is.na(data[, c(ch2, ch2.pos.1, ch2.pos.2)]), 1, foo))
} else {

for(i in 1:dim(data)[1]) {

ch1.m.pri <- data[, c(ch1, ch1.pri.1, ch1.pri.2)] * ch1.w.pri
ch2.m.pri <- data[, c(ch2, ch2.pri.1, ch2.pri.2)] * ch2.w.pri
ch1.m.pos <- data[, c(ch1, ch1.pos.1, ch1.pos.2)] * ch1.w.pos
ch2.m.pos <- data[, c(ch2, ch2.pos.1, ch2.pos.2)] * ch2.w.pos
geno.row <- data[i, row]
geno.col <- data[i, col]
rows <- (geno.row - nr %/% 2):(geno.row + nr %/% 2)
columns <- (geno.col - ncb):(geno.col + ncb)

ch1.m.pri <- apply(ch1.m.pri, 1, sum, na.rm = TRUE)
ch2.m.pri <- apply(ch2.m.pri, 1, sum, na.rm = TRUE)
ch1.m.pos <- apply(ch1.m.pos, 1, sum, na.rm = TRUE)
ch2.m.pos <- apply(ch2.m.pos, 1, sum, na.rm = TRUE)
cond1 <- data[, col] %in% columns & data[, row] %in% rows
cond2 <- data[, geno] %in% c(ch1, ch2)

ch1.w.pri <- apply(ch1.w.pri, 1, sum, na.rm = TRUE)
ch2.w.pri <- apply(ch2.w.pri, 1, sum, na.rm = TRUE)
ch1.w.pos <- apply(ch1.w.pos, 1, sum, na.rm = TRUE)
ch2.w.pos <- apply(ch2.w.pos, 1, sum, na.rm = TRUE)
temp <- data[cond1 & cond2, trait.aj]

ch1.m.pri <- ch1.m.pri / ch1.w.pri
ch2.m.pri <- ch2.m.pri / ch2.w.pri
ch1.m.pos <- ch1.m.pos / ch1.w.pos
ch2.m.pos <- ch2.m.pos / ch2.w.pos
if (length(temp) > 0 & !(data[i, geno] %in% c(ch1, ch2))) {
af <- mean(temp)
data[i, trait.aj] <- data[i, trait.aj] / (1 + af)
}
}

l.pri <- (ch1.m.pri * data[, ch1.w] + ch2.m.pri * data[, ch2.w]) / (data[, ch1.w] + data[, ch2.w])
l.pos <- (ch1.m.pos * data[, ch1.w] + ch2.m.pos * data[, ch2.w]) / (data[, ch1.w] + data[, ch2.w])

af <- apply(cbind(l.pri, l.pos), 1, mean)
}

# Make adjustment

data[, trait.aj] <- data[, trait.aj] / (1 + af)

# Return

Expand Down
Loading

0 comments on commit ab10db1

Please sign in to comment.