Senhores, bom dia. A simulação que pretendo realizar implementei através das funções que estão listadas abaixo, a combinations é do pacote gtools, necessáriamente queria só melhorar o tempo de processamento do função dialelo, especificamente no for() que corre pela matriz de combinações. Fui rodando odas as etapas da função e detectei justamente nesse ponto o gargalo do calculo. att, Fernando H # _____________________________________________________________________ #_ OK #_ Função para cálculo do valor genotípico #_ Parâmetros: indv = indvíduo sob análise # gmd = grau médio de dominância #______________________________________________________________________ soma.vg <- function(indv, gmd){ # argumentos da função h <- gmd # atribui o desvio de dominância ao heterozigoto gen <- numeric() # cria um vetor qualquer - armazena os valores genotípicos for(i in 1:length(indv)){ # 'laço' - passa a regra p/ cada loco # se o loco for igual a 'r' (recessivo) valor genotípico recebe -1 # se o loco for igual a 'h' (heterozigoto) valor genotípico recebe gmd # se o loco for igual a 'd' (dominante) valor genotípico recebe 1 if(indv[i] == 'r') { gen[i] <- -1 } else { if(indv[i] == 'h') gen[i] <- h else gen[i] <- 1 } } return(sum(gen)) # retorna a soma dos valores genotípcos por loco } # _____________________________________________________________________ #_ OK #_ Função para regra da segregação #_ Parâmetros: pai e mãe = indvíduos sob análise (cruzando) #______________________________________________________________________ segregacao <- function(pai, mae) { # argumentos da função filho <- numeric() # cria um vetor qualquer - armazena os valores genotípicos do filho for(i in 1:length(pai)) { # 'laço' - passa a regra de segregação p/ cada loco # se ambos pais são homozigotos dominantes (d), filho é dominante (d) # se um pai é dominante e o outro é heterozigoto (h) filho pode ser 'h' ou 'd' 50% p/ cada # se ambos pais são heterozigoto segregação 1:2:1 'd', 'h', e 'r' # se um pai é dominante e o outro é recessivo filho é heterozigoto # se um pai é reccessivo e o outro é heterozigoto filho pode ser 'r' ou 'r' 50% p/ cada # se ambos pais são recessivos filho é recessivo if(pai[i] == 'd' & mae[i] == 'd') filho[i] <- 'd' if(pai[i] == 'd' & mae[i] == 'h' | pai[i] == 'h' & mae[i] == 'd'){ u <- runif(1) if(u <= .5) filho[i] <- 'd' else filho[i] <- 'h' } if(pai[i] == 'd' & mae[i] == 'r' | pai[i] == 'r' & mae[i] == 'd'){ filho[i] <- 'h' } if(pai[i] == 'h' & mae[i] == 'h'){ u <- runif(1) if(u <= .25) filho[i] <- 'd' else if((u > .25) & (u <= .75)) filho[i] <- 'h' else filho[i] <- 'r' } if(pai[i] == 'h' & mae[i] == 'r' | pai[i] == 'r' & mae[i] == 'h'){ u <- runif(1) if(u <= .5) filho[i] <- 'h' else filho[i] <- 'r' } if(pai[i] == 'r' & mae[i] == 'r') filho[i] <- 'r' } return(filho) # retorna a constituição genética do filho do cruzamento } # _____________________________________________________________________ #_ OK #_ Função para fazer cruzamentos #_ Parâmetros: pai e mae = indvíduos, 'pai' e 'mãe' # prole = número de indivíduos na progênie #______________________________________________________________________ cruz<-function(pai, mae, prole){ # argumentos da função progenie <- matrix(NA, ncol = length(pai), nrow = prole) # cria matriz qualquer [prole,g] - armazena a prole for(i in 1:prole) { #'laço' - cria prole filhos do cruzamento progenie[i,] <- segregacao(pai, mae) } return(progenie) # retorna a prole do cruzamento }
# _____________________________________________________________________ # #_ Função para fazer um dialelo #_ Parâmetros: pais = indivíduos selecionados na população anterior # população = população dos pais # prole = tamanho das progênies # h2 = herdabilidade do caráter # gmd = grau médio de dominância #______________________________________________________________________ dialelo <- function(pais, populacao, prole, h2, gmd) { # argumentos da função combinacoes <- combinations(length(pais), 2, v = pais) # cria todas as combinações híbridas progenies <- vector('list', length = nrow(combinacoes)) # cria a estrutura das progênies id <- cbind(rep(c(1:nrow(combinacoes)), each = prole), rep(combinacoes[,1], each = prole), rep(combinacoes[,2], each = prole)) # cria a estrutura de identificação das progênies g <- ncol(populacao) - 5 # verifica o número de genes envolvidos for(i in 1:nrow(combinacoes)) { # 'laço' - para executar todos cruzamentos cruz.i <- cruz(populacao[combinacoes[i,1],4:(3 + g)], populacao[combinacoes[i,2],4:(3 + g)],prole) # aplica a função 'cruz' progenies[[i]] <- cruz.i # armazena a prole de cada cruzamento } dialelo <- as.data.frame(do.call(rbind, progenies)) # monta a planilha com o dialelo vg <- apply(dialelo, 1, soma.vg, gmd = gmd) # calcula os valores genotípicos totais por indivíduo varg <- var(vg) # calcula a variância genética fen <- vg + rnorm(nrow(dialelo), mean = 0, sqrt(varg * (1 - h2) / h2)) # atribui o desvio fenotípico resp <- cbind(id, dialelo, vg, fen) # monta a planilha com os resultados do dialelo names(resp) <- c('fami', 'pai', 'mae', 1:g, 'vg', 'fen') # atribui os nomes as colunas da planilha return(resp) # retorna o dialelo }