R Markdown

Définition de la graine:

set.seed(77)

QUESTTION 0

  1. Pour P0 = (BB,MM) = (4,12), il est probable que les yeux bleus disparaissent Pour P0 = (BB,MM) = (12,4), je pense que les yeux bleus devrait tres longtemps voire meme stagner Pour P0 = (BB,MM) = (5,5), les alleles BB et MM devrait stagner au meme niveaux.

  2. On devrait voir la meme chose que la question 1 mais avec plus de précisions (cas extreme plus faible) puisqu’on simule avec de plus grandes populations.

  3. En preservant des allèles BB et MM, on preserve, pas forcement l’équité de la couleur des yeux, mais peut etre une stabilisation du nombre d’allele BB et MM (apres tout depend de la population de départ) .

FONCTION INTRO

CONVENTION (DuoAl): 1: BB et 2: MM et 3 : MB/BM CONVENTION (Al): 1: Bleu et 2: Marron

fonctionAllele = function (DuoAl1,DuoAl2) {
  if(DuoAl1 == 1 ) {Al1 = 1}
  else if (DuoAl1 == 2) {Al1 = 2}
  else if (runif(1) >=0.5) {Al1 = 1} else {Al1 = 2}
  if(DuoAl2 == 1 ) {Al2 = 1}
  else if (DuoAl2 == 2) {Al2 = 2}
  else if (runif(1) >=0.5) {Al2 = 1} else {Al2 = 2}

  if (Al1 == 1 && Al2 == 1) {AlEnfant = 1}
  else if (Al1 == 2 && Al2 == 2) {AlEnfant = 2}
  else {AlEnfant = 3}
  
return (AlEnfant)
}

simulation = function(tab0,P,I,preservation) {
  allGeneration = list()
  allGeneration[[1]] = tab0
  for (i in 1:I) {
    tabParent1 = sample(tab0, size = P, replace=TRUE)
    tabParent2 = sample(tab0, size = P, replace=TRUE)
    pop = rep(0,P)
    for (j in 1:P) {
      pop[j] = fonctionAllele(tabParent1[j],tabParent2[j])
      if (preservation == 1) {pop[1] = 1; pop[2] = 2}
    }
    allGeneration[[i+1]] = pop
    tab0 = pop
  }
  return(allGeneration)
}

FONCTION POUR CALCULER BB/P et MM/P

RapportBleu = function(AllGeneration,P) {
  compteur =0
  test = c()
    for (j in 1:I){
      for (k in 1:P) {
        if (AllGeneration[[j]][k] == 1){compteur = compteur+1}
      }
      test[j] = compteur /P *100
      compteur =0
    }
    
  return(test)

}

RapportMarron = function(AllGeneration,P) {
  compteur =0
  test = c()
    for (j in 1:I){
      for (k in 1:P) {
        if (AllGeneration[[j]][k] == 2){compteur = compteur+1}
      }
      test[j] = compteur /P *100
      compteur =0
    }
    
  return(test)

}

QUESTION 1

Premier echantillon : P0 = (BB0,MM0) = (4, 12)

P=20
I=20
N=10

Population0 =c(rep(1,4),rep(2,12),rep(3,P-4-12))
MM = list()
BB = list()
for(i in 1:N) {
  AllGeneration = simulation(Population0,P,I,0)
  AllGeneration
  BB[[i]] = RapportBleu(AllGeneration,P)
  MM[[i]] = RapportMarron(AllGeneration,P)
}

xrange = seq(1,I,1)
plot(xrange, BB[[i]], type="l", xlab=" ième génération", ylab="Proportion d'invididus aux allele BB et MM", ylim = c(0,100) )
# ajout lignes
for (i in 1:N) {
  lines(xrange, BB[[i]], type="l", lwd=1.5, col="blue")
  lines(xrange, MM[[i]], type="l", lwd=1.5, col="brown")
}
# ajout titre et sous-titre
title("Evolution du nombre d'individus aux allèles BB et MM, P=20 sur 20 générations")

Deuxieme echantillon : P0 = (BB0;MM0) = (12; 4)

Population0 =c(rep(1,12),rep(2,4),rep(3,P-4-12))
MM = list()
BB = list()
for(i in 1:N) {
  AllGeneration = simulation(Population0,P,I,0)

BB[[i]] = RapportBleu(AllGeneration,P)
MM[[i]] = RapportMarron(AllGeneration,P)
}

xrange = seq(1,I,1)
plot(xrange, BB[[i]], type="l", xlab=" ième génération", ylab="Proportion d'invididus aux allele BB et MM", ylim = c(0,100), col="blue" )
# ajout lignes
for (i in 1:N) {
  lines(xrange, BB[[i]], type="l", lwd=1.5, col="blue")
  lines(xrange, MM[[i]], type="l", lwd=1.5, col="brown")
}
# ajout titre et sous-titre
title("Evolution du nombre d'individus aux allèles BB et MM, P=20 sur 20 générations")

Troisieme echantillon : PP0 = (BB0;MM0) = (5; 5)

Population0 =c(rep(1,5),rep(2,5),rep(3,P-5-5))
MM = list()
BB = list()
for(i in 1:N) {
  AllGeneration = simulation(Population0,P,I,0)

BB[[i]] = RapportBleu(AllGeneration,P)
MM[[i]] = RapportMarron(AllGeneration,P)
}

xrange = seq(1,I,1)
plot(xrange, BB[[i]], type="l", xlab=" ième génération", ylab="Proportion d'invididus aux allele BB et MM", ylim = c(0,100), col="blue" )
# ajout lignes
for (i in 1:N) {
  lines(xrange, BB[[i]], type="l", lwd=1.5, col="blue")
  lines(xrange, MM[[i]], type="l", lwd=1.5, col="brown")
}
# ajout titre et sous-titre
title("Evolution du nombre d'individus aux allèles BB et MM, P=20 sur 20 générations")

Comme on peut le voir, avec des petites populations, les courbes reste tres grossierement dans la meme lignée que leur point de départ quand il n y a pas beaucoup de generations (20) Lorsque l’on augmente les générations (200 par exemple mais pas représenté ici),“tout es possible”. Ainsi le fait d’avoir une petite populations sur de grandes generations permettent de faire disparaitre des alleles BB et MM et notamment de faire disparaitre les duo MM malgré leur dominance dans la population de départ.

Note: on parle bien ici du duo d’alleles BB et MM et non de la couleur des yeux. Ces duo peut disparaitre mais les M et B peuvent encore etre contenue dans des duo MB/BM.

QUESTION 2

Premier echantillon : P0 = (BB0,MM0) = (400, 1200)

P=2000
I=200
N=10  

Population0 =c(rep(1,400),rep(2,1200),rep(3,P-400-1200))
MM = list()
BB = list()
for(i in 1:N) {
  AllGeneration = simulation(Population0,P,I,0)

BB[[i]] = RapportBleu(AllGeneration,P)
MM[[i]] = RapportMarron(AllGeneration,P)
}

xrange = seq(1,I,1)
plot(xrange, BB[[i]], type="l", xlab=" ième génération", ylab="Proportion d'invididus aux allele BB et MM", ylim = c(0,100) )
# ajout lignes
for (i in 1:N) {
  lines(xrange, BB[[i]], type="l", lwd=1.5, col="blue")
  lines(xrange, MM[[i]], type="l", lwd=1.5, col="brown")
}
# ajout titre et sous-titre
title("Evolution du nombre d'individus aux allèles BB et MM, P=2000 sur 100 générations")

Deuxieme echantillon : P0 = (BB0,MM0) = (1200, 400)

Population0 =c(rep(1,1200),rep(2,400),rep(3,P-400-1200))
MM = list()
BB = list()
for(i in 1:N) {
  AllGeneration = simulation(Population0,P,I,0)

BB[[i]] = RapportBleu(AllGeneration,P)
MM[[i]] = RapportMarron(AllGeneration,P)
}

xrange = seq(1,I,1)
plot(xrange, BB[[i]], type="l", xlab=" ième génération", ylab="Proportion d'invididus aux allele BB et MM", ylim = c(0,100) )
# ajout lignes
for (i in 1:N) {
  lines(xrange, BB[[i]], type="l", lwd=1.5, col="blue")
  lines(xrange, MM[[i]], type="l", lwd=1.5, col="brown")
}
# ajout titre et sous-titre
title("Evolution du nombre d'individus aux allèles BB et MM, P=2000 sur 100 générations")

Troisieme echantillon : P0 = (BB0,MM0) = (500, 500)

Population0 =c(rep(1,500),rep(2,500),rep(3,P-500-500))
MM = list()
BB = list()
for(i in 1:N) {
  AllGeneration = simulation(Population0,P,I,0)

BB[[i]] = RapportBleu(AllGeneration,P)
MM[[i]] = RapportMarron(AllGeneration,P)
}

xrange = seq(1,I,1)
plot(xrange, BB[[i]], type="l", xlab=" ième génération", ylab="Proportion d'invididus aux allele BB et MM", ylim = c(0,100) )
# ajout lignes
for (i in 1:N) {
  lines(xrange, BB[[i]], type="l", lwd=1.5, col="blue")
  lines(xrange, MM[[i]], type="l", lwd=1.5, col="brown")
}
# ajout titre et sous-titre
title("Evolution du nombre d'individus aux allèles BB et MM, P=2000 sur 100 générations")

On peut voir que ces courbes sont bien plus précise, et centrées sur des valeurs, que la question précedente.
On le voit facilement car certaines courbes peuvent vite quitter leur valeurs de départ pour stagner sur une autre valeur.
Par exemple, pour une population de 2000 personnes avec 1200 BB et 400 MM au départ, on voit que la proportion de BB se “stabilise”" au alentour de 50 % et celle de marron entre 5 et 10% (valeur qu’on retrouve avec de simple calcul de probabilité).
Ex ci-dessus: P(MM) = (400/2000).(400/2000) + (400/2000).(400/2000)*(1/2) = 6/100 = 6% ce qui correspond.
Avec 500 BB et 500 MM au départ, les deux courbes se stabilisent à 25%.

QUESTION 3

Echantillon : P0 = (BB0,MM0) = (5, 5)

P=20
I=400
N=1 
Preservation =1

Population0 =c(rep(1,5),rep(2,5),rep(3,P-5-5))
MM = list()
BB = list()
for(i in 1:N) {
  AllGeneration = simulation(Population0,P,I,Preservation)
BB[[i]] = RapportBleu(AllGeneration,P)
MM[[i]] = RapportMarron(AllGeneration,P)
}

xrange = seq(1,I,1)
plot(xrange, BB[[i]], type="l", xlab=" ième génération", ylab="Proportion d'invididus aux allele BB et MM", ylim = c(0,100) )
# ajout lignes
for (i in 1:N) {
  lines(xrange, BB[[i]], type="l", lwd=1.5, col="blue")
  lines(xrange, MM[[i]], type="l", lwd=1.5, col="brown")
}
# ajout titre et sous-titre
title("Evolution du nombre d'individus aux allèles BB et MM, P=20 sur 400 générations")

Echantillon : P0 = (BB0,MM0) = (400, 1200)

P=10000 ## 10 000 200
I=200
N=3 
Preservation =1

Population0 =c(rep(1,400),rep(2,1200),rep(3,P-400-1200))
MM = list()
BB = list()
for(i in 1:N) {
  AllGeneration = simulation(Population0,P,I,Preservation)

BB[[i]] = RapportBleu(AllGeneration,P)
MM[[i]] = RapportMarron(AllGeneration,P)
}

xrange = seq(1,I,1)
plot(xrange, BB[[i]], type="l", xlab=" ième génération", ylab="Proportion d'invididus aux allele BB et MM", ylim = c(0,100) )
# ajout lignes
for (i in 1:N) {
  lines(xrange, BB[[i]], type="l", lwd=1.5, col="blue")
  lines(xrange, MM[[i]], type="l", lwd=1.5, col="brown")
}
# ajout titre et sous-titre
title("Evolution du nombre d'individus aux allèles BB et MM, P=10000 sur 200 générations")

Sans totalement comprendre, on remarque que les courbes BB et MM sont “presque symetrique” et s’inverse l’une à l’autre. Le fait de préserver est surtout utile dans le cas de petite population car en effet on voit que les courbes fluctuent enormement. Preserver ces alleles permet de refaire tourner la balance à chaque fois.

QUESTION 4

Au final, les résultats obtenus sont quasiment conforme à mes intuitions initiales. Cependant, on voit tout de meme que le nombre de population est tres important surtout du fait que l’on effectue des tirages avec remises. De plus, les résultats peuvent variés selon la graine choisie au départ.
De maniere generale, on voit que les duo d’alleles peuvent disparaitre avec des petites petites populations et non avec des grande (ou alors cas tres tres rare).
Si j’avais à modifier le modèle proposé, je pense qu’il faudrait prendre en compte le fait que un parent ne peut pas avoir d’enfant avec lui-meme (sans remise)