
Fabio, A entrada da função dialelo é além dos outros argumentos explicados abaixo uma planilha de dados \textsf{data.frame} que contêm na primeira coluna identificação da família do indivíduo, na segunda coluna o pai (progenitor 1) do indivíduo, na terceira coluna a mãe do indivíduo (progenitor 2). Da quarta até a coluna \textsl{\texttt{g + 3}} são os valores genotípicos por loco do indivíduo, e nas últimas duas colunas tem-se o valor genotípico total e o valor fenotípico do indivído respectivamente. A função denominada \textsl{\texttt{dialelo}} e tem com argumentos: \textsl{\texttt{pais}} que é um vetor contendo a identificação dos indivíduos que serão os pais no dialelo. O argumento \textsl{\texttt{populacao}} indica de que população esses indivíduos serão obtidos (o data.frame descrito acima), \textsl{\texttt{prole}}, assim como na função \textsl{\texttt{cruz}} é um número inteiro que indica quantos individuos filhos serão gerados a partir de um dado cruzamento do dialelo. Os argumentos \textsl{\texttt{h2}}, é um valor entre zero e um, que dimensiona um ruido proposital e \textsl{\texttt{gmd}}, pode assumir qualquer valor, mas o que será utilizado é 0 ou 1, que simula diferentes interações alélicas! abraço, Fernando H 2011/3/21 Fabio Mathias Corrêa <fabio.ufla@yahoo.com.br>
Fernando,
Faltou apenas um pequeno exemplo de como inicia a simulação!
Valeu!!!
Fábio Mathias Corrêa Departamento de Estatística Universidade Estadual de Santa Cruz
Tel.: 73-3680-5076 Cel.: 73-9991-8155
------------------------------ *De:* Fernando Henrique Toledo <fernandohtoledo@gmail.com> *Para:* r-br@listas.c3sl.ufpr.br *Enviadas:* Segunda-feira, 21 de Março de 2011 8:43:36 *Assunto:* Re: [R-br] Res: Implementação em C
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 }
_______________________________________________ R-br mailing list R-br@listas.c3sl.ufpr.br https://listas.inf.ufpr.br/cgi-bin/mailman/listinfo/r-br