Nothing
'#
Authors
Torsten Pook, torsten.pook@uni-goettingen.de
Copyright (C) 2017 -- 2020 Torsten Pook
This program is free software; you can redistribute it and/or
modify it under the terms of the GNU General Public License
as published by the Free Software Foundation; either version 3
of the License, or (at your option) any later version.
This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
GNU General Public License for more details.
You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
'#
#' Manually enter estimated breeding values
#'
#' Function to manually enter estimated breeding values
#' @param population Population list
#' @param bves Matrix of breeding values to enter (one row per individual with 1 element coding individual name)
#' @param type which time of values to input (default: "bve", alt: "bv", "pheno")
#' @param na.override Set to TRUE to also enter NA values (Default: FALSE - those entries will be skipped)
#' @param count Counting for economic cost calculation (default: 1 - (one observation (for "pheno"), one genotyping (for "bve")))
#' @param count.only.increase Set to FALSE to reduce the number of observation for a phenotype to "count" (default: TRUE)
#' @examples
#' data(ex_pop)
#' bv <- get.bv(ex_pop, gen=2)
#' new.bve <- cbind( colnames(bv), bv[,1]) ## Unrealistic but you do not get better than this!
#' ex_pop <- insert.bve(ex_pop, bves=new.bve)
#' @return Population-List with newly entered estimated breeding values
#' @export
insert.bve <- function(population, bves, type="bve", na.override = FALSE, count=1, count.only.increase=TRUE){
add <- 2
if(type=="bv"){
add <- 6
} else if(type=="pheno"){
add <- 8
}
if((ncol(bves)-1)!=population$info$bv.nr){
stop("Number of traits entered does not match with population! \n Enter NA colums if you dont want to overwrite a trait")
}
for(index in 1:nrow(bves)){
sex <- as.numeric(substr(bves[index,1], start=1, stop=1)=="F") + 1
split <- strsplit(bves[index,1], split=c("_"))
nr <- as.numeric(substr(split[[1]][1], start=2, stop=nchar(split[[1]][1])))
gen <- as.numeric(split[[1]][2])
if(na.override & add == 8){
population$breeding[[gen]][[sex+add]][,nr] <- as.numeric(bves[index,-1])
} else{
population$breeding[[gen]][[sex+add]][,nr][!is.na(as.numeric(bves[index,-1]))] <- as.numeric(bves[index,-1])[!is.na(as.numeric(bves[index,-1]))]
}
if(add==2){
population$breeding[[gen]][[sex]][[nr]][[16]] <- count
} else if(add==8){
if(count > 0 ){
temp1 <- (!is.na(population$breeding[[gen]][[sex+add]][,nr]))* count
if(count.only.increase){
population$breeding[[gen]][[sex]][[nr]][[15]][population$breeding[[gen]][[sex]][[nr]][[15]]<temp1] <- temp1[population$breeding[[gen]][[sex]][[nr]][[15]]<temp1]
} else{
population$breeding[[gen]][[sex]][[nr]][[15]] <- temp1
}
}
}
}
return(population)
}
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.