Question n°0 :

Tout d’abord, les résultats peuvent évidemment dépendre des populations de base, par exemple, si BB0 = 100%, il n’y aura évidemment que des populations composées de 100% de BB.

Mais, en imaginant que les populations commencent avec environ BB0 = 50% et et MM0 = 50%, alors lors du premier croisement, nous avons logiquement BB1 = 25%, MM1 = 25% et MB1 = 50% (on rassemble évidemment MB et BM que j’appellerai toujours MB). Puis, lors des croisements suivants, nous allons avoir en moyenne : BBi = 25%, MMi = 25% et MBi = 50% (faire le tableau de croisement pour le constater).

Donc, selon moi, la proportions de personnes ayant les yeux bleus devrait tendre vers 25% au fil des générations (si la proportion de départ reste respectable : BB0 = 50% au minimum).

— DONNEES —

Pour tout ce devoir, la graine aléatoire sera fixée à 42.

set.seed(42)

Dans les vecteurs de population, 0 correspondra à un individu BB, 1 à un individu MB et 2 à un individu MM.

— FONCTIONS —

#   La fonction alean renvoie un vecteur de n nombre aléatoires entre 0 et k-1.
alean <- function(n,k) {
  return (floor(runif(n)*k))
}

#   La fonction pop0 construit le vecteur de la population 0 avec b*BB, m*MM et
#   le reste en MB.
p0 <- function(b,m,n) {
  return (c(rep(0,b),rep(1,(n-b-m)),rep(2,m)))
}

#   La fonction enfant renvoie le gène d'un individu fils créé grâce aux gènes
#   de deux parents aléatoirements choisis.
enfant <- function(p) {
  pere <- p[alean(1,length(p))+1]
  mere <- p[alean(1,length(p))+1]
  if (pere == 0 && mere == 0) return (0)
  if (pere == 2 && mere == 2) return (2)
  if ((pere == 0 && mere == 2) || (pere == 2 && mere == 0)) return (1)
  if ((pere == 0 && mere == 1) || (pere == 1 && mere == 0)) {
    if (alean(1,2)==0) return (0) else return (1)
  }
  if ((pere == 2 && mere == 1) || (pere == 1 && mere == 2)) {
    if (alean(1,2)==0) return (2) else return (1)
  }
  if (alean(1,2)==0) return (1)
  if (alean(1,2)==0) return (0) else return (2)
}

#   La fonction pop renvoie une nouvelle population composée de n individus à
#   partir de la population p précédente.
pop <- function(p,n) {
  a <- enfant(p)
  for (i in 2:n) {
    a <- c(a,enfant(p))
  }
  return (a)
}

#   La fonction evol construit les nouvelles populations de n individus,
#   jusqu'à atteindre l'horizon i entré en paramètre.
evol <- function(b,m,n,i) {
  p <- p0(b,m,n)
  pi <- pop(p,n)
  for (k in 2:i) {
    pi <- pop(pi,n)
  }
  return (pi)
}

#   La fonction pc est la fonction qui calcule les pourcentages de BB, MB et 
#   MM au sein d'une population p donnée.
pc <- function(p) {
  bb <- 0
  mb <- 0
  mm <- 0
  for(k in 1:length(p)) {
    if (p[k] == 0) bb <- bb+1
    if (p[k] == 1) mb <- mb+1
    if (p[k] == 2) mm <- mm+1
  }
  pbb <- bb*100/length(p)
  pmb <- mb*100/length(p)
  pmm <- mm*100/length(p)
  res <- c(pbb,pmb,pmm)
  return (res)
}

#   La fonction nbt est la fonction qui réalise les t réalisations de
#   trajectoires, et calcule pour chacune d'entre elles les pourcentages
#   de BB, MB et MM, puis les regroupe dans un vecteur organisé comme
#   ceci : (BB0:BBt,MB0:MBt,MM0:MMt).
nbt <- function(b,m,n,i,t) {
  a <- pc(evol(b,m,n,i))
  bb <- a[1]
  mb <- a[2]
  mm <- a[3]
  for(k in 2:t) {
    a <- pc(evol(b,m,n,i))
    bb <- c(bb,a[1])
    mb <- c(mb,a[2])
    mm <- c(mm,a[3])
  }
  return (c(bb,mb,mm))
}

#   La fonction tracer est la fonction qui dessine le graphique voulu, en
#   prenant comme paramètres le vecteur des pourcentages renvoyés par nbt
#   (voir ci-dessus), et le nombre de réalisations de trajectoires t.
tracer <- function(g,t) {
  plot(rep(1:t),g[1:t],pch=16,type='o',lwd=2,cex=1,col="blue",ylim=c(0,100),yaxp=c(0,100,10),xaxp=c(1,t,t-1),xlab="Numero de population",ylab="Pourcentages",main="Répartition des couleurs d'yeux au fil des populations")
  par(new=T)
  plot(rep(1:t),g[(t+1):(2*t)],pch=16,type='o',lwd=2,cex=1,col="green",ylim=c(0,100),yaxt="n",xlab="",ylab="")
  par(new=T)
  plot(rep(1:t),g[(2*t+1):(3*t)],pch=16,type='o',lwd=2,cex=1,col="brown",ylim=c(0,100),yaxt="n",xlab="",ylab="")
}

#   La fonction main est la fonction "maître" à appeler dans les question
#   suivantes. Il prend en paramètres respectivement BB0, MM0, la taille
#   des populations filles n, l'horizon i (Imax dans l'énoncé), et le
#   nombre de réalisations de trajectoires t.
main <- function(b,m,n,i,t) {
  tracer(nbt(b,m,n,i,t),t)
}

Question n°1 :

#   P0 = (4,12), P = 20, Imax = 20, N = 10
main(4,12,20,20,10)

#   P0 = (12,4), P = 20, Imax = 20, N = 10
main(12,4,20,20,10)

#   P0 = (5,5), P = 20, Imax = 20, N = 10
main(5,5,20,20,10)

Dans le premier cas, avec BB0 = 20% de la population initiale, après 20 générations, l’allèle bleu est en minorité, avec 8 cas sur 10 où le pourcentage de BB ne dépasse pas 10%.

Dans le deuxième cas, avec BB0 = 60%, nous pouvons observer que les résultats sont presque inversés, en effet, 9 cas sur 10 présentent cette fois un pourcentage de BB supérieur à 40%, dont trois cas à 100%.

Dans le troisième cas, avec BB0 = 25%, il n’y a pas de domination totale d’un allèle, même si une légère domination de MM se fait ressentir. En moyenne, le pourcentage de BB tourne autour de 20%%, et celui de MM plutôt autour de 50%. On commence à se rapprocher de mes prévisions.

Nous allons maintenant effectuer les mêmes tests, mais avec un horizon plus élevé, ici à 100, afin de voir ce qui arriverait au long terme, toujours avec une petite population.

main(4,12,20,100,10)

main(12,4,20,100,10)

main(5,5,20,100,10)

Dans le premier cas, nous pouvons voir que les résultats sont radicaux, 7 cas sur 10 présentent 100% de MM, et les 3 autres donnent 100% de BB.

Dans le deuxième cas, les résultats finaux sont presques inversés, cette fois 7 cas ont 100% de BB, 2 fois 100% de MM et sur le test restant les trois pourcentages sont assez proches, 10% de BB, 35% de MB et 55% de MM.

Dans le dernier cas, 6 cas sur 10 possèdent 100% de MM et les autres 100% de BB.

Pour conclure, nous pouvons dire que si l’on augmente l’horizon mais pas la taille de la population, les résultats sont radicaux et pas très explicites.

Question n°2 :

main(400,1200,2000,100,10)

main(1200,400,2000,100,10)

main(500,500,2000,100,10)

Dans le premier cas avec 20% de BB au départ, nous pouvons voir que les courbes sont beaucoup plus lissées qu’en question 1, on peut vraiment y voir une moyenne qui en sort. Ici, nous pouvons voir que la moyenne des pourcentages de BB est de 10%, tandis que MM et MB se chevauchent vers les 45%.

Dans le deuxième cas, avec 60% de BB au début, le pourcentage de BB reste vers 60%, et celui de MM vers 10%.

Dans le dernier cas, avec 25% de BB au départ, les pourcentages de la population initiale sont conservés, c’est à dire 25% de BB, 25% de MM et 50% de MB. On peut considérer que cette population est une population d’équilibre.

Question n°3 :

Afin de prendre en compte la nouvelle règle d’évolution consistant à conserver au moins une personne BB et MM à chaque génération, il faut redéfinir les fonctions evol, nbt et main en evol2, nbt2 et main2 ci-dessous. Les fonctionnements sont identiques, il faut appeler main2 pour lancer le programme, chaque génération présentera juste une personne MM et BB au minimum. Les changements sont indiqués en commentaires.

evol2 <- function(b,m,n,i) {
  p <- p0(b,m,n)
  pi <- pop(p,n-2)          # Calcule n-2 personnes au lieu de n
  pi <- c(pi,0,2)           # Ajoute MM et BB manquants.
  for (k in 2:i) {
    pi <- pop(pi,n-2)       # Idem
    pi <- c(pi,0,2)         # Idem
  }
  return (pi)
}

nbt2 <- function(b,m,n,i,t) {
  a <- pc(evol2(b,m,n,i))       # Appelle maintenant evol2 au lieu d'evol
  bb <- a[1]
  mb <- a[2]
  mm <- a[3]
  for(k in 2:t) {
    a <- pc(evol2(b,m,n,i))     # Idem
    bb <- c(bb,a[1])
    mb <- c(mb,a[2])
    mm <- c(mm,a[3])
  }
  return (c(bb,mb,mm))
}

main2 <- function(b,m,n,i,t) {
  tracer(nbt2(b,m,n,i,t),t)       # Appelle maintenant nbt2 au lieu de nbt
}


#   Les mêmes tests qu'en question 1, mais avec un horizon Imax = 2000

main2(4,12,20,2000,10)

main2(12,4,20,2000,10)

main2(5,5,20,2000,10)

Pour les trois tests, nous obtenons les mêmes résultats, c’est à dire que les trois courbes varient à peu près autour de 30~35%.

Le système parait beaucoup plus stable, les trois différentes combinaisons BB, MM et MB sont à parts égales. Et aucune combinaison en particulier ne semble plus “attractrice” que les autres.

Question n°4 :

Si l’on considère une grande population, et une part 25% BB, 25% MM et 50%, (ou 50% BB et 50% MM, ce qui revient au même à une génération près), mes intuitions sont conformes aux résultats que nous avons obtenus.

En revanche, en prenant des plus petites populations, ou encore une conservation des combinaisons “souches”, mes résultats se révèlent moins pertinents.

On pourrait tester l’hypothèse de la préservation des gènes sur une population à grande échelle, pour observer s’il y a un changement quelconque, même si à mon avis cela ne changerait rien, les allèles ne disparaissants pas sur les premiers tests sur une grande population.

Si je devais modifier le modèle proposé, je pense que l’on pourrait ajouter de nouveaux paramètres, ajouter un gène par exemple indépendant des allèles B et M, qui pourrait gérer les différentes teintes, ce qui ajouterai le vert ou autres couleurs (violet pour la maladie d’Alexander). Ou encore gérer les yeux veirons.