Question 0 : Décrire votre intuition

Je pense que la proportion de personnes aux yeux bleus ne devrait pas tendre vers 0 ni augmenter, mais rester stable. Pour une population réduite, on risque bien sûr d’observer une disparition des allèles bleues tout comme on peut observer la disparition des allèles marrons, mais sur de gros échantillons, le proportion de personnes aux yeux bleus ne devraient pas changer (considérablement) au fil des générations.

library(reshape)
## Warning: package 'reshape' was built under R version 3.3.2
library(ggplot2)
## Warning: package 'ggplot2' was built under R version 3.3.2
#Initialisation de P avec MM et BB
initP <- function(Imax, MM, BB){
  P <- matrix(0,nrow=Imax,ncol=2)
  P[1,1] <- BB
  P[1,2] <- MM
  return(P)
}

#Construction des générations depuis P0
construitP <- function(Pop, Imax, MM, BB){
  P <- initP(Imax, MM, BB)
  for(i in 2:Imax){
    for(j in 1:Pop){
      Pap <- sample(x = c(0,1,2), 1, TRUE, c(P[i-1,1]/Pop,(Pop-P[i-1,1]-P[i-1,2])/Pop,P[i-1,2]/Pop))
      Mam <- sample(x = c(0,1,2), 1, TRUE, c(P[i-1,1]/Pop,(Pop-P[i-1,1]-P[i-1,2])/Pop,P[i-1,2]/Pop))
      #On a tiré aux hasard un père et une mère dans la population
      Ap <- ifelse(Pap==0, 0,
                   ifelse(Pap==1, rbinom(1,1,0.5), 1))
      #Si une le père à les yeux bleus, on choisit une allèle bleue (0). S'il a une allèle de chaque couleur,
      #on tire au sort l'une des deux équitablement, sinon, on prend une allèle marron (1)
      Am <- ifelse(Mam==0, 0,
                   ifelse(Mam==1, rbinom(1,1,0.5), 1))
        
      #On classe ensuite l'enfant engendré selon ces allèles
      if(Ap == 0 && Am == 0) #BB
        P[i,1] <- P[i,1]+1
      if(Ap == 1 && Am == 1)
        P[i,2] <- P[i,2]+1 #MM
    }
  }
  return(P)
}
graphique <- function(P, Pop, Imax){
  #On récupère toutes les données MM, MB, BB pour chaque génération
  T <- data.frame(Evo = 1:Imax, MM = P[1:Imax,2]/Pop, MB = (Pop-P[1:Imax,1]-P[1:Imax,2])/Pop, BB = P[1:Imax,1]/Pop)
  #Transformation pour créer le graphique
  Tclean = melt(T,c("Evo"))
  names(Tclean) = c("Evolution","Alleles","Proportion")

  #Création et affichage du graphique
  Pl <- ggplot(data=Tclean, aes(x=Evolution, y=Proportion, fill=Alleles, width=1)) + geom_line(aes(colour = Alleles))
  Pl <- Pl + scale_colour_brewer(palette = "BrBG") + geom_bar(stat = 'identity')
  Pl
}
#Fonction utilisée pour simuler une situation selon les configurations suivantes : Population, Imax, MM, BB
simulation <- function(Pop, Imax, MM, BB){
  P <- construitP(Pop,Imax,MM,BB)
  graphique(P, Pop, Imax)
}

Question 1 : Cas d’une petite population

On représente tout d’abord un échantillon avec MM=BB=5 et Pop=Imax=20. set.seed(25101985)

On remarque clairement une instabilité, mais jamais la disparition définitive de BB ou MM. BB n’a pas l’air particulièrement en danger par rapport à MM et inversement, la petite population et l’aléatoire sont la cause de cette instabilité. Essayons ensuite avec une projection sur Imax=50. set.seed(25101986)

On observe alors que BB et MM se valent, il n’y a pas de prédominance de l’un sur l’autre. Puisque l’allèle bleue est récessif, plus de personnes auront les yeux marrons mais ce n’est pas pour autant que cette allèle va disparaitre. Varions maintenant la proportion d’allèles au début de la simulation : MM=12 et BB=4. set.seed(25101987)

Et inversons les rôles : MM=4 et BB=12. set.seed(25101994)

On n’observe pas forcément de différences entre les deux configurations, les allèles doubles présentes en plus grande quantité dès le début ont tendance à remporter la bataille sur les autres mais cela n’empêche pas les allèles doubles en infériorité numérique de gagner du terrain sur les autres. Une grande part d’aléatoire reste donc forcément présente mais l’algorithme ne semble pas tronqué. Voyons avec une population plus importante pour déterminer si l’instabilité est dûe à la taille de la population…

Question 2 : Cas d’une grande population

Commençons avec Pop=2000, Imax=100 et MM=BB=500. set.seed(25101985)

Les résultats semblent équilibrés et stables, essayons avec MM=400 et BB=1200. set.seed(25101985)

La stabilité est confirmée, mais il semblerait qu’il y ait un sursaut d’orgueil des allèles MB, oubliées de ce devoir qui prennent plus de place à la deuxième génération. Inversons les rôles : MM=1200 et BB=600

Ce phénomène se confirme, les allèles MB ne semblent pas prêtes à disparaitre tant que les allèles BB et MM sont présentes. Ceci n’enlève rien à la stabilité du système. En augmentant, MB empiète autant sur MM que sur BB pour atteindre environ la moitié de la population. Il est en fait aisé d’expliquer ce comportement. Au premier tour de l’algorithme, comme presque toute la population possède soit des allèles BB soit MM, la fonction aléatoire aura tendance à sélectionner une allèle M et une allèle B, d’où leur plus grand nombre dès la première génération calculée. Essayons maintenant un cas un peu plus extrême sans même utiliser la préservation : MM=1200 et BB=100. set.seed(25101989)

BB se défend bien, la stabilité n’est pas complètement vérifiée. Grâce à l’aléatoire, BB peut tendre à disparaitre tout comme, au contraire regagner une part de la population sur MB et MM. Bien que moins stable que précedemment, l’évolution de BB reste cohérente et non instable pour autant.

Question 3 : Cas d’une petite population avec préservation

initP2 <- function(Imax, MM, BB){
  P <- matrix(1,nrow=Imax,ncol=2)
  P[1,1] <- BB
  P[1,2] <- MM
  return(P)
}

construitP2 <- function(Pop, Imax, MM, BB){
  P <- initP2(Imax, MM, BB)
  for(i in 2:Imax){
    for(j in 1:(Pop-2)){
      Pap <- sample(x = c(0,1,2), 1, TRUE, c(P[i-1,1]/Pop,(Pop-P[i-1,1]-P[i-1,2])/Pop,P[i-1,2]/Pop))
      Mam <- sample(x = c(0,1,2), 1, TRUE, c(P[i-1,1]/Pop,(Pop-P[i-1,1]-P[i-1,2])/Pop,P[i-1,2]/Pop))
    
      Ap <- ifelse(Pap==0, 0, #Allele Bl