[R-br] Res: Res: Implementação em C
Fernando Henrique Toledo
fernandohtoledo em gmail.com
Segunda Março 21 15:19:54 BRT 2011
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 em 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 em gmail.com>
> *Para:* r-br em 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 em listas.c3sl.ufpr.br
> https://listas.inf.ufpr.br/cgi-bin/mailman/listinfo/r-br
>
>
-------------- Próxima Parte ----------
Um anexo em HTML foi limpo...
URL: <http://listas.inf.ufpr.br/pipermail/r-br/attachments/20110321/bbe5cdea/attachment-0001.html>
Mais detalhes sobre a lista de discussão R-br