Как выполнить спаривание двойной пары с R. Пожалуйста, исправьте некоторые проблемы с кодом. - PullRequest
Новая
       59

Как выполнить спаривание двойной пары с R. Пожалуйста, исправьте некоторые проблемы с кодом.

1 голос
/ 15 апреля 2019

Я работаю над растениями, и, как вы знаете, нам нужно сделать много скрещиваний, чтобы улучшить наши сорта. Один вид скрещивания называется «спаривание двойной пары». Я хотел бы реализовать спаривание двойной пары (это означает, что каждый родитель начальной популяции имеет место точно в 2-х разных скрещиваниях), чтобы создать беспородное будущее. селекционные расчетные значения.

Это просто проблема логики, потому что я недостаточно тренируюсь R. Я думаю, вы могли бы помочь мне, не понимая всего этого.

Часть ниже показывает, где я застрял. # выбор пар 

  pairs <- data.frame()
  for (i in 1:2) { 
  pairs <- rbind(pairs,(data.frame(dam=sample(pdams, npairs, replace=TRUE), sire=sample(psires, npairs, replace=TRUE))))
  }
**

Вот весь мой сценарий: 

##################################
####### PEDIGREE FUNCTION ########
##################################

# function to create a pedigree with dispersal
# inputs:
# nids = list of number of individuals per generation
# ngenerations = number of generations to simulate
# epm = rate of extra-pair mating (defaults to NULL, no extra-pair)
# missing = probability that one parent is missing in the pedigree
# nonb = proportion of each generation that is non-breeding
# gridsize = length of one size of (square) spatial grid 
# dispmean = mean dispersal distance (lognormal)
# dispvar = variance in dispersal distance (lognormal)

pedfun<-function(nids, ngenerations, epm=NULL, missing=NULL, nonb=0.4, 
             gridsize=50, dispmean, dispsd){

# get list of individuals and their generations
gener<-1:ngenerations

genern <- rep(1:ngenerations, times = nids)
ID <- 1:sum(nids)

# runs on generation-by-generation basis
for(i in 1:ngenerations){

  id<-ID[which(genern==i)]
  dam<-rep(NA, nids[i])
  sire<-rep(NA, nids[i])

  Xloc<-rep(NA, nids[i])
  Yloc<-rep(NA, nids[i])

  # randomly allocates sex (0 = male, 1 = female)
  sex<-sample(c(0,1), length(id), replace=TRUE)

  # for first generation, no dams or sires are known 
  # so remain NA

if(i==1){

  # for first generation
  # spatial locations sampled at random for X and Y coordinates
  Xloc<-sample(1:gridsize, length(id), replace=TRUE)
  Yloc<-sample(1:gridsize, length(id), replace=TRUE)

  # combine into single data frame
  pedigree<-data.frame(id=id, dam=dam, sire=sire, 
                       generation=i, sex=sex,
                       Xloc=Xloc, Yloc=Yloc, disp_dist=NA,
                       fall=0)

}else if(i>1){

  # for all generations after first
  # list of all possible dams and sires
  # from previous generation
  pdams<-pedigree$id[which(pedigree$generation==(i-1) &
                             pedigree$sex==1)]
  psires<-pedigree$id[which(pedigree$generation==(i-1) &
                              pedigree$sex==0)]

  # determine number of pairs
  # depending on how many males and females
  # and the proportion of the population that is non-breeding
  npairs<-min(length(pdams), length(psires)) - 
    round(min(length(pdams), length(psires))*nonb)

     # selects breeding males and females
  pdams<-pedigree$id[which(pedigree$generation==(i-1) & 
                             pedigree$sex==1 & pedigree$fall==0)]
  psires<-pedigree$id[which(pedigree$generation==(i-1) & 
                              pedigree$sex==0 & pedigree$fall==0)]

  if(length(pdams)<npairs | length(psires)<npairs){
    npairs<-min(length(pdams), length(psires))
  }

  #selection of pairs

  pairs <- data.frame()
  for (i in 1:2) { 
  pairs <- rbind(pairs,(data.frame(dam=sample(pdams, npairs,         replace=TRUE), sire=sample(psires, npairs, replace=TRUE))))
  }
**

  # gives each offspring their parental pair
  pairid<-as.numeric(sample(rownames(pairs), 
                            length(id), replace=TRUE))

  # gives each offspring their sex
  sex<-sample(c(0,1), length(id), replace=TRUE)

  # put into dataframe format
  addped<-data.frame(id=id, 
                     dam=pairs$dam[pairid], 
                     sire=pairs$sire[pairid],
                     generation=i, 
                     sex=sex)

Спасибо за советы!

...