[RICM4-PS] TP1
Lesage Lucas
29 octobre 2016
set.seed(25)
premierePartie <- function(P,BB,MM,I){
#Initialisation des variables
BM=P-BB-MM
nbBleu=0
nbMarron=0
i=1
j=1
k=1
#Remplissage du tableau de population
Pop=c()
oldPop=c()
for(i in i:P){
if(i<=BB){
Pop[i]='BB'
}
if((i>BB)&&(i<=BB+MM)){
Pop[i]='MM'
}
if((i>BB+MM)&&(i<=BB+MM+BM)){
Pop[i]='BM'
}
}
#print(Pop)
#Simulation des generations
oldPop=Pop
for (j in 1:P){
parent1=sample(1:P, 1)
while ((parent2=sample(1:P, 1)) == parent1){
parent2=sample(1:P, 1)
}
if ((oldPop[parent1]=='BB')&&(oldPop[parent2]=='BB')){
Pop[j]='BB'
}
if ((oldPop[parent1]=='MM')&&(oldPop[parent2]=='MM')){
Pop[j]='MM'
}
if ((oldPop[parent1]=='BM')&&(oldPop[parent2]=='BB')){
Pop[j]=ifelse(runif(1)>0.5,'BM', 'BB')
}
if ((oldPop[parent1]=='BM')&&(oldPop[parent2]=='MM')){
Pop[j]=ifelse(runif(1)>0.5,'BM', 'MM')
}
}
#print(Pop)
#Comptage des couleurs d'yeux
nbBleu=sum(Pop=='BB')
nbMarron=sum(Pop=='BM')+sum(Pop=='MM')
return(c(nbBleu,nbMarron))
}
deuxiemePartie <- function(P,BB,MM,I){
#Initialisation des variables
BM=P-BB-MM
nbBleu=0
nbMarron=0
i=1
j=1
k=1
#Remplissage du tableau de population
Pop=c()
oldPop=c()
for(i in i:P){
if(i<=BB){
Pop[i]='BB'
}
if((i>BB)&&(i<=BB+MM)){
Pop[i]='MM'
}
if((i>BB+MM)&&(i<=BB+MM+BM)){
Pop[i]='BM'
}
}
#print(Pop)
#Simulation des generations
oldPop=Pop
for (j in 1:(P-2)) {
parent1=sample(1:(P-2), 1)
while ((parent2=sample(1:(P-2), 1)) == parent1){
parent2=sample(1:(P-2), 1)
}
if ((oldPop[parent1]=='BB')&&(oldPop[parent2]=='BB')){
Pop[j]='BB'
}
if ((oldPop[parent1]=='MM')&&(oldPop[parent2]=='MM')){
Pop[j]='MM'
}
if ((oldPop[parent1]=='BM')&&(oldPop[parent2]=='BB')){
Pop[j]=ifelse(runif(1)>0.5,'BM', 'BB')
}
if ((oldPop[parent1]=='BM')&&(oldPop[parent2]=='MM')){
Pop[j]=ifelse(runif(1)>0.5,'BM', 'MM')
}
}
Pop[P-1]='BB'
Pop[P]='MM'
#print(Pop)
#Comptage des couleurs d'yeux
nbBleu=sum(Pop=='BB')
nbMarron=sum(Pop=='BM')+sum(Pop=='MM')
return(c(nbBleu,nbMarron))
}Intuition :
Je pense que la population d’individus aux yeux bleus va diminuer peu à peu, de manière exponentielle selon le nombre d’individus aux yeux marrons. De plus, les individus aux allèles Marron-Marron sont “coinceurs”, c’est à dire que la probabilité d’avoir un enfant aux yeux bleus dépendera du conjoint, et sera donc soit de 1/4 si le conjoint est BM , soit 1/2 si il est BB, mais le descendant sera forcemment aux yeux marrons, avec eventuellement une allèle Bleue, mais donc avec une probabilité de transmettre cette allèle réduite.
J’ai pris la liberté de faire 100 tests au lieu de 10, car je trouve les courbes plus parlantes ainsi.
#Question 1.1
vecResBB=c()
vecResMM=c()
for (o in 1:100){
recupRes=premierePartie(20,4,12,20)
vecResBB=c(vecResBB,recupRes[1]*100/(recupRes[1]+recupRes[2]))
vecResMM=c(vecResMM,recupRes[2]*100/(recupRes[1]+recupRes[2]))
}
plot(rep(1:100),vecResBB,ylim=c(0,100),yaxp=c(0,100,10), xaxp=c(0,100,5), xlab="Numero test", ylab="Pourcentage (Marron et Bleu)", main="Diagramme", pch=3, col="blue", type="o", cex=0.2)
par(new=T)
plot(rep(1:100),vecResMM,ylim=c(0,100), xlab="", ylab="", xaxp=c(0,100,5), pch=3, col="brown", type="o", cex=0.2)
#Question 1.2
vecResBB=c()
vecResMM=c()
for (o in 1:100){
recupRes=premierePartie(20,12,4,20)
vecResBB=c(vecResBB,recupRes[1]*100/(recupRes[1]+recupRes[2]))
vecResMM=c(vecResMM,recupRes[2]*100/(recupRes[1]+recupRes[2]))
}
plot(rep(1:100),vecResBB,ylim=c(0,100),yaxp=c(0,100,10), xaxp=c(0,100,5), xlab="Numero test", ylab="Pourcentage (Marron et Bleu)", main="Diagramme", pch=3, col="blue", type="o", cex=0.2)
par(new=T)
plot(rep(1:100),vecResMM,ylim=c(0,100), xlab="", ylab="", xaxp=c(0,100,5), pch=3, col="brown", type="o", cex=0.2)
#Question 1.3
vecResBB=c()
vecResMM=c()
for (o in 1:100){
recupRes=premierePartie(20,5,5,20)
vecResBB=c(vecResBB,recupRes[1]*100/(recupRes[1]+recupRes[2]))
vecResMM=c(vecResMM,recupRes[2]*100/(recupRes[1]+recupRes[2]))
}
plot(rep(1:100),vecResBB,ylim=c(0,100),yaxp=c(0,100,10), xaxp=c(0,100,5), xlab="Numero test", ylab="Pourcentage (Marron et Bleu)", main="Diagramme", pch=3, col="blue", type="o", cex=0.2)
par(new=T)
plot(rep(1:100),vecResMM,ylim=c(0,100), xlab="", ylab="", xaxp=c(0,100,5), pch=3, col="brown", type="o", cex=0.2)
Question 1 :
On remarque que :
-Si les yeux marrons sont dominants au début, ils le sont encore plus après 20 générations. (2 yeux bleus, 18 yeux marrons)
-Si les yeux bleus sont dominants au début, ils le sont encore plus après 20 générations, mais pas autant que pour les marrons. (15 yeux bleus, 5 yeux marrons)
-Si les deux yeux sont équivalents au début, les yeux marrons dominent après 20 générations, mais moins que si ils dominaient dès le début. (4 yeux bleus, 16 yeux marrons)Ces résultats sont logiques, car les individus avec les allèles Bleu-Marron comptent pour marrons, et comme dit dans mon intuition, les probabilités jouent en défaveur pour les yeux bleus.
Cas interessant : BB=19 et MM=1 au début; J’aurais pensé qu’au bout d’un grand nombre de générations les yeux Marrons auraient dominé entièrement, mais en fait le premier enfant a pu ne pas etre conçu par le parent MM, ou meme, il serait BM et lui même si il a un conjoint BB, leur enfant pourrait etre BB et faire disparaitre le MM.
#Question 2.1
vecResBB=c()
vecResMM=c()
for (o in 1:100){
recupRes=premierePartie(2000,400,1200,100)
vecResBB=c(vecResBB,recupRes[1]*100/(recupRes[1]+recupRes[2]))
vecResMM=c(vecResMM,recupRes[2]*100/(recupRes[1]+recupRes[2]))
}
plot(rep(1:100),vecResBB,ylim=c(0,100),yaxp=c(0,100,10), xaxp=c(0,100,5), xlab="Numero test", ylab="Pourcentage (Marron et Bleu)", main="Diagramme", pch=3, col="blue", type="o", cex=0.2)
par(new=T)
plot(rep(1:100),vecResMM,ylim=c(0,100), xlab="", ylab="", xaxp=c(0,100,5), pch=3, col="brown", type="o", cex=0.2)
#Question 2.2
vecResBB=c()
vecResMM=c()
for (o in 1:100){
recupRes=premierePartie(2000,1200,400,100)
vecResBB=c(vecResBB,recupRes[1]*100/(recupRes[1]+recupRes[2]))
vecResMM=c(vecResMM,recupRes[2]*100/(recupRes[1]+recupRes[2]))
}
plot(rep(1:100),vecResBB,ylim=c(0,100),yaxp=c(0,100,10), xaxp=c(0,100,5), xlab="Numero test", ylab="Pourcentage (Marron et Bleu)", main="Diagramme", pch=3, col="blue", type="o", cex=0.2)
par(new=T)
plot(rep(1:100),vecResMM,ylim=c(0,100), xlab="", ylab="", xaxp=c(0,100,5), pch=3, col="brown", type="o", cex=0.2)
#Question 2.3
vecResBB=c()
vecResMM=c()
for (o in 1:100){
recupRes=premierePartie(2000,500,500,100)
vecResBB=c(vecResBB,recupRes[1]*100/(recupRes[1]+recupRes[2]))
vecResMM=c(vecResMM,recupRes[2]*100/(recupRes[1]+recupRes[2]))
}
plot(rep(1:100),vecResBB,ylim=c(0,100),yaxp=c(0,100,10), xaxp=c(0,100,5), xlab="Numero test", ylab="Pourcentage (Marron et Bleu)", main="Diagramme", pch=3, col="blue", type="o", cex=0.2)
par(new=T)
plot(rep(1:100),vecResMM,ylim=c(0,100), xlab="", ylab="", xaxp=c(0,100,5), pch=3, col="brown", type="o", cex=0.2)
Question 2 :
On remarque que :
-Si les yeux marrons sont dominants au début, ils le sont encore plus après 100 générations. (280 yeux bleus, 1720 yeux marrons)
-Si les yeux bleus sont dominants au début, ils le sont encore plus après 100 générations, mais pas autant que pour les marrons. (1373 yeux bleus, 627 yeux marrons)
-Si les deux yeux sont équivalents au début, les yeux marrons dominent après 100 générations, mais moins que si ils dominaient dès le début. (546 yeux bleus, 1454 yeux marrons)Les résultats sont au final similaires à ceux de la question 1, ce qui importe est dans l’allure des courbes de tests.
En effet, dans la question 1, les valeurs sont éparses, la courbe a des écarts assez grands. Dans la question 2, la courbe est plus affiné, lisse, l’écart des valeurs est beaucoup plus petit.
Cette simulation montre clairement que un nombre assez conséquent d’échantillons est important si on veut avoir des résultats moins abstraits.
#Question 3.1
vecResBB=c()
vecResMM=c()
for (o in 1:100){
recupRes=deuxiemePartie(20,4,12,2000)
vecResBB=c(vecResBB,recupRes[1]*100/(recupRes[1]+recupRes[2]))
vecResMM=c(vecResMM,recupRes[2]*100/(recupRes[1]+recupRes[2]))
}
plot(rep(1:100),vecResBB,ylim=c(0,100),yaxp=c(0,100,10), xaxp=c(0,100,5), xlab="Numero test", ylab="Pourcentage (Marron et Bleu)", main="Diagramme", pch=3, col="blue", type="o", cex=0.2)
par(new=T)
plot(rep(1:100),vecResMM,ylim=c(0,100), xlab="", ylab="", xaxp=c(0,100,5), pch=3, col="brown", type="o", cex=0.2)
#Question 3.2
vecResBB=c()
vecResMM=c()
for (o in 1:100){
recupRes=deuxiemePartie(20,12,4,2000)
vecResBB=c(vecResBB,recupRes[1]*100/(recupRes[1]+recupRes[2]))
vecResMM=c(vecResMM,recupRes[2]*100/(recupRes[1]+recupRes[2]))
}
plot(rep(1:100),vecResBB,ylim=c(0,100),yaxp=c(0,100,10), xaxp=c(0,100,5), xlab="Numero test", ylab="Pourcentage (Marron et Bleu)", main="Diagramme", pch=3, col="blue", type="o", cex=0.2)
par(new=T)
plot(rep(1:100),vecResMM,ylim=c(0,100), xlab="", ylab="", xaxp=c(0,100,5), pch=3, col="brown", type="o", cex=0.2)
#Question 3.3
vecResBB=c()
vecResMM=c()
for (o in 1:100){
recupRes=deuxiemePartie(20,5,5,2000)
vecResBB=c(vecResBB,recupRes[1]*100/(recupRes[1]+recupRes[2]))
vecResMM=c(vecResMM,recupRes[2]*100/(recupRes[1]+recupRes[2]))
}
plot(rep(1:100),vecResBB,ylim=c(0,100),yaxp=c(0,100,10), xaxp=c(0,100,5), xlab="Numero test", ylab="Pourcentage (Marron et Bleu)", main="Diagramme", pch=3, col="blue", type="o", cex=0.2)
par(new=T)
plot(rep(1:100),vecResMM,ylim=c(0,100), xlab="", ylab="", xaxp=c(0,100,5), pch=3, col="brown", type="o", cex=0.2)
Question 3 :
On remarque que :
-Si les yeux marrons sont dominants au début, ils le sont encore plus après 2000 générations. (3 yeux bleus, 17 yeux marrons)
-Si les yeux bleus sont dominants au début, ils le sont encore plus après 2000 générations, mais pas autant que pour les marrons. (15 yeux bleus, 5 yeux marrons)
-Si les deux yeux sont équivalents au début, les yeux marrons dominent après 2000 générations, mais moins que si ils dominaient dès le début. (6 yeux bleus, 14 yeux marrons)Même si ils sont similaires à la question 1, ces résultats sont assez différents car ils montrent bien que une population est moins dominée, grâce à l’individu qui ne change jamais.
Question 4 :
Au final, j’ai eu tort sur mon intuition initiale car je n’avais pas pensé que les parents n’étaient pas forcémment tous choisis, et que donc une population infime de couleur de yeux marrons ne pourra pas oblgatoirement prendre le dessus sur les bleus.
Si je devais modifier le modèle, je modifierais les critères de choix des parents. Car dans le cas courant il est possible que 5 parents soient responsable des 20 enfants, et les autres n’ont pas d’enfants. En utilisant des statistiques réelles du nombre d’enfants par couple, la simulation serait probablement plus réaliste.
Ensuite prendre en compte le sexe dans la simulation serait aussi un grand pas vers une version plus réaliste.