Avec une liste simplement chaînée, il est possible d'ajouter ou supprimer l'élément au début, et (avec un peu d'effort) d'ajouter un élément à la fin. Mais afin de pouvoir supprimer rapidement l'élément à la fin d'une liste, celle-ci doit être doublement chaînée.
Contrairement au cas des listes simplement chaînées, Common Lisp n'a pas de fonctions prédéfinies pour les listes doublement chaînées. Nous devons donc commencer par définir un type. Nous allons utiliser une structure pour les cellules. Voici une définition possible :
(defstruct dcell
(elem nil)
(prev nil)
(next nil))
Cette structure va conduire à la construction d'objets contenant des suites de références circulaires. L'affichage d'un tel objet est infini. Pour pallier à ce problème, nous fournissons à la structure une fonction d'affichage spécifique qui ne suit que le champ next et n'affiche pas le champ prev.
(defstruct (dcell
(:print-function
(lambda (dcell s k)
(do
((l dcell (dcell-next l)))
((null l))
(format s "~A" (dcell-elem l))))))
(elem nil)
(prev nil)
(next nil))
Comme avec des listes simplement chaînées, nous allons utiliser deux variables globales *start* et *end* qui pointent respectivement sur le premier et le dernier élément :
(defparameter *start* nil)
(defparameter *end* nil)
La figure 23.1 montre une telle liste.
Les fonctions pour récupérer le premier et le dernier élément sont simples :
(defun dfirst-elem ()
(assert *start*)
(dcell-elem *start*))
(defun dlast-elem ()
(assert *end*)
(dcell-elem *end*))
Voici une première version de la fonction pour ajouter un élément au début :
(defun dadd-front (x)
(if (null *start*)
(setf *start* (make-dcell :elem x)
*end* *start*)
(setf *start* (make-dcell :elem x :next *start*)
(dcell-prev (dcell-next *start*)) *start*)))
La fonction pour ajouter un élément à la fin est symétrique. Chaque occurrence de *start* doit être remplacée par *end*, chaque occurrence de next par prev et chaque occurrence de prev par next :
(defun dadd-end (x)
(if (null *end*)
(setf *end* (make-dcell :elem x)
*start* *end*)
(setf *end* (make-dcell :elem x :prev *end*)
(dcell-next (dcell-prev *end*)) *end*)))
Les deux fonctions pour supprimer un élément sont elles aussi symétriques :
(defun dremove-front ()
(assert *start*)
(if (eq *start* *end*)
(setf *start* nil
*end* nil)
(setf *start* (dcell-next *start*)
(dcell-prev *start* nil))))
(defun dremove-end ()
(assert *end*)
(if (eq *start* *end*)
(setf *start* nil
*end* nil)
(setf *end* (dcell-prev *end*)
(dcell-next *end* nil))))
Mais comme avec les listes simplement chaînées, ces fonctions sont inutilement compliquées et inefficaces. L'utilisation de sentinelles peut considérablement améliorer la situation.
L'idée est de faire en sorte que *start* pointe toujours sur la première sentinelle, et que *end* pointe toujours sur la deuxième sentinelle. Le premier élément de la liste (s'il existe) se trouve donc dans la cellule qui suit celle pointée par *start* et le dernier élément (s'il existe) se trouve dans la cellule qui précède celle pointée par *end* (voir la figure 23.2).
Voici les expressions à évaluer pour initialiser *start* et *end*
(defparameter *start* (make-dcell :elem nil))
(defparameter *end* (make-dcell :elem nil))
(setf (dcell-next *start*) *end*
(dcell-prev *end*) *start*)
Il convient de définir une fonction pour déterminer si la liste est vide :
(defun dempty ()
(eq (dcell-next *start*) *end*))
Les fonctions pour récupérer le premier et le dernier éléments sont un peu plus compliquées :
(defun dfirst-elem ()
(assert (not (dempty)))
(dcell-elem (dcell-next *start*)))
(defun dlast-elem ()
(assert (not (dempty)))
(dcell-elem (dcell-prev *end*)))
Par contre, les fonctions pour ajouter un élément sont plus simples, car il n'y a pas de cas spécial à tester :
(defun dadd-front (x)
(let ((new-cell (make-dcell :next *start*)))
(setf (dcell-elem *start*) x
(dcell-prev *start*) new-cell
*start* new-cell)))
(defun dadd-end (x)
(let ((new-cell (make-dcell :prev *end*)))
(setf (dcell-elem *end*) x
(dcell-next *end*) new-cell
*end* new-cell)))
Ici, une sentinelle est transformée en cellule normale, et la nouvelle cellule allouée sert de sentinelle. Il est aussi possible (mais un peu plus compliqué) de préserver la cellule sentinelle et d'utiliser la nouvelle cellule pour stocker l'élément rajouté. Voici finalement, les fonctions pour supprimer un élément :
(defun dremove-front ()
(assert (not (dempty)))
(setf *start* (dcell-next *start*)
(dcell-prev *start*) nil
(dcell-elem *start*) nil))
(defun dremove-end ()
(assert (not (dempty)))
(setf *end* (dcell-prev *end*)
(dcell-next *end*) nil
(dcell-elem *end*) nil))
Ici, la sentinelle est abandonnée, et sera ultérieurement récupérée par le ramasse-miettes. La première (respectivement dernière) cellule est transformée en sentinelle.
Avec une liste doublement chaînée, il est possible d'introduire la notion de curseur (en Anglais : cursor). Il s'agit d'une position dans la liste permettant d'insérer ou de supprimer un élément. De plus, le curseur peut être avancé ou reculé d'une position à la fois.
Le curseur peut bien sûr indiquer un des éléments de la liste, mais cela pose un problème si la liste est vide. Une meilleure idée est que le curseur indique un espace entre deux éléments, car cette idée se généralise facilement à une liste vide. La figure 23.3 illustre cette idée.
En ce qui concerne l'implémentation, il est évidemment impossible de faire pointer un curseur entre deux éléments. Mais la solution est simple : il suffit de le faire pointer physiquement sur l'élément qui précède la position logique ou sur la première sentinelle, si la position est avant le premier élément. Sans la sentinelle, le nombre de cas spéciaux à tester serait considérable.
Il est possible d'abandonner les variables *start* et *end*, car il est toujours possible d'avancer ou de reculer le curseur. Mais elles peuvent servir, car on a souvent besoin de positionner le curseur au début ou à la fin de la liste. Sans ces variables, ces deux opérations seraient lentes : O(n) au lieu de O(1).
Voici les expressions à évaluer pour initialiser une telle liste :
(defparameter *start* (make-dcell :elem nil))
(defparameter *end* (make-dcell :elem nil))
(defparameter *cursor* *start*)
(setf (dcell-next *start*) *end*
(dcell-prev *end*) *start*)
Il convient de définir deux fonctions pour déterminer si le curseur est au début ou à la fin de la liste :
(defun at-beginning ()
(eq *cursor* *start*))
(defun at-end ()
(eq (dcell-next *cursor*) *end*))
On remarque une disymétrie entre ces deux fonctions, due au fait que le curseur pointe physiquement sur la cellule qui précède la position. On remarque aussi que le curseur peut être à la fois au début et à la fin de la liste, ce qui est le cas lorsque la liste est vide.
Voici les fonctions pour déplacer le curseur :
(defun go-forward ()
(assert (not (at-end)))
(setf *cursor* (dcell-next *cursor*)))
(defun go-backward ()
(assert (not (at-beginning)))
(setf *cursor* (dcell-prev *cursor*)))
(defun go-start ()
(setf *cursor* *start*))
(defun go-end ()
(setf *cursor* (dcell-prev *end*)))
Il est clair que les fonctions pour mettre le curseur au début ou à la fin sont rapides (O(1)).
En ce qui concerne les fonctions d'insertion et de suppression, plusieurs conventions sont possibles. On peut insérer ou supprimer devant ou derrière le curseur.
Pour l'insertion, que ce soit avant ou après le curseur, une cellule doit être ajoutée entre la cellule sur laquelle pointe le curseur et celle d'après. La seule différence sera la position finale du curseur. Pour la suppression, il faut soit supprimer la cellule sur laquelle pointe le curseur, soit celle d'après.
Voici la fonction pour ajouter un élément après le curseur (à sa gauche) :
(defun add-before (x)
(let ((new-cell (make-dcell :elem x
:prev *cursor*
:next (dcell-next *cursor*))))
(setf (dcell-prev (dcell-next *cursor*)) new-cell
(dcell-next *cursor*) new-cell
*cursor* new-cell)))
La seule différence entre add-before et add-after est que pour add-after le curseur ne sera pas affecté :
(defun add-after (x)
(let ((new-cell (make-dcell :elem x
:prev *cursor*
:next (dcell-next *cursor*))))
(setf (dcell-prev (dcell-next *cursor*)) new-cell
(dcell-next *cursor*) new-cell)))
Voici la fonction pour supprimer l'élément suivant le curseur :
(defun delete-before ()
(assert (not (at-beginning)))
(setf (dcell-next (dcell-prev *cursor*)) (dcell-next *cursor*)
(dcell-prev (dcell-next *cursor*)) (dcell-prev *cursor*)
*cursor* (dcell-prev *cursor*)))
Finalement, voici la fonction pour supprimer l'élément après le curseur :
(defun delete-after ()
(assert (not (at-end)))
(setf (dcell-prev (dcell-next (dcell-next *cursor*))) *cursor*
(dcell-next *cursor*) (dcell-next (dcell-next *cursor*))))
On pourrait maintenir les fonctions d'ajout et de suppression d'un élément au début ou à la fin de la liste, mais cela pose problème lorsqu'on supprime un élément sur lequel se trouve le curseur. C'est le cas si le curseur se trouve logiquement entre le premier et le deuxième élément (et donc physiquement sur le premier élément) et si le premier élément est supprimé. Il est alors nécessaire de tester la valeur du curseur pour le déplacer d'une position à gauche.
Ce problème est le même si on généralise cette technique à un nombre arbitraire de curseurs. Dans ce cas, il n'est pas pratique de tester l'ensemble des curseurs à chaque fois qu'un élément est supprimé.
Voici une autre technique possible. Il faut d'abord ajouter un champ dans la cellule comme ceci :
(defstruct dcell
(elem nil)
(deleted nil)
(prev nil)
(next nil))
Le champ supplémentaire indique si la cellule a été supprimée. Un curseur qui pointe sur une cellule supprimée doit être ajusté. Mais au lieu de faire cet ajustement au moment où la cellule est supprimée, on le fait avant d'utiliser le curseur. De cette manière, on n'ajuste pas un curseur qui n'en a pas besoin. Dans la description qui suit, nous allons supposer que le curseur manipulé se trouve toujours dans la variable *cursor*, mais en général, on peut supposer qu'il peut y avoir plusieurs curseurs.
D'abord, avant de se servir d'un curseur quelconque, il est dorénavant nécessaire de s'assurer qu'il pointe sur une cellule non supprimée. On le fait en reculant (par le champ prev) jusqu'à ce que le curseur pointe sur une cellule non supprimée. Nous allons appelé cette procédure normalisation (voir la figure 23.4 pour une situation possible avant la normalisation et la figure 23.5 pour la situation après normalisation). Voici la fonction qui normalise le curseur :
(defun normalize ()
(loop while (dcell-deleted *cursor*)
do (setf *cursor* (dcell-prev *cursor*))))
Il est possible que plusieurs curseurs pointent sur la même cellule. Si le nombre de curseurs est grand, on peut simplifier la tâche des autres curseurs qui pointent sur les cellules de la chaîne de cellules supprimées, en transformant la chaîne en arbre peu profond. Pour cela, il faut modifier la fonction de normalisation de la manière suivante :
(defun normalize ()
(when (dcell-deleted *cursor*)
(collapse *cursor*)
(setf *cursor* (dcell-prev *cursor*))))
(defun collapse (cell)
(when (dcell-deleted (dcell-prev cell))
(collapse (dcell-prev cell))
(setf (dcell-prev cell)
(dcell-prev (dcell-prev cell)))))
Après appel à la fonction collapse, toutes les cellules supprimées de la chaîne pointent directement sur une cellule non supprimée. La figure 23.6 montre la situation après appel à la nouvelle version de la fonction normalize.
Les fonctions de déplacement du curseur et les fonctions d'insertion doivent maintenant appeler normalize :
(defun go-forward ()
(assert (not (at-end)))
(normalize)
(setf *cursor* (dcell-next *cursor*)))
(defun go-backward ()
(assert (not (at-beginning)))
(normalize)
(setf *cursor* (dcell-prev *cursor*)))
(defun add-before (x)
(normalize)
(let ((new-cell (make-dcell :elem x
:prev *cursor*
:next (dcell-next *cursor*))))
(setf (dcell-prev (dcell-next *cursor*)) new-cell
(dcell-next *cursor*) new-cell
*cursor* new-cell)))
(defun add-after (x)
(normalize)
(let ((new-cell (make-dcell :elem x
:prev *cursor*
:next (dcell-next *cursor*))))
(setf (dcell-prev (dcell-next *cursor*)) new-cell
(dcell-next *cursor*) new-cell)))
Les fonctions de suppression doivent maintenant être modifiées de la façon suivante :
(defun delete-before ()
(assert (not (at-beginning)))
(normalize)
(setf (dcell-deleted *cursor* t)
(dcell-next (dcell-prev *cursor*)) (dcell-next *cursor*)
(dcell-prev (dcell-next *cursor*)) (dcell-prev *cursor*)
*cursor* (dcell-prev *cursor*)))
(defun delete-after ()
(assert (not (at-end)))
(normalize)
(setf (dcell-deleted (dcell-next *cursor*)) t
(dcell-prev (dcell-next (dcell-next *cursor*)) *cursor*
(dcell-next *cursor*) (dcell-next (dcell-next *cursor*)))))
