Senhores, bom dia.<br><br>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.<br>
<br>att,<br>Fernando H<br><br># _____________________________________________________________________<br>#_ OK<br>#_ Função para cálculo do valor genotípico<br>#_ Parâmetros: indv = indvíduo sob análise<br># gmd = grau médio de dominância<br>
#______________________________________________________________________<br><br><a href="http://soma.vg">soma.vg</a> <- function(indv, gmd){ # argumentos da função<br> h <- gmd # atribui o desvio de dominância ao heterozigoto<br>
gen <- numeric() # cria um vetor qualquer - armazena os valores genotípicos<br> for(i in 1:length(indv)){ # 'laço' - passa a regra p/ cada loco<br> # se o loco for igual a 'r' (recessivo) valor genotípico recebe -1<br>
# se o loco for igual a 'h' (heterozigoto) valor genotípico recebe gmd<br> # se o loco for igual a 'd' (dominante) valor genotípico recebe 1<br> if(indv[i] == 'r') {<br> gen[i] <- -1<br>
} else {<br> if(indv[i] == 'h') gen[i] <- h else gen[i] <- 1<br> }<br> }<br> return(sum(gen)) # retorna a soma dos valores genotípcos por loco<br>}<br><br># _____________________________________________________________________<br>
#_ OK<br>#_ Função para regra da segregação<br>#_ Parâmetros: pai e mãe = indvíduos sob análise (cruzando)<br>#______________________________________________________________________<br><br>segregacao <- function(pai, mae) { # argumentos da função<br>
filho <- numeric() # cria um vetor qualquer - armazena os valores genotípicos do filho<br> for(i in 1:length(pai)) { # 'laço' - passa a regra de segregação p/ cada loco<br> # se ambos pais são homozigotos dominantes (d), filho é dominante (d)<br>
# se um pai é dominante e o outro é heterozigoto (h) filho pode ser 'h' ou 'd' 50% p/ cada<br> # se ambos pais são heterozigoto segregação 1:2:1 'd', 'h', e 'r'<br> # se um pai é dominante e o outro é recessivo filho é heterozigoto<br>
# se um pai é reccessivo e o outro é heterozigoto filho pode ser 'r' ou 'r' 50% p/ cada<br> # se ambos pais são recessivos filho é recessivo<br> if(pai[i] == 'd' & mae[i] == 'd') filho[i] <- 'd'<br>
if(pai[i] == 'd' & mae[i] == 'h' | pai[i] == 'h' & mae[i] == 'd'){<br> u <- runif(1)<br> if(u <= .5) filho[i] <- 'd' else filho[i] <- 'h'<br>
}<br> if(pai[i] == 'd' & mae[i] == 'r' | pai[i] == 'r' & mae[i] == 'd'){<br> filho[i] <- 'h'<br> }<br> if(pai[i] == 'h' & mae[i] == 'h'){<br>
u <- runif(1)<br> if(u <= .25) filho[i] <- 'd' else<br> if((u > .25) & (u <= .75)) filho[i] <- 'h' else<br> filho[i] <- 'r'<br> }<br> if(pai[i] == 'h' & mae[i] == 'r' | pai[i] == 'r' & mae[i] == 'h'){<br>
u <- runif(1)<br> if(u <= .5) filho[i] <- 'h' else filho[i] <- 'r'<br> }<br> if(pai[i] == 'r' & mae[i] == 'r') filho[i] <- 'r'<br> }<br> return(filho) # retorna a constituição genética do filho do cruzamento<br>
}<br><br># _____________________________________________________________________<br>#_ OK<br>#_ Função para fazer cruzamentos<br>#_ Parâmetros: pai e mae = indvíduos, 'pai' e 'mãe'<br># prole = número de indivíduos na progênie <br>
#______________________________________________________________________<br><br>cruz<-function(pai, mae, prole){ # argumentos da função<br> progenie <- matrix(NA, ncol = length(pai), nrow = prole) # cria matriz qualquer [prole,g] - armazena a prole<br>
for(i in 1:prole) { #'laço' - cria prole filhos do cruzamento<br> progenie[i,] <- segregacao(pai, mae)<br> }<br> return(progenie) # retorna a prole do cruzamento<br>}<br><div class="gmail_quote"><br><blockquote class="gmail_quote" style="border-left: 1px solid rgb(204, 204, 204); margin: 0pt 0pt 0pt 0.8ex; padding-left: 1ex;">
<div><div class="h5">
><br>
> # _____________________________________________________________________<br>
> #<br>
> #_ Função para fazer um dialelo<br>
> #_ Parâmetros: pais = indivíduos selecionados na população anterior<br>
> # população = população dos pais<br>
> # prole = tamanho das progênies<br>
> # h2 = herdabilidade do caráter<br>
> # gmd = grau médio de dominância<br>
> #______________________________________________________________________<br>
> dialelo <- function(pais, populacao, prole, h2, gmd) { # argumentos da<br>
> função<br>
> combinacoes <- combinations(length(pais), 2, v = pais) # cria todas as<br>
> combinações híbridas<br>
> progenies <- vector('list', length = nrow(combinacoes)) # cria a<br>
> estrutura<br>
> das progênies<br>
> id <- cbind(rep(c(1:nrow(combinacoes)), each = prole),<br>
> rep(combinacoes[,1], each = prole),<br>
> rep(combinacoes[,2], each = prole)) # cria a estrutura de<br>
> identificação das progênies<br>
> g <- ncol(populacao) - 5 # verifica o número de genes envolvidos<br>
> for(i in 1:nrow(combinacoes)) { # 'laço' - para executar todos<br>
> cruzamentos<br>
> cruz.i <- cruz(populacao[combinacoes[i,1],4:(3 + g)],<br>
> populacao[combinacoes[i,2],4:(3 + g)],prole) # aplica a<br>
> função 'cruz'<br>
> progenies[[i]] <- cruz.i # armazena a prole de cada cruzamento<br>
> }<br>
> dialelo <- as.data.frame(do.call(rbind, progenies)) # monta a planilha<br>
> com<br>
> o dialelo<br>
> vg <- apply(dialelo, 1, <a href="http://soma.vg" target="_blank">soma.vg</a>, gmd = gmd) # calcula os valores<br>
> genotípicos totais por indivíduo<br>
> varg <- var(vg) # calcula a variância genética<br>
> fen <- vg + rnorm(nrow(dialelo), mean = 0, sqrt(varg * (1 - h2) / h2)) #<br>
> atribui o desvio fenotípico<br>
> resp <- cbind(id, dialelo, vg, fen) # monta a planilha com os resultados<br>
> do dialelo<br>
> names(resp) <- c('fami', 'pai', 'mae', 1:g, 'vg', 'fen') # atribui os<br>
> nomes as colunas da planilha<br>
> return(resp) # retorna o dialelo<br>
> }<br></div></div></blockquote></div>