Préambule

Nous soussignés Ambre MULAC et Olivier SOLDANO déclarons sur l’honneur que ce rapport est le fruit d’un travail personnel, en binôme, que nous n’avons ni contrefait, ni falsifié, ni copié tout ou partie de l’ouvre d’autrui afin de la faire passer pour nôtre. Toutes les sources d’information utilisées et les citations d’auteur ont été mentionnées conformément aux usages en vigueur. Nous sommes conscient(e)s que le fait de ne pas citer une source ou de ne pas la citer clairement et complètement est constitutif de plagiat, que le plagiat est considéré comme une faute grave au sein de l’Université, pouvant être sévèrement sanctionnée par la loi.

PROBABILITES ET SIMULATIONS: Grille non fiable.

Introduction

Dans ce DM nous allons essayer d’analyser le comportement d’une grille de connexions non fiable de taille \(n\) selon la probabilité de panne d’un lien \(p\), plus particulièrement nous allons analyser la taille d’une composante connexe à un noeud donné de la grille, ainsi qu’à la probabilité de rupture \(1-p\) telle que si on dépasse une probabilité critique \(p_c\) telle que \(1-p \lt p_c\) (ou bien \(p \gt p_c\) les deux sont équivalents) pour que la grille soit completement connectée au noeud \((0,0)\)

nos données étant dépendantes d’un générateur aléatoire, pour obtenir des résultats reproductibles nous fixons la graine du générateur. nous donnons aussi les librairies optionnelles utilisées

## Warning: package 'ggplot2' was built under R version 3.1.2

Question 1: Modélisation

ci-après notre simulateur R générant une grille \([-n,n]\times[-n,n]\) de liens fiables avec une probabilité \(p\), représentée par une dataframe de longueur maximale \(2\times2n\times(2n+1)\) lignes (nombre de connexions maximal sur une grille \([-n,n]\times[-n,n]\)).

#grille : fonction générant une grille de liens 
grille<-function(n,p){
  frame <- data.frame()                                                         #conteneur du graphe
  for(i in -n:n){                                                               #parcours des deux dimensions
    for(j in -n:n){
      q<-runif(1)                   
      if(j+1 <= n && q < p) frame <- rbind(frame,data.frame(x1=i,y1=j,x2=i,y2=j+1))   #si le voisin1 est contenu dans la grille et que le lien n'est pas en panne on ajoute l'arète dans la dataframe
      q<-runif(1)
      if(i+1 <= n && q < p) frame <-rbind(frame,data.frame(x1=i,y1=j,x2=i+1,y2=j))     #idem pour le voisin2
    }
  }
return(frame)
}

On génère les liens d’adjacence vers la droite et vers le haut, en partant du sommet en bas à gauche pour limiter le parcours. la dataframe contient quatre colonnes,qui forment deux à deux les couples donnant les coordonnées des sommets de l’arète,(x1,y1) et (x2,y2). le graph en grille généré ne contiendra pas de meta-arètes.

Question 2: Analyse

on cherche à dénombrer les sommets connectés au sommet \((0,0)\). pour cela on va chercher tous les liens partant de \((0,0)\) retrouver les sommets qui y sont reliés et compter récursivement le nombre de sommets connectés à ceux ci.

# fonction de dénombrement des sommets connecté au sommet (x,y)
# n : taille de la grille
# df : grille
# x ,y: coordonnées du point étudié
# vu : tableau des points déja visités
nbConnect<-function(e,x,y){
    voisins<-data.frame()                                           #voisins = aucuns
    if(nrow(e$df)!= 0){                                               # si il existe des connexions dans la grille
        sub1<-subset(e$df, (x1 == x & y1 == y))                       # on selectionne les liens qui partent du point visité
        sub2<-subset(e$df, (x2 == x & y2 == y))                       # on séléctionne les liens qui entrent au point visité
        rs1<-nrow(sub1)                                             # comptage des liens sortants
        rs2<-nrow(sub2)                                             # comptage des liens entrants
        
        if (rs1!=0 | rs2!=0){
            voisins<-unique(rbind(voisins,data.frame(x=sub1$x2,y=sub1$y2))) #ajout des nouveaux voisins en sortie
            voisins<-unique(rbind(voisins,data.frame(x=sub2$x1,y=sub2$y1))) #ajout des nouveaux voisins en entrée
            e$df<-subset(e$df,!(x1==x & y1==y) & !(x2==x & y2==y))   #suppression des liens déja évalués du set de liens
            
            if(rs1>0){
                #cat ("eval sortants\n")
                for(j in seq_len(rs1)){         # pour tout sommets reliés aux les liens sortants on examine la connectivité
                    xs1<-sub1[j,'x2']
                    ys1<-sub1[j,'y2']
                    voisins<-unique(rbind(voisins,nbConnect(e,xs1,ys1)))   # on ajoute les nouveaux sommets voisins
                }
            }
            
            
            
            if(rs2>0){
               # cat ("eval entrants\n")
                for(j in seq_len(rs2)){         # pour tout sommets reliés aux les liens entrants on examine la connectivité
                    xs2<-sub2[j,'x1']
                    ys2<-sub2[j,'y1']
                    voisins<-unique(rbind(voisins,nbConnect(e,xs2,ys2)))  # on ajoute les nouveaux sommets voisins
                }
            }
        }
    }
  return(voisins);
}
# fonction d'évaluation de connectivité au sommet (x,y) à environnement stable pour algo recursif
connexion_grille<-function(n,p,x,y){
    df <- grille (n,p); #on créé une grille fiable à 100%
    #cat("eval pour taille",n,",à",p*100,"% fiable,",((2*n+1)^2)-1," noeuds accessibles max \n")
    e=environment()
    res<-nbConnect(e,x,y)
    nbAccess<-nrow(res)
    #cat(nbAccess,"noeuds connectés au sommet (",x,",",y,")"); #calcul du nombre de connexions
    return(nbAccess);
}

Dù à quelques problèmes de gestion des effets de bords pour la version recursive du code R, l’évaluation de la connectivité occasionne des blocages à partir d’une taille de grille \(n=8\) - le code occasionne des répétitions(répétition d’un nombre fixe de fois l’algorithme selon la taille de la grille) alors même que nous avons fixé l’environnement, pour une raison qui nous echappe encore…-, nos test se feront donc jusqu’à une taille de grille de \(n=7\).

expérimentation

notre experience va consister à comparer les rapports de tailles entre la composante connexe au sommet \((0,0)\), et la taille totale de la grille. Ainsi nous obtiendrons des resultats uniquement dépendants de la probabilité de rupture de lien (distorsion pour les cas de faible taille).

description de l’expérience:

  1. évaluation de la connectivité au sommet \((0,0)\) pour des grilles de taille 1 à 9 et une probabilité de rupture de lien allant de 1% à 99% par pas de 10%, moyenne sur 10 tirages

  2. affichage des résultats sous forme d’histogramme pour tenter de trouver la fourchette de probabilité ou se trouve la probabilité critique \(p_c\) de déconnexion d’un noeud.

k<-10
val<-0
taille <- seq_len(7)
proba <- c(1,10,20,30,40,50,60,70,80,90,99)
proba <-proba*0.01
res<-data.frame()
for (n in taille){
    nbNoeuds <-((2*n+1)^2)-1
    for (p in proba){
        for (i in seq_len(k)){
            val<-val + connexion_grille(n,p,0,0)
        }
        val<-val/k
        res<-rbind(res,data.frame(t=n,p=p,c_ratio=(val/nbNoeuds)))
        val<-0
    }    
}
#suppression de la première valeur car générant une erreur de façon aléatoire avec un ratio > 1
#suppression de la plus petite valeur pour t=1 à caude d'une erreur générée aléatoirement malgré la graine fixe (???)
res <- subset(res,t!=1 | p != 0.01)
#affichage des résultats
plot<- ggplot(data=res,aes(x=p,y=c_ratio,group=t,fill=t)) + geom_histogram(stat ='identity',position = 'dodge',binwidth = 0.1)
plot<- plot + ggtitle("taux de connexion de la grille au noeud (0,0)")
plot<- plot + theme_minimal()

plot<-plot + theme(plot.title = element_text(face="bold")) + scale_fill_continuous(name="taille de grille")
plot <- plot  + xlab("probabilité de connexion") + ylab ("noeuds connectés à (0,0) / nombre de noeuds  \n")
print(plot)

plot of chunk unnamed-chunk-6

on voit grace à cet histogramme que \(p_c\) se trouve entre 80% et 90% de fiabilité sur chaque lien. affinons notre recherche en recommençant notre experimentation sur cette frange.

k<-10
val<-0
taille <- seq_len(7)
proba <- c(80,82,84,86,88,90)
proba <-proba*0.01
res<-data.frame()
for (n in taille){
    nbNoeuds <-((2*n+1)^2)-1
    for (p in proba){
        for (i in seq_len(k)){
            val<-val + connexion_grille(n,p,0,0)
        }
        val<-val/k
        res<-rbind(res,data.frame(t=n,p=p,c_ratio=(val/nbNoeuds)))
        val<-0
    }
}
plot<- ggplot(data=res,aes(x=p,y=c_ratio,group=t,fill=t)) + geom_histogram(stat ='identity',position = 'dodge',binwidth = 0.1)
plot<- plot + ggtitle("taux de connexion de la grille au noeud (0,0)")
plot<- plot + theme_minimal()

plot<-plot + theme(plot.title = element_text(face="bold")) + scale_fill_continuous(name="taille de grille")
plot <- plot  + xlab("probabilité de connexion") + ylab ("noeuds connectés à (0,0) / nombre de noeuds  \n")
print(plot)

plot of chunk unnamed-chunk-8

ici on obtient un intervale entre 88% et 90%, on répète encore une fois sur un intervalle encore plus serré

k<-10
val<-0
taille <- seq_len(7)
proba <- c(880,883.3,886.6,890,893.3,896.6,900)
proba <-proba*0.001
res<-data.frame()
for (n in taille){
    nbNoeuds <-((2*n+1)^2)-1
    for (p in proba){
        for (i in seq_len(k)){
            val<-val + connexion_grille(n,p,0,0)
        }
        val<-val/k
        res<-rbind(res,data.frame(t=n,p=p,c_ratio=(val/nbNoeuds)))
        val<-0
    }
}
plot<- ggplot(data=res,aes(x=p,y=c_ratio,group=t,fill=t)) + geom_histogram(stat ='identity',position = 'dodge',binwidth = 0.1)
plot<- plot + ggtitle("taux de connexion de la grille au noeud (0,0)")
plot<- plot + theme_minimal()

plot<-plot + theme(plot.title = element_text(face="bold")) + scale_fill_continuous(name="taille de grille")
plot <- plot  + xlab("probabilité de connexion") + ylab ("noeuds connectés à (0,0) / nombre de noeuds  \n")
print(plot)

plot of chunk unnamed-chunk-10

Conclusion

Grace à ces résultats obtenus nous pensons pouvoir dire que la probabilité que \(p_c\) soit comprise entre 89% et 90% est très forte, cependant nous aurions aimé faire plusiers choses pour augmenter la probabilité de véracité de nos résultats:

  1. Faire des calculs pour estimer cette probabilité en fonction de la fourchette de proba visitée et savoir combien de fois répéter nos expériences jusqu’à atteindre un indice de confiance suppérieur à 99,9% par dichotomie, mais nous ne savons pas comment faire.

  2. Estimer une valeur idéale pour le nombre d’itération (k dans les expériences) à effectuer sur un couple taille/proba, pour avoir un temps de calcul juste pour obtenir cet indice de confiance.

  3. Essayer nos experiences sur des grilles de plus grande taille, pour confirmer le sentiment que la taille de la grille influe sur \(p_c\) à la baisse ; autrement dit qu’une grille plus grande aiderai dans une certaine mesure à générer un arbre couvrant, en proposant plus de chemins.