Traduções desta página:

Ferramentas do usuário

Ferramentas do site


05_curso_antigo:r2019:alunos:trabalho_final:andrevrodrigues:selsex

Função: selsex()

rm(list=ls()) 

selsex <- function(scenario1, scenario2, n_males = 100, gpc = T)
{
#### Para recordar: scenario1 e scenario2 são objetos que representam o quanto um ambiente tem de abundância de recursos
##### 1 - seria um ambiente com escassez de recursos. 10 - um ambiente com abundância de recursos.
#### n_males é um objeto que representa quantos machos conseguirão copular com um fêmea depois de disputarem os recursos.
  
#### Verificando se scenario1 não é numérico
if(is.numeric(scenario1) == F)
  #### Caso não for numérico, demonstrar mensagem abaixo e interromper função
  stop("The argument for scenario1 must be numeric and an integer!!")
#### Caso scenario1 for numérico...
else
{
  #### Arredondar scenario1 para um valor inteiro e colocar ele no objeto 'a'
  a <- round(scenario1)
  #### Verificar se o valor arredondado 'a' é diferente de scenario1
  if(a != scenario1)
    #### Se houver diferença, demonstrar mensagem abaixo e interromper função
    stop("The argument for scenario1 must be numeric and an integer!!")
}
#### Verificando se scenario2 não é numérico
if(is.numeric(scenario2) == F)
  #### Caso não for numérico, demonstrar mensagem abaixo e interromper função
  stop("The argument for scenario2 must be numeric and an integer!!")
#### Caso scenario2 for numérico...
else
{
  #### Arredondar scenario2 para um valor inteiro e colocar ele no objeto 'a'
  a <- round(scenario2)
  #### Verificar se o valor arredondado 'a' é diferente de scenario2
  if(a != scenario2)
    #### Se houver diferença, demonstrar mensagem abaixo e interromper função
    stop("The argument for scenario2 must be numeric and an integer!!")
}
#### Verificando se n_males não é numérico ou menor que UM
if(is.numeric(n_males) == F || n_males < 1)
  #### Caso não for numérico ou menor que UM, demonstrar mensagem abaixo e interromper função
  stop("The argument for n_males must be numeric, an integer and positive!!")
#### Caso n_males for numérico e maior que ZERO...
else
{
  #### Arredondar n_males para um valor inteiro e colocar ele no objeto 'a'
  a <- round(n_males)
  #### Verificar se o valor arredondado 'a' é diferente de n_males
  if(a != n_males)
    #### Se houver diferença, demonstrar mensagem abaixo e interromper função
    stop("The argument for n_males must be numeric, an integer and positive!!")
}
#### verificar se scenario1 é menor que UM ou maior que 10
if(scenario1 < 1 || scenario1 > 10)
  #### Caso for, apresentar seguinte mensagem e interromper função
  stop("The argument for scenario1 must be between 1 and 10!!")
#### verificar se scenario2 é menor que UM ou maior que 10
if(scenario2 < 1 || scenario2 > 10)
  #### Caso for, apresentar seguinte mensagem e interromper função
  stop("The argument for scenario2 must be between 1 and 10!!")
#### Verificar se n_males é menor que 30
if(n_males < 30)
  #### Caso for, apresentar a seguinte mensagem de advertência
  warning("Low values of n_males may cause biological misinterpretation!!\nFor a better biological interpretation, use n_males values equal or greater than 30.")
#### Verificar se scenario1 é igual a scenario2
if(scenario1 == scenario2)
  #### Caso for, apresentar a seguinte mensagem de advertência
  warning("The two scenarios have the same resourcer scarcity. You will not be able to see significant differences!!")
#### Verificar se graphs é uma variável lógica
if(is.logical(gpc) == F)
  ### Caso não for, interromper função e exibir a mensagem
  stop("The argument for graphs must be logical (TRUE or FALSE)!!")
  
#### Biblioteca utilizada para desenhar os círculos da esquematização dos modelos.  
library("plotrix")

#### Criando Vetor com o melhor fenótipo para o cenário 1 ####
m_best1 <- vector(length = n_males) 
#### Criando Vetor com o melhor fenótipo para o cenário 2 ####
m_best2 <- vector(length = n_males)

#### for com n_males disputas entre 11-scenario1 machos por cada local de recurso
for(i in 1:n_males)
{
  #11-scenario1 machos chegando no recurso
  m_disputa1 <- sample(1:10, 11-scenario1, replace = T) 
  #disputa com apenas um macho de maior valor vira o selecionado
  m_best1[i] <- max(m_disputa1)                         
}

#### for com n_males disputas entre 11-scenario2 machos por cada local de recurso
for(i in 1:n_males)
{
  #11-scenario2 machos chegando no recurso
  m_disputa2 <- sample(1:10, 11-scenario2, replace = T)
  #disputa com apenas um macho de maior valor vira o selecionado
  m_best2[i] <- max(m_disputa2)
}
# Comparação entre os fenótipos selecionados do cenário 1 e 2
t <- t.test(m_best1, m_best2)

# Verificando se o usuário quer os gráficos
if(gpc == FALSE)
  # Se não, apenas devoler os valores do teste t
  return(t)

  #### Abrindo janela para melhor visualização
  x11(width = 20, height = 12)

  #### Criando um layout para organizar a janela de visualização
  layout(mat = matrix(c(1,1,1,1,2,2,2,2,3,3,3,4,4,4,5,5), 2, 8, byrow = T), respect = F)

  #### Histograma dos n_males machos que conseguiram se reproduzir no cenário 1 ####
  hist(m_best1, breaks = 0:10, xaxt = "n", xlab = "Phenotype selected", main = "Intrasexual selection\n on Scenario 1", ylim = c(0,n_males), las = 1)
  #### ajustando o eixo X para ficar centralizado com as classes do histograma
  axis(1, at = seq(0.5, 9.5, by=1), labels = 1:10)

  #### Histograma dos machos que conseguiram se reproduzir no cenário 2 ####
  hist(m_best2, breaks = 0:10, xaxt = "n", xlab = "Phenotype selected", main = "Intrasexual selection\n on Scenario 2", ylim = c(0,n_males), las = 1)
  #### ajustando o eixo X para ficar centralizado com as classes do histograma
  axis(1, at = seq(0.5, 9.5, by=1), labels = 1:10)

  #### Simulando os ambientes de maneira bem simples visualmente, com n_males locais de recurso ####
  # Criando um cenário limpo inicialmente
  plot(1 ,1 , xlim = c(-10, n_males+10), ylim = c(-10, n_males+10), axes = F, ann = F, type = "n") 

  # Criando vetor de posição X dos circulos de "recursos"
  pos_circx <- rep(NA, n_males)
  # Criando vetor de posição Y dos circulos de "recursos"
  pos_circy <- rep(NA, n_males)

  # Criando n_males circulos de recurso para o cenário 1
  for(i in 1:n_males)
  {
    # posicionando aleatoriamente a posição X do círculo
    pos_circx[i] <- runif(1, 0, n_males)
    # posicionando aleatoriamente a posição y do círculo
    pos_circy[i] <- runif(1, 0, n_males)
    # Criando e posicionando cada círculo com raio igual a scenario1
    draw.circle(pos_circx[i], pos_circy[i], scenario1, nv = 1000, density = NA, col = "brown4") 
  }
 
  # Este for serve para selecionar a posição de cada círculo de recursos
  for(i in 1:n_males)
  {
    # Posicionando cada ponto de macho ao redor de seu respectivo círculo de recurso
    for(j in 1:scenario1)
    {
      # Se o contadaor for 1...
      if(j == 1)
        # ...desenhar o círculo do macho selecionado pela fêmea próximo ao centro do respectivo recurso 
        # com tamanho proporcional ao seu fenótipo (m_best1)
        draw.circle((pos_circx[i]-scenario1+runif(1, 0, scenario1*2)), (pos_circy[i]-scenario1+runif(1, 0, scenario1*2)), 
                    m_best1/10, density = NA, col = "green")
      # Se não...
      else
        # ...desenhar círculos menores próximos ao centro do respectivo recurso representando machos não selecionados pelas fêmeas
        draw.circle((pos_circx[i]-scenario1+runif(1, 0, scenario1*2)), (pos_circy[i]-scenario1+runif(1, 0, scenario1*2)), 
                    0.5, density = NA, col = "darkgreen")
    }  
  }
  # Colocando um texto informativo da quantidade da amostra de machos (que já passaram pela seleção intrasexual) no qual a fêmea escolhe um
  text(n_males/2,n_males+10+n_males*0.03,paste(scenario1, "males for each resouce site"))
  
  # Criando um cenário limpo inicialmente
  plot(1 ,1 , xlim = c(-10, n_males+10), ylim = c(-10, n_males+10), axes = F, ann = F, type = "n") 
  # Criando vetor de posição X dos circulos de "recursos"
  pos_circx <- rep(NA, n_males)
  # Criando vetor de posição Y dos circulos de "recursos"
  pos_circy <- rep(NA, n_males)
  # Criando n_males circulos de recurso para o cenário 2
  for(i in 1:n_males)
  {
    # posicionando aleatoriamente a posição X do círculo
    pos_circx[i] <- runif(1, 0, n_males)
    # posicionando aleatoriamente a posição y do círculo
    pos_circy[i] <- runif(1, 0, n_males)
    # Criando e posicionando cada círculo com raio igual a scenario2
    draw.circle(pos_circx[i], pos_circy[i], scenario2, nv = 1000, density = NA, col = "brown4")   
  }
  # Este for serve para selecionar a posição de cada círculo de recursos
  for(i in 1:n_males)
  {
    # Posicionando cada ponto de macho ao redor de seu respectivo círculo de recurso
    for(j in 1:scenario2)
    {
      # Se o contadaor for 1...
      if(j == 1)
        # ...desenhar o círculo do macho selecionado pela fêmea próximo ao centro do respectivo recurso 
        # com tamanho proporcional ao seu fenótipo (m_best2)
        draw.circle((pos_circx[i]-scenario2+runif(1, 0, scenario2*2)), (pos_circy[i]-scenario2+runif(1, 0, scenario2*2)), 
                  m_best2/10, density = NA, col = "green")
      # Se não...
      else
        # ...desenhar círculos menores próximos ao centro do respectivo recurso representando machos não selecionados pelas fêmeas
        draw.circle((pos_circx[i]-scenario2+runif(1, 0, scenario2*2)), (pos_circy[i]-scenario2+runif(1, 0, scenario2*2)), 
                    0.5, density = NA, col = "darkgreen") 
    }  
  }
  # Colocando um texto informativo da quantidade da amostra de machos (que já passaram pela seleção intrasexual) no qual a fêmea escolhe um
  text(n_males/2,n_males+10+n_males*0.03,paste(scenario2, "males for each resouce site"))
  
  # Criando plot vazio para as legendas dos esquemas dos cenários
  plot(1 ,1 , xlim = c(0,10), ylim = c(0,10), axes = F, ann = F, type = "n")
  # Desenha um círculo para representar a legenda dos recursos
  draw.circle(1,7,0.5, density = NA, col = "brown4")
  # Desenha um círculo para representar a legenda dos machos selecionados
  draw.circle(1,4,0.3, density = NA, col = "green")
  # Desenha um círculo para representar a legenda dos machos restantes
  draw.circle(1,1,0.2, density = NA, col = "darkgreen")
  # Texto para a legenda dos recursos
  text(2, 7, "Resource\navailable", adj = 0)
  # Texto para a legenda dos machos selecionados
  text(2, 4, "Male\nselected", adj = 0)
  # Texto para a legenda dos machos restantes
  text(2, 1, "Other\nmales", adj = 0)
  # termina a função retornando o sumario do teste t
  return(t)
}

05_curso_antigo/r2019/alunos/trabalho_final/andrevrodrigues/selsex.txt · Última modificação: 2020/08/12 06:04 (edição externa)