DM PS Gaëtan Rival

Exercice 1 : Question préliminaire à propos d’estimation

Question 1

Pour cette estmation, nous décidons de génerer a et n aléatoirement dans chaque expérience pour voir l’efficacité de Max(M) sur un a et n quelconque.

a -> correspond au nombre selectionné secretement par Alice n -> correspond au nombre de valeur selectionné dans l’interval {0..a}

###################### Fonction ##################
F1 <- function(){
  
for (t in 1:T){
  
###Intervalle allant de 0 à a
a=runif(1,min=0,1000)

###nb de nombre selectionné dans l'intervalle 
n=runif(1,min=2,1000)

L=n 
tab = array(L);

  for (i in 1:L){
    tab[i]=runif(1,min=0,a);
  }

M=max(tab)
#Ajouter à la table de donnée
if(t==1){
  tabDiff[t,1]=n
  tabDiff[t,2]=a-M
}
else{
  ligne <-c(n,a-M)
  tabDiff <-rbind(tabDiff,ligne)
}
}
plot(tabDiff)
}

##################################################

T=500 ###Nombre d'experiences

tabDiff <- data.frame(N=c(0),Diff=c(0)); #Initialisation tableau de donnée

F1()

D’après le graphe ci-dessus, nous pouvons remarquer que plus le nombre n est important, plus la difference entre le nombre a et le Max(n) de la selection devient faible. Donc en augmentant le nombre de valeur selectionné dans l’interval {0..a}, plus nos chances sont élevées de trouver la valeur de a.

Pour continuer notre estimation, nous avons décider cette fois de fixer la valeur de a et de voir l’évolution de notre estimateur en fonctin de n.

Pour une valeur de a :

###Intervalle allant de 0 à a
a=runif(1,min=0,1000)
a

## [1] 389.3105

###################### Fonction ##################
F2 <- function(a){
  
for (t in 1:T){
  
###nb de nombre selectionné dans l'intervalle 
n=runif(1,min=2,1000)

L=n 
tab = array(L);

  for (i in 1:L){
    tab[i]=runif(1,min=0,a);
  }

M=max(tab)
#Ajouter à la table de donnée
if(t==1){
  tabMax[t,1]=n
  tabMax[t,2]=M
}
else{
  ligne <-c(n,M)
  tabMax <-rbind(tabMax,ligne)
}
}
plot(tabMax)
return (tabMax)
}

##################################################

T=500 ###Nombre d'experiences

tabMax <- data.frame(N=c(0),Max=c(0)); #Initialisation tableau de donnée

tabMax=F2(a)
Em=mean(tabMax$Max)
abline(h=a,col="red")

Maintenant nous décidons de fixer la valeur de a et n afin d’évaluer l’esperance de M.

a vaut :

###Intervalle allant de 0 à a
a=runif(1,min=0,1000)
a

## [1] 956.7371

n vaut :

###nb de nombre selectionné dans l'intervalle 
n=runif(1,min=2,1000)
n

## [1] 52.57687

###################### Fonction ##################
F3 <- function(a,n){
  
for (t in 1:T){
L=n 
tab = array(L);

  for (i in 1:L){
    tab[i]=runif(1,min=0,a);
  }

M=max(tab)
#Ajouter à la table de donnée
if(t==1){
  tabAN[t,1]=n
  tabAN[t,2]=M
}
else{
  ligne <-c(n,M)
  tabAN <-rbind(tabAN,ligne)
}
}
plot(tabAN)
return (tabAN)
}

##################################################

T=500 ###Nombre d'experiences

tabAN <- data.frame(N=c(0),Max=c(0)); #Initialisation tableau de donnée

tabAN=F3(a,n)

abline(h=a,col="red")

Nous obtenons pour a et n une esperance de M de :

#Esperance M :
Em=mean(tabAN$Max)
Em

## [1] 938.635

Pour caculer l’esperance de M en fonction de a et n, nous obtenons la formule suivante : E[M]=((n-1)/n)*a

#Test formule
TestE=((n-1)/n)*a

Nous obtenons la valeur suivante :

TestE

## [1] 938.5402

Sachant que la variance de M est VAR(M)=E(M²)-E(M)² donc nous obtenons :

VarM=var(tabAN$Max)
VarM

## [1] 333.0224

#Test Variance formule en fonction de a et n
Var=((n-2)/n)*a*a
VarM2=abs((Var-(TestE*TestE)))
VarM2

## [1] 331.1278

Question 2

Pour évaluer ce nouveau estimateur soit M’=(2/n) *sum(Xi), nous allon reprendre les mêmes valeurs de a et n qu’avant afin d’effectuer une comparaison. Nous nous placerons dans une phase de test de 500 expériences comme dans la question d’avant. Rappel des valeurs de a et n :

a

## [1] 956.7371

n

## [1] 52.57687

###################### Fonction ##################
F4 <- function(a,n){
  
for (t in 1:T){
L=n 
tab = array(L);

  for (i in 1:L){
    tab[i]=runif(1,min=0,a);
  }

M=(2/n)*sum(tab)
#Ajouter à la table de donnée
if(t==1){
  tabM1[t,1]=n
  tabM1[t,2]=M
}
else{
  ligne <-c(n,M)
  tabM1 <-rbind(tabM1,ligne)
}
}
plot(tabM1)
return (tabM1)
}

##################################################

T=500 ###Nombre d'experiences

tabM1 <- data.frame(N=c(0),Max=c(0));  #Initialisation tableau de donnée

tabM1=F4(a,n)
abline(h=a,col="red")

Comme nous pourvons le voir sur le graphique au dessus, beaucoup plus de valeurs se trouvent au dessus de la ligne rouge par rapport à l’estimateur avec Max.

Nous obtenons une esperance pour M’ de :

#Esperance M' :
Em1=mean(tabM1$Max);
Em1

## [1] 947.0224

Nous pouvons relever que l’esperance de cet estimateur M’ est plus éloigné de la valeur de a que l’estimateur M.

VarM1=var(tabM1$Max)
VarM1;

## [1] 5719.887

De plus la dispertion des valeurs est bien plus importante sur cette derniere que sur l’autre graphe ce qui est prouvé par le calcul de la variance.

Exercice 2 : Un deuxieme jeu à base de max

Question 1 :

###################### Fonction ##################
F5 <- function(n){

for (t in 1:T){
  
###Intervalle allant de 0 à 1
a=runif(1,0,1)

L=n
tab = array(L);

  for (i in 1:L){
    tab[i]=runif(1,min=0,a);
  }
M=max(tab)
rM=1.1*M

if(rM<=a){
  Gain=rM-M
}
else{
  Gain=0
}

#Ajouter à la table de donnée
if(t==1){
  tabGain[t,2]=M
  tabGain[t,3]=rM
  tabGain[t,4]=Gain
}
else{
  ligne <-c(n,M,rM,Gain)
  tabGain <-rbind(tabGain,ligne)
}

}
return(tabGain)
}
####################################################

###nb de nombre selectionné dans l'intervalle 
n=10

T=100 ###Nombre d'experiences

#Initilisation
tabGain <- data.frame(N=c(n),Max=c(0),rM=c(0),Gain=c(0));

tabGain=F5(n)

#Représentation graphique
plot(tabGain$N,tabGain$Gain)

Pour s’implifier l’affichage du graphique, nous avons effectué juste 100 expériences pour montrer qu’une grande partie des gains sont proches voir égales à 0. Donc nous pouvons en déduire que les valeurs r(M) sont plus souvent supérieur à a. Pour que se soit plus représentatif, nous avons calculé l’esperance du gain soit :

#Esperance du Gain
EGain=mean(tabGain$Gain);
EGain;

## [1] 0.01684325

Afin de montrer l’impact du nombre d’expérience sur l’esperance du Gain, nous avons effectué le graphe suivant pour montrer son évolution.

###################### Fonction ##################
F6 <- function(T,n){
  
#Initilisation
tabGain1 <- data.frame(N=c(n),Max=c(0),rM=c(0),Gain=c(0));

for (t in 1:T){
  
###Intervalle allant de 0 à 1
a=runif(1,0,1)

L=n
tab = array(L);

  for (i in 1:L){
    tab[i]=runif(1,min=0,a);
  }
M=max(tab)
rM=1.1*M

if(rM<=a){
  Gain=rM-M
}
else{
  Gain=0
}

#Ajouter à la table de donnée
if(t==1){
  tabGain1[t,2]=M
  tabGain1[t,3]=rM
  tabGain1[t,4]=Gain
}
else{
  ligne <-c(n,M,rM,Gain)
  tabGain1 <-rbind(tabGain1,ligne)
}

}
return (mean(tabGain1$Gain))
}
####################################################

###nb de nombre selectionné dans l'intervalle 
n=10

T=5 ###Nombre d'experiences

#Initilisation
tabGainT <- data.frame(T=c(T),EGain=c(0));

for(i in 1:10){
  #Ajouter à la table de donnée
if(i==1){
  tabGainT[i,2]=F6(T,n)
}
else{
  ligne <-c(T,F6(T,n))
  tabGainT <-rbind(tabGainT,ligne)
}
  T=T*2
}

plot(tabGainT)

Suite à ce graphe, nous remarquons que l’esperance du gain à tendance à devenir constant et tendre vers 0.015. Ce qui se rapproche fortement de 0.

Sachant que dans ce jeu, il n’y a aucune perte donc le jeu ne peut être qu’à l’avantage de Bob. Mais quand nous regardons la stratégie de Bob et le résultat de l’esperance du Gain, nous pouvons remarquer qu’elle est tres proche de 0 donc la probabilité de gagner reste tres faible en prenant comme r(M)=1.1M Nous pouvons en déduire qu’il ne s’agit pas de la meilleure stratégie pour cette situation car plus notre Max(Xi) est proche de a, plus nous avons de chance de dépasser cette derniere et donc d’obtenir aucun gain.

Question 2 :

Dans cette situation, nous allons générer A et M aléatoirement à chaque expérience pour un a et m fixe. Prenons a et n suivant sachant que n est aussi fixé :

##### P(A=a,M=m) #############

# Variable a
a=0.8
# Variable m
m=0.6
# Variable n
n=3

###################### Fonction ##################
F7 <- function(a,n){
  
for (t in 1:T){
  
A=runif(1,min=0,1);
A=round(A,1)  #Arrondir un chiffre après la virgule

M=runif(1,min=0,A);
M=round(M,1)  #Arrondir un chiffre après la virgule

L=n
tab = array(L);

  for (i in 1:L){
    x=runif(1,min=0,A);
    tab[i]=round(x,1); #Arrondir un chiffre après la virgule
  }

M=max(tab)

if(A==a && M==m ){
  C=1
}
else{
  C=0
}

#Ajouter à la table de donnée
if(t==1){
  tabAM[t,2]=A
  tabAM[t,3]=M
  tabAM[t,4]=C
}
else{
  ligne <-c(n,A,M,C)
  tabAM <-rbind(tabAM,ligne)
}
}
  return(tabAM)
}

################################################

T=500 ###Nombre d'experience

#Initilisation
tabAM <- data.frame(N=c(n),A=c(0),M=c(0),Condition=c(0));

tabAM=F7(a,n);

Nous obtenons ainsi l’estimation suivante pour la probabilité de A=a et M=m :

Prob=mean(tabAM$Condition)
Prob

## [1] 0.024

Pour la cas suivant, nous avons fixé la valeur de M à 0.5 et nous avons calculer la probabilité de A=a sachant M=0.5 Sachant la formule P(A|B)= P(A,B)/P(B), nous avons appliqué cette dernière pour évaluer notre estimation sur la valeur de A.

Nous avons fixer les valeurs à n=3 (consigne) et T=1000 afin d’affiner nos probabilitées.

##### P(A=a|M=0.5) #############

T=1000 ###Nombre d'experience

#Nombre de nombre dans l'interval {0 .. A}
n=3

######################## Fonction P(A,B) ######################"
F8 <- function(a,m){
  
#Initilisation
tabA <- data.frame(N=c(n),A=c(0),M=c(0),Condition=c(0));

for (t in 1:T){
  
A=runif(1,min=0,1);
A=round(A,1)

M=runif(1,min=0,A);
M=round(M,1)
  
L=n
tab = array(L);

  for (i in 1:L){
    x=runif(1,min=0,A);
    tab[i]=round(x,1); #Arrondir un chiffre après la virgule
  }

M=max(tab)

if(A==a && M==m ){
  C=1
}
else{
  C=0
}

#Ajouter à la table de donnée
if(t==1){
  tabA[t,2]=A
  tabA[t,3]=M
  tabA[t,4]=C
}
else{
  ligne <-c(n,A,M,C)
  tabA <-rbind(tabA,ligne)
}
}


Prob=mean(tabA$Condition)
return (Prob) #Retourne une probabilité

}
##########################################

#Initilisation
tabA <- data.frame(A=c(0),PAxM=c(0),PA_M=c(0));

for(i in 0:10){
  
#Ajouter à la table de donnée
if(i==0){
  tabA[i,2]=F8(0,0.5)
}
else{
  ligne <-c(i/10,F8(i/10,0.5))
  tabA <-rbind(tabA,ligne)
}
}

PM=sum(tabA$PAxM)


for(i in 0:10){
  tabA[i,3]=round(tabA[i,2]/PM,4) #Arrondi 2 chiffres après la virgule
}

Voici le résultat de notre estimation sur la valeur de A soit : PAxM -> Probabilité de A et M PA_M -> Probabilité de A sachant M(=0.5 dans notre cas)

tabA

##      A  PAxM  PA_M
## 1  0.0 0.000 0.000
## 2  0.1 0.000 0.000
## 3  0.2 0.000 0.000
## 4  0.3 0.000 0.000
## 5  0.4 0.000 0.000
## 6  0.5 0.029 0.232
## 7  0.6 0.045 0.360
## 8  0.7 0.021 0.168
## 9  0.8 0.018 0.144
## 10 0.9 0.011 0.088
## 11 1.0 0.001 1.000

Selon les cas, les probabilités les plus fortes pour la valeur de A se joue entre 0.5 et 0.6. Donc ne devrions proposer à Alice l’une de ces deux valeurs.

Question 3

###nb de nombre selectionné dans l'intervalle 
n=2

T=500 ###Nombre d'experience

#Initilisation
tabSum <- data.frame(N=c(n),Max=c(0),rM1=c(0),rM2=c(0),rM3=c(0),Gain03=c(0),Gain05=c(0),Gain07=c(0));

for (t in 1:T){
  
###Intervalle allant de 0 à 1
a=runif(1,0,1)
L=n
tab = array(L);

  for (i in 1:L){
    tab[i]=runif(1,min=0,a);
  }

M=max(tab)
rM1=M**0.3 #Puissance 0.3
rM2=M**0.5 #Puissance 0.5
rM3=M**0.7 #Puissance 0.6


if(rM1<=a){
  Gain1=rM1-M
}
else{
  Gain1=0
}
if(rM2<=a){
  Gain2=rM2-M
}
else{
  Gain2=0
}
if(rM3<=a){
   Gain3=rM3-M
}
else{
  Gain3=0
}


#Ajouter à la table de donnée
if(t==1){
  tabSum[t,2]=M
  tabSum[t,3]=rM1
  tabSum[t,4]=rM2
  tabSum[t,5]=rM3
  tabSum[t,6]=Gain1
  tabSum[t,7]=Gain2
  tabSum[t,8]=Gain3
}
else{
  ligne <-c(n,M,rM1,rM2,rM3,Gain1,Gain2,Gain3)
  tabSum <-rbind(tabSum,ligne)
}

}


#Représentation graphique
plot(tabSum$N,tabSum$rM1)
abline(h=a,col="red")

plot(tabSum$N,tabSum$rM2)
abline(h=a,col="red")

plot(tabSum$N,tabSum$rM3)
abline(h=a,col="red")

Nous obtenons une esperance avec alpha=0.3 de :

#Esperance du Gain avec alpha=0.3
EGain03=mean(tabSum$Gain03);
EGain03;

## [1] 0.05805169

Nous obtenons une esperance avec alpha=0.5 de :

#Esperance du Gain avec alpha=0.5
EGain05=mean(tabSum$Gain05);
EGain05;

## [1] 0.06642008

Nous obtenons une esperance avec alpha=0.7 de :

#Esperance du Gain avec alpha=0.7
EGain07=mean(tabSum$Gain07);
EGain07;

## [1] 0.05491064

Suite aux résultats, nous pouvons en déduire que la puissance 0.5 est la plus efficace.

Pour déterminer par la suite le meilleur alpha, nous allons tester tout les differents cas possibles et analyser leur esperance de gain.

###################### Fonction ####################
F8 <- function(n,alpha){
#Initilisation
tabAlpha <- data.frame(N=c(n),Gain=c(0));

for (t in 1:T){
  
###Intervalle allant de 0 à 1
a=runif(1,0,1)
L=n
tab = array(L);

  for (i in 1:L){
    tab[i]=runif(1,min=0,a);
  }

M=max(tab)
rM=M**alpha #Puissance alpha

if(rM<=a){
  Gain=rM-M
}
else{
  Gain=0
}


#Ajouter à la table de donnée
if(t==1){
  tabAlpha[t,2]=Gain
}
else{
  ligne <-c(n,Gain)
  tabAlpha <-rbind(tabAlpha,ligne)
}

}
  return(mean(tabAlpha$Gain))
}
###################################################

#Initilisation
tabR <- data.frame(alpha=c(0),Esperance=c(0));

for(t in 0:10){
  if(t==0){
    tabR[t,1]=F8(n,t)
  }
  else{
    ligne <-c(t/10,F8(n,t/10))
    tabR <-rbind(tabR,ligne)
  }
}
tabR

##    alpha  Esperance
## 1    0.0 0.00000000
## 2    0.1 0.02609426
## 3    0.2 0.03530567
## 4    0.3 0.05757919
## 5    0.4 0.05840187
## 6    0.5 0.06307375
## 7    0.6 0.06748324
## 8    0.7 0.05591537
## 9    0.8 0.04338768
## 10   0.9 0.02469031
## 11   1.0 0.00000000

Dans la majorité des cas, l’alpha le plus interessant est 0.6 avec une esperance de gain la plus importante. Donc pour n=2, nous conseillons de prendre comme alpha pour cette strategie 0.6. Ensuite, nous allon reproduire la même strategie mais avec n=10 et le même nombre d’experiences pour comparer les résultats.

###nb de nombre selectionné dans l'intervalle 
n=10

T=500 ###Nombre d'experience

Voici le code pour determiner le meilleur alpha pour n=10 :

#Initilisation
tabR <- data.frame(alpha=c(0),Esperance=c(0));

for(t in 0:10){
  if(t==0){
    tabR[t,1]=F8(n,t)
  }
  else{
    ligne <-c(t/10,F8(n,t/10))
    tabR <-rbind(tabR,ligne)
  }
}
tabR

##    alpha    Esperance
## 1    0.0 0.0000000000
## 2    0.1 0.0009144687
## 3    0.2 0.0037661941
## 4    0.3 0.0073429588
## 5    0.4 0.0075154442
## 6    0.5 0.0089769610
## 7    0.6 0.0083924980
## 8    0.7 0.0129415459
## 9    0.8 0.0140476119
## 10   0.9 0.0138520347
## 11   1.0 0.0000000000

Dans la majorité des cas, l’alpha le plus interessant est 0.8 avec une esperance de gain la plus élevé. Donc pour n=10, nous conseillons de prendre comme alpha pour cette strategie 0.8.

Exerice 3 : Un dernier jeu à base de max et pile et face

Question 1 :

#################### Fonction ###########################
F9 <- function(Bool){
  #Bool=1 -> Plus Grande
  #Bool=0 -> Plus Petite
  for (t in 1:T){

    A2=runif(1,min=0,1);
    
    A1=runif(1,min=0,max=A2);
    
    Piece=round(runif(1),0)
    
    #Pile=1
    #Face=0
    
    if(Piece==0){
      resultat=A1
    }
    else{
      resultat=A2
    }
    
    
    if(Bool==1 && resultat==A2){
      c=1
    }
    else{
      if(Bool==0 && resultat==A1){
        c=1
      }
      else{
        c=0
      }
    }
    
    #Ajouter à la table de donnée
    if(t==1){
      tabB[t,1]=resultat
      tabB[t,2]=c
    }
    else{
      ligne <-c(resultat,c)
      tabB <-rbind(tabB,ligne)
    }
  }
  return(tabB)
}
  



######################################################

T=1000 ###Nombre d'experience

#Initilisation
tabB <- data.frame(Resultat=c(0),Condition=c(0));

tabB=F9(1)

Donc si Bob decide de toujours dire oui le fait qu’Alice lui donne la plus grande des valeus, nous obtenons la probabilié suivante :

Pwin=mean(tabB$Condition)
Pwin

## [1] 0.521

De plus, nous pouvons remarquer que cette situation suit une loi binomial et on s’attend à trouver une probabilité proche de 0.5.

Question 2

Notre stategie est d’analyser la valeur d’Alice. Si cette derniere est supérerieure à 0.5, nous répondons “oui” comme quoi il s’agit bien de la plus grande valeur sinon nous répondons “non” dans le cas où la valeur est strictement inférieure à 0.5.

#################### Fonction ###########################
F10 <- function(){
  #Bool=1 -> Plus Grande
  #Bool=0 -> Plus Petite
  for (t in 1:T){
    
    A2=runif(1,min=0,1);
    
    A1=runif(1,min=0,max=A2);

    
    
    Piece=round(runif(1),0)
    
    #Pile=1
    #Face=0
    
    if(Piece==0){
      resultat=A1
    }
    else{
      resultat=A2
    }
    
    if (resultat>=0.5)
      Bool=1
    else{
      Bool=0
    }
    
    
    if(Bool==1 && resultat==A2){
      c=1
    }
    else{
      if(Bool==0 && resultat==A1){
        c=1
      }
      else{
        c=0
      }
    }
    
    #Ajouter à la table de donnée
    if(t==1){
      tabB[t,1]=resultat
      tabB[t,2]=c
    }
    else{
      ligne <-c(resultat,c)
      tabB <-rbind(tabB,ligne)
    }
  }
  return(tabB)
}
  



######################################################

T=1000 ###Nombre d'experience

#Initilisation
tabB <- data.frame(Resultat=c(0),Condition=c(0));

tabB=F10()

Ainsi, nous obtenons l’esperance de gain suivante :

Pwin=mean(tabB$Condition)
Pwin

## [1] 0.706

Maintenant nous allons tester notre stratégie avec A1 et A2 fixex soit :

A1=0.4
A2=0.6

#################### Fonction ###########################
F11 <- function(A1,A2){
  #Bool=1 -> Plus Grande
  #Bool=0 -> Plus Petite
  for (t in 1:T){
    
    Piece=round(runif(1),0)
    
    #Pile=1
    #Face=0
    
    if(Piece==0){
      resultat=A1
    }
    else{
      resultat=A2
    }
    
    if (resultat>=0.5)
      Bool=1
    else{
      Bool=0
    }
    
    
    if(Bool==1 && resultat==A2){
      c=1
    }
    else{
      if(Bool==0 && resultat==A1){
        c=1
      }
      else{
        c=0
      }
    }
    
    #Ajouter à la table de donnée
    if(t==1){
      tabB[t,1]=resultat
      tabB[t,2]=c
    }
    else{
      ligne <-c(resultat,c)
      tabB <-rbind(tabB,ligne)
    }
  }
  return(tabB)
}
  
######################################################

T=1000 ###Nombre d'experience

#Initilisation
tabB <- data.frame(Resultat=c(0),Condition=c(0));

tabB=F11(A1,A2)

Ainsi, nous obtenons l’esperance suivante :

Pwin=mean(tabB$Condition)
Pwin

## [1] 1