Pour la génération de labyrinte, notre idée est de fixer chaque point comme espace ou obstacle selon la probabilité p.
On a déclaré deux variables globales SPACE et OBSTACLE, pour fixer les valeurs de chaque point du labyrinthe.
rm(list = ls())
set.seed(66)
# var globale
SPACE <- 1
OBSTACLE <- 0
Pour faire un algorithme plus simple, pour la génération de chaque labyrinte de taille mn, on génère un terrain de taille (m+2)(n+2), la première ligne (resp. collone) et la dernière ligne (resp. collone) sont fixés comme OBSTACLE. Donc on peut éviter la vérification de bord, toutes les condition s'aigit de la valeur du point(SPACT ou OBSTACLE). Dans ce protocole, le point A est (n+1,2), le point B est (2,m+1).
#
# --------------------------------------------------------------------------
# GenTerrain : Générer & retourner un terrain acceptable is_draw : 0, ne
# fait pas d'imprimer 1, imprimer & dessiner tous les terrains 2, imprimer
# & dessiner le terrain acceptable
# --------------------------------------------------------------------------
GenTerrain <- function(m, n, p, is_draw) {
repeat {
terrain <- matrix(SPACE, nrow = n + 2, ncol = m + 2, byrow = TRUE)
i <- 0
# fixer les 4 bords comme obstacle
while (i < m + 2) {
terrain[1, i + 1] <- OBSTACLE
terrain[n + 2, i + 1] <- OBSTACLE
i <- i + 1
}
j <- 0
while (j < n + 2) {
terrain[j + 1, 1] <- OBSTACLE
terrain[j + 1, m + 2] <- OBSTACLE
j <- j + 1
}
# générer un terrain
i <- 1
while (i < m + 1) {
j <- 1
while (j < n + 1) {
if (runif(1) < p) {
terrain[j + 1, i + 1] <- OBSTACLE
}
j <- j + 1
}
i <- i + 1
}
# fixer le point A et le point B comme SPACE
terrain[n + 1, 2] <- SPACE
terrain[2, m + 1] <- SPACE
# vérifier ce terrain, si c'est acceptable on retourne, sinon refaire pour
# p==0, on n'a pas besoin de vérifier
if (p > 0 && CheckTerrain(terrain) == 1) {
if (is_draw == 1 || is_draw == 2) {
# print(terrain)
DrawTerrain(terrain, 0)
}
return(terrain)
} else if (p == 0) {
return(terrain)
}
if (is_draw == 1) {
# print(terrain)
DrawTerrain(terrain, 1)
}
}
}
Pour la vérification du terrain, on parcourt le terrain, si on peut atteindre le point B, ce terrain est acceptable, sinon on rejete.
# vérifier si le terrain est acceptable
CheckTerrain <- function(terrain) {
DEALED <- 1
NO_DEALED <- 0
# un tableau de même taille que le terrain, initialisé tous les points
# comme NO_DEALED
temp <- matrix(NO_DEALED, nrow = nrow(terrain), ncol = ncol(terrain), byrow = TRUE)
# une fonction récursive, qui marque les points ce qu'on a déjà visité &
# visite tous les points non visités ce qu'il peut atteindre.
CheckPoint <- function(position) {
temp[position[1], position[2]] <<- DEALED
# print(position)
if (temp[position[1] - 1, position[2]] == NO_DEALED && terrain[position[1] -
1, position[2]] == SPACE) {
CheckPoint(c(position[1] - 1, position[2]))
}
if (temp[position[1] + 1, position[2]] == NO_DEALED && terrain[position[1] +
1, position[2]] == SPACE) {
CheckPoint(c(position[1] + 1, position[2]))
}
if (temp[position[1], position[2] - 1] == NO_DEALED && terrain[position[1],
position[2] - 1] == SPACE) {
CheckPoint(c(position[1], position[2] - 1))
}
if (temp[position[1], position[2] + 1] == NO_DEALED && terrain[position[1],
position[2] + 1] == SPACE) {
CheckPoint(c(position[1], position[2] + 1))
}
}
# le point A est c(nrow(terrain)-1,2)
CheckPoint(c(nrow(terrain) - 1, 2))
# si à la fin, le point B (2,ncol(terrain)-1) est visité, on retourne vrai
# sinon faux.
if (temp[2, ncol(terrain) - 1] == DEALED) {
return(1)
}
return(0)
}
On a fourni une fonction pour dessiner le terrain en plusieurs couleurs, les cases noirs sont des bords, les cases blancs sont des espaces, les cases gris sont des obstacles, le case bleu est le point A, le case rouge est le point B.
# déssiner le terrain para is_rejet : boolean, si ce terrain est rejeté
DrawTerrain <- function(terrain, is_rejet) {
t <- t(terrain)[, nrow(terrain):1]
if (is_rejet == 1) {
plot(c(0, nrow(t)), c(0, ncol(t)), type = "n", xlab = "", ylab = "",
asp = 1, main = "terrain rejeté", axes = FALSE)
} else {
plot(c(0, nrow(t)), c(0, ncol(t)), type = "n", xlab = "", ylab = "",
asp = 1, main = "terrain accepatable", axes = FALSE)
}
for (i in 1:nrow(t)) {
for (j in 1:ncol(t)) {
if (i == 2 && j == 2) {
# point A
rect(i - 1, j - 1, i, j, col = "blue", border = "black")
} else if (i == nrow(t) - 1 && j == ncol(t) - 1) {
# point B
rect(i - 1, j - 1, i, j, col = "red", border = "black")
} else if (i == 1 || i == nrow(t) || j == 1 || j == ncol(t)) {
# bord
rect(i - 1, j - 1, i, j, col = "black", border = "black")
} else if (t[i, j] == SPACE) {
# SPACE
rect(i - 1, j - 1, i, j, col = "white", border = "black")
} else {
# OBSTACLE
rect(i - 1, j - 1, i, j, col = "bisque4", border = "black")
}
}
}
}
Pour générer un labyrinthe 4*5, p = 0.35, on peut voir qu'on a rejeté 2 terrains sans chemin entre A et B, et enfin, on genere le 3eme terrain acceptable, le tableau affiché est pareil que l'image.
GenTerrain(4, 5, 0.35, 1)
## [,1] [,2] [,3] [,4] [,5] [,6]
## [1,] 0 0 0 0 0 0
## [2,] 0 1 1 0 1 0
## [3,] 0 0 0 0 1 0
## [4,] 0 1 1 1 1 0
## [5,] 0 1 0 1 0 0
## [6,] 0 1 1 1 0 0
## [7,] 0 0 0 0 0 0
On a une autre idée, mais on a pas pu réaliser. Quand on génère un terrain, en fait, on utilise la fonction RANDOM() m*n-2 fois, parce que les valeur du point A et du point B sont déjà déterminés. On obtient une suite de valeurs aléatoires, selon le théorème central limite, le nombre d'obstacle suit la loi normal(p * (m * n-2), (m * n-2)/12).
Avant le rejet, le terrain a 2m+n-2 posibilités. Quand il n'y a pas d'obstacle, il y a \( C_{m+n-2}^0 \) possibilités. Quand il y a une obstacle, il y a \( C_{m+n-2}^1 \) possibilités, etc. Donc on a : \[ C_{m+n-2}^0 + C_{m+n-2}^1 + ... + C_{m+n-2}^{m+n-2} = 2^{m+n-2} \] Quand le nombre d'obstacle est 0 ou 1, on accepte tous les terrains générés, par contre, quand le nombre > ((m*n-2)-(m+n-3)), on rejete tous, (m+n-3) est le chemin le plus court entre le point A et le point B. Mais pour les nombre entre 1 et ((m*n-2)-(m+n-3)), il y a beaucoup de situations, on n'a pas le temps pour calculer précisement…
Pour le deplacement de la puce, on propose la fonction de déplacer une fois comme le suivant, on utilise deux variables aléatoire, une signifie la direction du déplacement, une autre signifie la modification(soit 1, soit -1), en suite, on vérifie si ce déplacement est acceptable, sinon on rejete.
# déplacement d'une fois de la puce para : position, position courrante de
# la puce retourne la position de la puce après ce déplacement
Avancer2 <- function(position, terrain) {
x <- position[1]
y <- position[2]
repeat {
p_next = c(position[1], position[2])
# direction, soit x, soit y
i <- round(runif(1, 1, 2), 0)
# modification, soit 1, soit -1
p_next[i] <- p_next[i] + (round(runif(1, 0, 1), 0) * 2 - 1)
# vérifier si ce point est SPACE, sinon refaire.
if (terrain[p_next[1], p_next[2]] == SPACE) {
return(p_next)
}
}
}
Pour éviter le rejet, on a utilisé une autre façon. En utilisant un tableau P_voisins, on en ajoute les cases suivantes accepatables un par un après la vérification, donc on peut faire le choix selon la taille du tableau.
# déplacement d'une fois de la puce, version qui évite rejet
Avancer <- function(position, terrain) {
P_voisins <- data.frame(x = numeric(0), y = numeric(0))
x <- position[1]
y <- position[2]
# met les points acceptables dans le tableau P_voisins
if (terrain[x - 1, y] == SPACE) {
P_voisins[nrow(P_voisins) + 1, ] <- c(x - 1, y)
}
if (terrain[x + 1, y] == SPACE) {
P_voisins[nrow(P_voisins) + 1, ] <- c(x + 1, y)
}
if (terrain[x, y - 1] == SPACE) {
P_voisins[nrow(P_voisins) + 1, ] <- c(x, y - 1)
}
if (terrain[x, y + 1] == SPACE) {
P_voisins[nrow(P_voisins) + 1, ] <- c(x, y + 1)
}
FX <- 0
i <- 0
u <- runif(1)
repeat {
FX <- FX + 1/nrow(P_voisins)
i <- i + 1
if (u <= FX) {
# print(FX)
return(c(P_voisins[i, ]$x, P_voisins[i, ]$y))
}
}
}
Dans la fonction du déplacement, on s'arrête quand la puce atteint le point B. Chaque fois quand il déplace, le temps du déplacement s'augmente par 1.
# le procédure du deplacement retourne le temps du deplacement
Deplacement <- function(terrain) {
position <- c(nrow(terrain) - 1, 2)
time <- 0
# on s'arrête quand la puce atteint le point B
while (!identical(position, c(2, ncol(terrain) - 1))) {
position <- Avancer(position, terrain)
# print(position)
time <- time + 1
}
return(time)
}
On peut voir que dans le terrain généré comme le suivant, le temps de déplacement est 19.
print(Deplacement(GenTerrain(4, 5, 0.5, 2)))
## [1] 19
Pour calculer le temps moyen, on doit déterminer le nombre d’expérimentations sur un labyrinthe, on a étudier la courbe de temps moyen et le nombre d’expérimentations pour le labyrinthe m=n=10, p=0. On trouve que après 200 tirages, le temps moyen a une tendance à stagner.
EtudierT_1Terrain <- function() {
terrain <- GenTerrain(10, 10, 0, 0)
time <- c()
timeMoy <- c()
for (i in 1:500) {
time <- c(time, Deplacement(terrain))
timeMoy <- c(timeMoy, mean(time))
# print(i) print(mean(time))
}
plot(timeMoy, type = "l", xlab = "nombre d'expérimentations", ylab = "temps moyen")
}
EtudierT_1Terrain()
Donc dans notre fonction, on a utilisé 200 comme le nombre de tirages.
GetTempMoy <- function(terrain) {
time <- c()
for (i in 1:200) {
time <- c(time, Deplacement(terrain))
}
return(mean(time))
}
On a étudier les cas de {(m,n) | m\( \in \)[1,4] & n\( \in \)[1,4]}. On a généré le labyrinthe pour chaque couple(m, n). Puisque quand p = 0, on a qu'une seul labyrinthe. La fonction retourne un tableau, la valeur de i ligne et j colonne est le temps moyen de labyrinthe i*j.
Question_3 <- function() {
m_list <- c(1:4)
n_list <- c(1:4)
tempMoy <- matrix(nrow = length(m_list), ncol = length(n_list))
for (m in m_list) {
for (n in n_list) {
tempMoy[m, n] <- GetTempMoy(GenTerrain(m, n, 0, 0))
}
}
print(tempMoy)
}
On peut bien voir que le résultat est un matrice diagonale. C’est raisonnable puisque pour chaque labyrinthe(m, n), on peut obtenir un labyrinthe(n, m) correspondant. Quand la taille du labyrinthe augmente, le temps moyen augmente vite.
Question_3()
## [,1] [,2] [,3] [,4]
## [1,] 0.00 1.00 3.90 9.10
## [2,] 1.00 3.89 9.43 19.63
## [3,] 3.79 9.47 19.40 27.96
## [4,] 8.21 18.76 29.35 44.85
On a fait un peu de réfléche sur la façon de calculer le temps moyen. Pour chaque case de la position (i, j), on note \( Et_{i,j} \) comme le temps moyen d’atteinte B partant de la case (i, j), \( V_{i,j} \) est l'ensemble de tous les voisins attainable de la case (i, j). On suppose la position de A est (n, 1), et la position de B est (1, m), donc on note \( Et_{A} \) comme \( Et_{n,1} \) . Donc \[ Et_{n,1} = \frac{1}{2}(1+Et_{n-1,1}) + \frac{1}{2}(1+Et_{n-1,1}) =1 + \frac{Et_{n-1,1} + Et_{n-1,1}}{2} \] on peut obtenir les équations suivantes:
\( Et_{i,j} = 1 + (\sum_{(x,y)\in V_{i,j}} Et_{x,y})/(taille\ de\ V_{i,j}) \) pour tous les i\( \in \)[1, n], j\( \in \)[1, m] sauf (i, j) = (1, m) et 1, m = 0
\( Et_{1,m} = 0 \)
Donc on aura m * n équations linéaires pour les m * n variables, donc on peut bien le résoudre.
On a essayé avec n = 1, m = 4, Et = 9, n = 1, m = 3, Et = 4, n = 2, m = 2, Et = 4, Ils sont prèsque pareil comme le résultat d’expérimentation.
La distribution du temps d’atteindre B partant de A est comme ci-dessous:
Question_4 <- function() {
time <- c()
terrain <- GenTerrain(10, 10, 0, 0)
for (i in 1:400) {
time <- c(time, Deplacement(terrain))
}
# print(time)
hist(time, breaks = 50)
}
Question_4()
On peut bien voir que le temps se concentre dans l’intervalle [100,200], et puis il tends vers 0 jusqu'à infini. On a aussi calculé le temps moyen de ce labyrinthe, c'est environ 540. Selon la distribution, le plus possible intervalle ne contient pas le temps moyen.
Pour étudier l'impact de p, comme dans la question 3, d'abord, on doit étudier combien de labyrinte qu'on va considérer, donc on a déssiné la courbe du temps moyen et le nombre de terrain ce qu'on considère, comme le suivant:
EtudierT_MulTerrain <- function(m, n, p) {
time <- c()
timeMoy <- c()
for (i in 1:40) {
time <- c(time, GetTempMoy(GenTerrain(m, n, p, 0)))
timeMoy <- c(timeMoy, mean(time))
# print(i) print(mean(time))
}
plot(timeMoy, type = "l", xlab = "nombre d'expérimentations", ylab = "temps moyen")
}
EtudierT_MulTerrain(4, 5, 0.5)
On peut voir le courbe, il n'est pas bien stalbe, mais à cause de la capacité de calculation de notre ordinateurs, on a choisi 20 comme le nombre de labyrinthe ce qu'on va considérer.
Pour les valeurs de p, on a choisi 0, 0.2, 0.4, 0.6 et 0.8 .
Question_5 <- function(m, n) {
tempMoy <- data.frame(p = numeric(0), tempsMoy = numeric(0))
tempMoy[nrow(tempMoy) + 1, ] <- c(0, GetTempMoy(GenTerrain(m, n, 0, 0)))
for (p in seq(0.2, 0.8, by = 0.2)) {
time <- c()
for (i in 1:20) {
# print(c(p,i))
time <- c(time, GetTempMoy(GenTerrain(m, n, p, 0)))
}
tempMoy[nrow(tempMoy) + 1, ] <- c(p, mean(time))
}
plot(tempMoy, type = "b")
}
On a choisi le labyrinthe de taille 3*4, l'impact de p est comme la courbe suivante:
Question_5(3, 4)
On peut voir que, d'abord, le temps moyen a une tendance d'augmenter jusqu'à 0.3, puis il se réduit.
On peut toujours cosidérer ce labyrinthe comme un graphe, chaque case est un sommet, quand on met un obstacle, c'est parreil que d'enlever le sommet depuis le graphe. C'est pas difficile d'imaginer quand il y a beaucoup d'obstacle, il y aura pas beaucoup de sommets dans ce graphe, donc le temps moyen d'atteindre B sera plus petit. Mais c'est quand même possible que quelques obstacles peuvent couper le graphe en 2 composants connexes, ça sera pareil que tous les sommets dans le composant connexe qui contient pas A et B sont enlevés. Donc le temps moyen n'est pas toujours stable.