Pierre-Henri Ginoux, David Levayer RICM4
On génère des labyrinthe avec rejet. Un labyrinthe est valide si et seulement si il existe au moins un chemin de A à B.
La fonction genereLabyrinthe créé des labyrinthe uniforme (pour chaque case, on a une probabilité p d'avoir un obstacle). On regarde ensuite si un chemin A->B existe. Pour cela, on se place en A et on marque les cases où l'on peut se rendre. Petit à petit, on complète une matrice binaire qui indique les chemins du labyrinthe. Lorsque la matrice est entièrement complétée, on regarde si le point B est marqué.
cherche <- function(mat, matBin, x, y) {
m <- nrow(mat)
n <- ncol(mat)
matBin[x, y] <- 1
nextMatBin = matrix(data = 0, m, n)
for (i in 1:m) {
for (j in 1:n) {
nextMatBin[i, j] = matBin[i, j]
}
}
# On regarde <U+00E0> chaque fois : - si on ne sort pas de la matrice - si
# on est d<U+00E9>ja pass<U+00E9> par l<U+00E0> (marque <U+00E0> 1) - si on
# a le droit de passer (obstacle ?)
if (x < m) {
if (matBin[x + 1, y] != 1 & mat[x + 1, y] != 1) {
nextMatBin = cherche(mat, nextMatBin, x + 1, y)
}
}
if (x > 1) {
if (matBin[x - 1, y] != 1 & mat[x - 1, y] != 1) {
nextMatBin = cherche(mat, nextMatBin, x - 1, y)
}
}
if (y < n) {
if (matBin[x, y + 1] != 1 & mat[x, y + 1] != 1) {
nextMatBin = cherche(mat, nextMatBin, x, y + 1)
}
}
if (y > 1) {
if (matBin[x, y - 1] != 1 & mat[x, y - 1] != 1) {
nextMatBin = cherche(mat, nextMatBin, x, y - 1)
}
}
nextMatBin
}
trouveChemin <- function(mat) {
m <- nrow(mat)
n <- ncol(mat)
# Si on a un obstacle des le depart...
if (mat[m, 1] == 1) {
FALSE
} else {
# On cree une matrice binaire qui va tracer les chemins possibles
matBin = matrix(data = 0, m, n)
matBinComplete = cherche(mat, matBin, m, 1)
if (matBinComplete[1, n] == 1) {
TRUE
} else {
FALSE
}
}
}
genereLabyrinthe <- function(m, n, p) {
repeat {
# On cree la matrice avec les obstacles
mat = matrix(data = 0, m, n)
for (i in 1:m) {
for (j in 1:n) {
u = runif(1, 0, 1)
if (u < p)
mat[i, j] <- 1
}
}
# On regarde s'il y a bien un chemin de A vers B
if (trouveChemin(mat))
break
}
mat
}
# On genere un labyrinthe valide
for (i in 1:1) {
laby <- genereLabyrinthe(5, 5, 0.3)
}
print(laby)
## [,1] [,2] [,3] [,4] [,5]
## [1,] 1 1 1 0 0
## [2,] 1 0 0 0 1
## [3,] 0 0 1 0 0
## [4,] 0 0 0 0 0
## [5,] 0 1 1 0 0
# ggplot(data.frame(laby), aes(x,y)) + stat_bin2d(bins=c(5,5)) +
# coord_fixed() + geom_vline(xintercept = 0) + geom_hline(yintercept = 0)
Version peu efficace (mais qui marche, ce qui est déjà pas mal) : méthode avec rejet
deplace <- function(x1, y1, lab) {
m = nrow(lab)
n = ncol(lab)
x = x1
y = y1
nbDeplacement = 0
# On place la puce
lab[x, y] = 2
run <- TRUE
while (run) {
# On regarde les deplacements possibles
l = matrix(nrow = 4, ncol = 2)
nbPossibilite = 0
if (x > 1) {
if (lab[x - 1, y] != 1) {
nbPossibilite = nbPossibilite + 1
l[nbPossibilite, 1] = x - 1
l[nbPossibilite, 2] = y
}
}
if (x < m) {
if (lab[x + 1, y] != 1) {
nbPossibilite = nbPossibilite + 1
l[nbPossibilite, 1] = x + 1
l[nbPossibilite, 2] = y
}
}
if (y > 1) {
if (lab[x, y - 1] != 1) {
nbPossibilite = nbPossibilite + 1
l[nbPossibilite, 1] = x
l[nbPossibilite, 2] = y - 1
}
}
if (y < n) {
if (lab[x, y + 1] != 1) {
nbPossibilite = nbPossibilite + 1
l[nbPossibilite, 1] = x
l[nbPossibilite, 2] = y + 1
}
}
# On tire un entier uniformement pour decider du deplacement
u = ceiling(runif(1, 0, nbPossibilite))
newX = l[u, 1]
newY = l[u, 2]
# On efface la puce
lab[x, y] = 0
# On fait bouger la puce
x = newX
y = newY
# On incremente le nombre de deplacement
nbDeplacement = nbDeplacement + 1
# On remet la puce au nouvel emplacement
lab[x, y] = 2
if ((x == 1) && (y == n)) {
run <- FALSE
}
}
nbDeplacement
}
On test les deplacements de la puce
m = nrow(laby)
nb = deplace(m, 1, laby)
print(nb)
## [1] 148
Pour faire les tests on a choisi les couples (m,n) suivants : (10,10),(10,20),(20,10),(20,20).
Le cas de la matrice 10,10 est détaillé (ce qui correspond à la question 4).
# On cr<U+00E9>er les diff<U+00E9>rents labyrinthes n<U+00E9>cessaires pour
# les tests
laby5u5 <- genereLabyrinthe(5, 5, 0)
laby10u10 <- genereLabyrinthe(10, 10, 0)
laby10u20 <- genereLabyrinthe(10, 20, 0)
laby20u10 <- genereLabyrinthe(20, 10, 0)
laby20u20 <- genereLabyrinthe(20, 20, 0)
# A partir de 30,30, l'ordinateur que nous avons utilis<U+00E9> pour les
# tests n'est plus capabl ede faire les calculs
On teste le labyrinthe avec 1000 puces. Pour chaque puce, on retient le nombre de déplacements necessaires. Ces nombres sont stockés dans un vecteur puis tracés. Enfin, on calcule le temps moyen.
val = c()
for (i in 1:1000) {
val = c(val, deplace(5, 1, laby5u5))
}
hist(val, breaks = 50, main = "Nombre de deplacements (laby 5x5 sans obstacle)")
Temps moyen :
mean(val)
## [1] 80.04
On voit bien que la majorité des puces arrivent à sortir du labyrinthe en moins de 100 coups. On regarde si c'est uniforme :
chisq.test(val)
##
## Chi-squared test for given probabilities
##
## data: val
## X-squared = 53772, df = 999, p-value < 2.2e-16
La distribution n'est pas uniforme (vu l'histogramme, on aurait pu s'en douter).
Est-ce que la distribution suit une loi normale ? On a pas vraiment de symétrie, mais peut-etre que c'est une loi normale tronquée…
On fait de même pour les matrices suivantes…
val = c()
for (i in 1:100) {
val = c(val, deplace(10, 1, laby10u10))
}
hist(val, breaks = 10, main = "Nombre de deplacements (laby 10x10 sans obstacle)")
mean(val)
## [1] 604.3
val = c()
for (i in 1:100) {
val = c(val, deplace(10, 1, laby10u20))
}
hist(val, breaks = 10, main = "Nombre de deplacements (laby 10x20 sans obstacle)")
mean(val)
## [1] 1450
val = c()
for (i in 1:100) {
val = c(val, deplace(20, 1, laby20u10))
}
hist(val, breaks = 10, main = "Nombre de deplacements (laby 20x10 sans obstacle)")
mean(val)
## [1] 1465
val = c()
for (i in 1:100) {
val = c(val, deplace(20, 1, laby20u20))
}
hist(val, breaks = 10, main = "Nombre de deplacements (laby 20x20 sans obstacle)")
mean(val)
## [1] 3165
On retrouve les mêmes tendances et la même forme de courbe (même si les valeurs varient en abscisse/ordonné).
resVariationP = c()
inter = c(1:10)
for (i in inter) {
p = 5 * i/100
labyP = genereLabyrinthe(10, 10, p)
val = c()
for (i in 1:500) {
val = c(val, deplace(10, 1, labyP))
}
resVariationP = c(resVariationP, mean(val))
}
print(resVariationP)
## [1] 550.3 641.9 486.9 900.0 580.8 951.3 832.4 568.1 1238.7 586.4
plot(inter, resVariationP)
Ce résultat est pour le moins étrange.
On pensait que le temps moyen pour sortir du labyrinthe allait diminuer au fur et à mesure que p augmente. En effet, si on rajoute des obstacles, on diminue les choix possibles pour la puce, qui se retrouve alors sur le bon chemin (malgré elle).
Or il semblerait que ce ne soit pas si simple. Les valeurs oscillent, montent dans un premier temps puis resecendent…
Une chose semble certaine : la valeur de p a une influence sur le temps moyen de parcours du labyrinthe (c'est une petite victoire, mais une victoire quand même)