' ============================================================================
' DEMOTRI
' Ce programme d‚montre graphiquement six algorithmes de tri. Il affiche,
' dans un ordre al‚atoire, 25 ou 43 bƒtonnets horizontaux de diff‚rentes
' longueurs puis les trie, du plus petit au plus grand.
'
' Le programme recourt aussi aux instructions SOUND pour g‚n‚rer des sons
' de diff‚rentes densit‚s, selon la position du bƒtonnet affich‚. Vous
' remarquerez que les instructions SOUND ralentissent la vitesse de chaque
' algorithme de tri afin que vous puissiez suivre le d‚roulement du tri.
' Les dur‚es ne sont donc indiqu‚es que pour servir … la comparaison.
' Elles ne constituent pas une mesure pr‚cise de la vitesse de tri.
'
' Si vous utilisez ces sous-programmes de tri dans vos propres programmes,
' vous noterez peut-ˆtre une diff‚rence entre leurs vitesses relatives
' exemple, le tri par ‚change peut ˆtre plus rapide que le tri Shell),
' en fonction du nombre d'‚l‚ments … trier et du "m‚lange" initial.
' ============================================================================
DEFINT A-Z ' Entier de type implicite.
' Declarer les proc‚dures FUNCTION et SUB, ainsi que le nombre et le type des
' arguments :
DECLARE FUNCTION EntierAleat (Inferieur, Superieur)
DECLARE SUB InitRect ()
DECLARE SUB TriCles ()
DECLARE SUB VerifEcran ()
DECLARE SUB TraceCadre (CoteSup, CoteInf, CoteGauche, CoteDroit)
DECLARE SUB TempsEcoule (LigneCourante)
DECLARE SUB TriEchange ()
DECLARE SUB TriEnPile ()
DECLARE SUB Initialisation ()
DECLARE SUB TriInsertion ()
DECLARE SUB PassageBas (NiveauMax)
DECLARE SUB PassageHaut (NiveauMax)
DECLARE SUB AfficheUnBatonnet (Ligne)
DECLARE SUB TriRapide (Bas, Haut)
DECLARE SUB Reinitialisation ()
DECLARE SUB TriShell ()
DECLARE SUB MenuTri ()
DECLARE SUB PermuteBatonnets (Ligne1, Ligne2)
DECLARE SUB BasculeSon (Ligne, Colonne)
' D‚finir le type de donn‚e utilis‚ pour contenir les informations de chaque
' bƒtonnet de couleur :
TYPE TypeTri
longueur AS INTEGER ' Longueur du bƒtonnet (l'‚lement compar‚
' dans les diff‚rents tris).
ValCouleur AS INTEGER ' Couleur du bƒtonnet.
ChaineBatonnet AS STRING * 43 ' Le bƒtonnet (une chaŒne de 43
' caractŠres).
END TYPE
' D‚clarer les constantes globales :
CONST FAUX = 0, VRAI = NOT FAUX, COLONNEGAUCHE = 49
CONST NBREOPTIONS = 11, NBRETRIS = 6
' D‚clarer les variables globales et leur affecter de l'espace m‚moire.
' TableauTri et SauveTri sont deux tableaux de type de donn‚e TypeTri d‚fini
' ci-dessus :
DIM SHARED TableauTri(1 TO 43) AS TypeTri, SauveTri(1 TO 43) AS TypeTri
DIM SHARED TitreOption(1 TO NBREOPTIONS) AS STRING * 13
DIM SHARED HeureDebut AS SINGLE
DIM SHARED PREMierPlan, fond, PasSon, Pause
DIM SHARED Selection, LigneMax, LigneInit, MaxCouleurs
' Instructions DATA pour les diff‚rentes options du menu de tri :
DATA Insertion, Cles, Pile, Echange, SHELL, Rapide,
DATA Bascule son, , < Plus lent, > Plus rapide
' Commencer par l'en-tˆte du module :
Initialisation ' Initialiser les valeurs des donn‚es.
MenuTri ' Afficher le menu de tri.
WIDTH 80, LigneInit ' R‚tablir le nombre de lignes initial.
CLS
END
' CherchLigne, IntercepteMono et IntercepteLigne sont des sous-programmes de
' traitement d'erreurs appel‚s au moyen de la proc‚dure SUB VerifEcran.
' CherchLigne d‚termine si le programme a commenc‚ avec 25, 43 ou 50 lignes.
' IntercepteMono d‚termine si la carte d'affichage courante est monochrome.
' IntercepteLigne fixe le nombre maximum de lignes possibles (43 ou 25).
CherchLigne:
IF LigneInit = 50 THEN
LigneInit = 43
RESUME
ELSE
LigneInit = 25
RESUME NEXT
END IF
IntercepteMono:
MaxCouleurs = 2
RESUME NEXT
IntercepteLigne:
LigneMax = 25
RESUME
' =========================== AfficheUnBatonnet ==============================
' Affiche TableauTri(Ligne).ChaineBatonnet … la ligne sp‚cifi‚e par le
' paramŠtre Ligne, en utilisant la couleur de TableauTri(Ligne).ValCouleur.
' ============================================================================
'
SUB AfficheUnBatonnet (Ligne) STATIC
LOCATE Ligne, 1
COLOR TableauTri(Ligne).ValCouleur
PRINT TableauTri(Ligne).ChaineBatonnet;
END SUB
' ============================== BasculeSon ==================================
' Inverse la valeur courante de PasSon, puis affiche cette valeur … c“t‚
' de l'option "Commutation du son" du menu de tri.
' ============================================================================
'
SUB BasculeSon (Ligne, Colonne) STATIC
PasSon = NOT PasSon
LOCATE Ligne, Colonne
IF PasSon THEN
PRINT ": DESACTIVE";
ELSE
PRINT ": ACTIVE ";
END IF
END SUB
' ============================== EntierAleat =================================
' Fournit un entier al‚atoire sup‚rieur ou ‚gal au paramŠtre Inferieur et
' inf‚rieur ou ‚gal au paramŠtre Superieur.
' ============================================================================
'
FUNCTION EntierAleat (Inferieur, Superieur) STATIC
EntierAleat = INT(RND * (Superieur - Inferieur + 1)) + Inferieur
END FUNCTION
' ============================ Initialisation ================================
' Initialise les tableaux SauveTri et TitreOption. Appelle ‚galement les
' proc‚dures VerifEcran, InitRect et EntierAleat.
' ============================================================================
'
SUB Initialisation STATIC
DIM TableauTemp(1 TO 43)
VerifEcran ' V‚rifier s'il s'agit d'un ‚cran monochrome
' ou EGA et d‚finir le nombre de lignes de
' texte.
FOR I = 1 TO LigneMax
TableauTemp(I) = I
NEXT I
IndexMax = LigneMax
RANDOMIZE TIMER ' Alimenter le g‚n‚rateur de nombres
' al‚atoires.
FOR I = 1 TO LigneMax
' Appeler EntierAleat pour trouver dans TableauTemp un ‚l‚ment al‚atoire
' compris entre 1 et IndexMax, puis affecter la valeur de cet ‚l‚ment …
' LongueurBatonnet:
Index = EntierAleat(1, IndexMax)
LongueurBatonnet = TableauTemp(Index)
' Ecraser la valeur contenue dans TableauTemp(Index) et la remplacer par
' la valeur contenue dans TableauTemp(IndexMax) afin que la valeur
' contenue dans TableauTemp(Index) ne soit choisie qu'une seule fois :
TableauTemp(Index) = TableauTemp(IndexMax)
' Diminuer la valeur de IndexMax afin que TableauTemp(IndexMax) ne
' puisse pas ˆtre choisi lors du passage suivant … travers la boucle :
IndexMax = IndexMax - 1
' Affecter la valeur de LongueurBatonnet … l'‚l‚ment .Longueur, puis
' stocker dans l'‚l‚ment ChaineBatonnet une chaŒne des caractŠres du
' bloc LongueurBatonnet (ASCII 223: ß):
SauveTri(I).longueur = LongueurBatonnet
SauveTri(I).ChaineBatonnet = STRING$(LongueurBatonnet, 223)
' Stocker la valeur de la couleur appropri‚e dans l'‚l‚ment .ValCouleur:
IF MaxCouleurs > 2 THEN
SauveTri(I).ValCouleur = (LongueurBatonnet MOD MaxCouleurs) + 1
ELSE
SauveTri(I).ValCouleur = MaxCouleurs
END IF
NEXT I
FOR I = 1 TO NBREOPTIONS ' Lire les options du menu
READ TitreOption(I) ' DEMONSTRATION DE TRI et les stocker
NEXT I ' dans le tableau TitreOption.
CLS
Reinitialisation ' Affecter … TableauTri des valeurs contenues dans
' SauveTri et tracer … l'‚cran des bƒtonnets non
' tri‚s.
PasSon = FAUX
Pause = 2 ' Initialiser Pause … 2 mouvements de balancier
' (… 1/9 seconde).
InitRect ' Tracer le cadre du menu de tri et afficher
' les options.
END SUB
' =============================== InitRect ===================================
' Appelle la proc‚dure TraceCadre pour tracer le cadre autour du menu de
' tri, puis affiche les diff‚rentes options stock‚es dans le tableau
' TitreOption.
' ============================================================================
'
SUB InitRect STATIC
TraceCadre 1, 22, COLONNEGAUCHE - 3, 79
LOCATE 3, COLONNEGAUCHE: PRINT "DEMO DE TRI AVEC QUICKBASIC";
LOCATE 5
FOR I = 1 TO NBREOPTIONS - 1
LOCATE , COLONNEGAUCHE: PRINT TitreOption(I)
NEXT I
' Ne pas afficher la derniŠre option (> PlusRapide) si la longueur de
' la Pause est ramen‚e … un mouvement de balancier :
IF Pause > 1 THEN LOCATE , COLONNEGAUCHE: PRINT TitreOption(NBREOPTIONS);
' Basculer le son puis afficher la valeur courante de PasSon :
PasSon = NOT PasSon
BasculeSon 12, COLONNEGAUCHE + 12
LOCATE NBREOPTIONS + 6, COLONNEGAUCHE
PRINT "Entrez votre choix (premiŠre"
LOCATE , COLONNEGAUCHE
PRINT "lettre : I C P E S R B < > )"
LOCATE , COLONNEGAUCHE
PRINT "ou appuyez sur ANNULATION"
LOCATE , COLONNEGAUCHE
PRINT "pour terminer le programme: ";
END SUB
' =============================== MenuTri ===================================
' La proc‚dure MenuTri appelle d'abord la proc‚dure Reinitialisation pour
' s'assurer que TableauTri n'est pas tri‚, puis demande … l'utilisateur de
' s‚lectionner un des choix suivants :
'
' * Un des algorithmes de tri
' * Commutation du son
' * Augmentation ou diminution de la vitesse
' * Fin du programme
' ============================================================================
'
SUB MenuTri STATIC
Echap$ = CHR$(27)
' Cr‚er une chaŒne compos‚e de tous les choix corrects :
OPTION$ = "ICPESR><B" + Echap$
DO
' Rendre le curseur visible :
LOCATE NBREOPTIONS + 9, COLONNEGAUCHE + 27, 1
Choix$ = UCASE$(INPUT$(1)) ' Rechercher le choix de
Selection = INSTR(OPTION$, Choix$) ' l'utilisateur et v‚rifier s'il
' est repris dans le menu.
' L'utilisateur a choisi une des proc‚dures ci-dessous :
IF (Selection >= 1) AND (Selection <= NBRETRIS) THEN
Reinitialisation ' Rem‚langer les bƒtonnets.
LOCATE , , 0 ' Rendre le curseur invisible.
PREMierPlan = 0 ' D‚finir les valeurs de la vid‚o
fond = 7 ' inverse.
HeureDebut = TIMER ' Enregistrer l'heure de d‚but.
END IF
' R‚aliser le branchement vers la proc‚dure ad‚quate, en fonction de la
' touche frapp‚e :
SELECT CASE Choix$
CASE "I"
TriInsertion
CASE "C"
TriCles
CASE "P"
TriEnPile
CASE "E"
TriEchange
CASE "S"
TriShell
CASE "R"
TriRapide 1, LigneMax
CASE ">"
' R‚duire la dur‚e de la pause afin d'acc‚l‚rer le tri, puis
' retracer le menu pour effacer toute indication de temps (‚tant
' donn‚ qu'elle ne pourra ˆtre compar‚e aux r‚sultats futurs) :
Pause = (2 * Pause) / 3
InitRect
CASE "<"
' Augmenter la dur‚e de la pause afin de ralentir le tri, puis
' retracer le menu pour effacer toute indication de temps (‚tant
' donn‚ qu'elle ne pourra ˆtre compar‚e aux r‚sultats futurs) :
Pause = (3 * Pause) / 2
InitRect
CASE "B"
BasculeSon 12, COLONNEGAUCHE + 12
CASE Echap$
' Comme l'utilisateur a appuy‚ sur la touche ANNULATION (ESC),
' quitter cette proc‚dure et revenir … l'en-tˆte du module :
EXIT DO
CASE ELSE
' Touche incorrecte.
END SELECT
IF (Selection >= 1) AND (Selection <= NBRETRIS) THEN
PREMierPlan = MaxCouleurs ' D‚sactiver la vid‚o inverse.
fond = 0
TempsEcoule 0 ' Afficher le temps final.
END IF
LOOP
END SUB
' ============================= PassageBas ===================================
' La proc‚dure PassageBas r‚tablit les ‚l‚ments de TableauTri compris entre
' 1 et NiveauMax en une "pile" (voir le sch‚ma repris … la proc‚dure
' TriEnPile).
' ============================================================================
'
SUB PassageBas (NiveauMax) STATIC
I = 1
' D‚placer la valeur de TableauTri(1) vers le bas de la pile jusqu'… ce
' qu'il atteigne son propre noeud (c-…-d jusqu'… ce qu'il soit inf‚rieur
' … son noeud pŠre ou jusqu'… ce qu'il atteigne NiveauMax, qui constitue
' le bas de la pile courante) :
DO
Fils = 2 * I ' Rechercher l'indice du noeud fils.
' Quand le bas de la pile est atteint, sortir de cette proc‚dure :
IF Fils > NiveauMax THEN EXIT DO
' S'il y a deux noeuds fils, chercher le plus grand :
IF Fils + 1 <= NiveauMax THEN
IF TableauTri(Fils + 1).longueur > TableauTri(Fils).longueur THEN
Fils = Fils + 1
END IF
END IF
' D‚placer la valeur vers le bas si elle n'est toujours pas sup‚rieure
' … l'un ou l'autre de ses fils :
IF TableauTri(I).longueur < TableauTri(Fils).longueur THEN
SWAP TableauTri(I), TableauTri(Fils)
PermuteBatonnets I, Fils
I = Fils
' Sinon, TableauTri a ‚t‚ r‚tabli en une pile allant de 1 … NiveauMax.
' Quitter :
ELSE
EXIT DO
END IF
LOOP
END SUB
' ============================== PassageHaut =================================
' La proc‚dure PassageHaut convertit en une "pile" les ‚l‚ments de
' TableauTri compris entre 1 et NiveauMax (voir le sch‚ma repris … la
' proc‚dure TriEnPile).
' ============================================================================
'
SUB PassageHaut (NiveauMax) STATIC
I = NiveauMax
' D‚placer la valeur de TableauTri(NiveauMax) vers le haut de la pile
' jusqu'… ce qu'il atteigne son propre noeud (c-…-d jusqu'… ce qu'il soit
' sup‚rieur … un de ses noeuds fils ou jusqu'… ce qu'il atteigne 1, qui
' constitue le sommet de la pile) :
DO UNTIL I = 1
Pere = I \\ 2 ' Rechercher l'indice du noeud pŠre.
' Comme la valeur du noeud courant est encore sup‚rieure … la valeur
' de son noeud pŠre, permuter ces ‚l‚ments de tableau :
IF TableauTri(I).longueur > TableauTri(Pere).longueur THEN
SWAP TableauTri(Pere), TableauTri(I)
PermuteBatonnets Pere, I
I = Pere
' Sinon, l'‚l‚ment a trouv‚ la place qui lui convient dans la pile.
' Quitter alors la proc‚dure :
ELSE
EXIT DO
END IF
LOOP
END SUB
' =========================== PermuteBatonnets ===============================
' Appelle AfficheUnBatonnet … deux reprises pour intervertir les
' deux bƒtonnets en Ligne1 et Ligne2, puis appelle la proc‚dure
' TempsEcoule.
' ============================================================================
'
SUB PermuteBatonnets (Ligne1, Ligne2) STATIC
AfficheUnBatonnet Ligne1
AfficheUnBatonnet Ligne2
TempsEcoule Ligne1
END SUB
' ============================ Reinitialisation ==============================
' R‚tablit le tableau TableauTri dans son ‚tat initial non tri‚ puis
' affiche les bƒtonnets de couleur non tri‚s.
' ============================================================================
'
SUB Reinitialisation STATIC
FOR I = 1 TO LigneMax
TableauTri(I) = SauveTri(I)
NEXT I
FOR I = 1 TO LigneMax
LOCATE I, 1
COLOR TableauTri(I).ValCouleur
PRINT TableauTri(I).ChaineBatonnet;
NEXT I
COLOR MaxCouleurs, 0
END SUB
' ============================= TempsEcoule ==================================
' Affiche le nombre de secondes ‚coul‚es depuis le d‚but du sous-programme
' de tri sp‚cifi‚. Ce laps de temps couvre … la fois le temps n‚cessaire
' au retra‡age des bƒtonnets et la pause marqu‚e lorsque l'instruction
' SOUND joue une note. Il ne s'agit donc pas d'une mesure pr‚cise de la
' vitesse de tri.
' ============================================================================
'
SUB TempsEcoule (LigneCourante) STATIC
CONST FORMAT = " &###.### secondes "
' Afficher en vid‚o inverse la s‚lection courante et le nombre de secondes
' ‚coul‚es :
COLOR PREMierPlan, fond
LOCATE Selection + 4, COLONNEGAUCHE - 2
PRINT USING FORMAT; TitreOption(Selection), TIMER - HeureDebut;
IF PasSon THEN
SOUND 30000, Pause ' Pas de son, une simple pause.
ELSE
SOUND 60 * LigneCourante, Pause ' Son, donc jouer une note pendant
END IF ' la pause.
COLOR MaxCouleurs, 0 ' R‚tablir les couleurs normales du
' premier plan et du fond.
END SUB
' ============================== TraceCadre ==================================
' Trace un cadre rectangulaire au moyen des caractŠres ASCII de haut rang
' É (201) , » (187) , È (200) , ¼ (188) , º (186) et Í (205). Les
' paramŠtres CoteSup, CoteInf, CoteGauche et CoteDroit sont les arguments
' de ligne et de colonne des coins sup‚rieur gauche et inf‚rieur droit du
' cadre.
' ============================================================================
'
SUB TraceCadre (CoteSup, CoteInf, CoteGauche, CoteDroit) STATIC
CONST SGAUCHE = 201, SDROIT = 187, IGAUCHE = 200, IDROIT = 188
CONST VERTICAL = 186, HORIZONTAL = 205
LargeurCadre = CoteDroit - CoteGauche - 1
LOCATE CoteSup, CoteGauche
PRINT CHR$(SGAUCHE); STRING$(LargeurCadre, HORIZONTAL); CHR$(SDROIT);
FOR Ligne = CoteSup + 1 TO CoteInf - 1
LOCATE Ligne, CoteGauche
PRINT CHR$(VERTICAL); SPC(LargeurCadre); CHR$(VERTICAL);
NEXT Ligne
LOCATE CoteInf, CoteGauche
PRINT CHR$(IGAUCHE); STRING$(LargeurCadre, HORIZONTAL); CHR$(IDROIT);
END SUB
' =============================== TriCles ====================================
' L'algorithme TriCles parcourt TableauTri en comparant les ‚l‚ments
' adjacents et en permutant les paires qui ne sont pas class‚es dans
' le bon ordre. Il continue ainsi jusqu'… ce qu'il ne reste plus de
' paire … permuter.
' ============================================================================
'
SUB TriCles STATIC
Limite = LigneMax
DO
Interversion = FAUX
FOR Ligne = 1 TO (Limite - 1)
' Deux ‚l‚ments adjacents sont mal class‚s, permuter leurs valeurs
' et retracer ces deux bƒtonnets :
IF TableauTri(Ligne).longueur > TableauTri(Ligne + 1).longueur THEN
SWAP TableauTri(Ligne), TableauTri(Ligne + 1)
PermuteBatonnets Ligne, Ligne + 1
Interversion = Ligne
END IF
NEXT Ligne
' Lors du passage suivant, ne pas trier au-del… de la derniŠre
' Interversion :
Limite = Interversion
LOOP WHILE Interversion
END SUB
' ============================= TriEchange ==================================
' TriEchange compare chaque ‚l‚ment de TableauTri - en commen‡ant par le
' premier ‚l‚ment - avec chacun des ‚l‚ments suivants. Si l'un de ceux-ci
' est inf‚rieur … l'‚l‚ment courant, il est ‚chang‚ avec ce dernier. Ce
' mˆme processus est ensuite r‚p‚t‚ pour l'‚l‚ment suivant de TableauTri.
' ============================================================================
'
SUB TriEchange STATIC
FOR Ligne = 1 TO LigneMax
PlusCourteLigne = Ligne
FOR J = Ligne + 1 TO LigneMax
IF TableauTri(J).longueur < TableauTri(PlusCourteLigne).longueur THEN
PlusCourteLigne = J
TempsEcoule J
END IF
NEXT J
' D‚couverte d'une ligne plus courte que la ligne courante. Permuter
' ces deux ‚l‚ments du tableau :
IF PlusCourteLigne > Ligne THEN
SWAP TableauTri(Ligne), TableauTri(PlusCourteLigne)
PermuteBatonnets Ligne, PlusCourteLigne
END IF
NEXT Ligne
END SUB
' =============================== TriEnPile ===================================
' La proc‚dure TriEnPile appelle deux autres proc‚dures - PassageHaut et
' PassageBas. PassageHaut transforme TableauTri en une "pile" qui se
' pr‚sente de la maniŠre illustr‚e ci-dessous :
'
' TableauTri(1)
' / \\
' TableauTri(2) TableauTri(3)
' / \\ / \\
' TableauTri(4) TableauTri(5) TableauTri(6) TableauTri(7)
' / \\ / \\ / \\ / \\
' ... ... ... ... ... ... ... ...
'
'
' dans laquelle chaque "noeud pŠre" est sup‚rieur … chacun de ses "noeuds
' fils". Par exemple, TableauTri(1) est sup‚rieur … TableauTri(2) ou …
' TableauTri(3), TableauTri(3) est sup‚rieur … TableauTri(6) ou …
' TableauTri(7), et ainsi de suite.
'
' Ainsi, une fois que la premiŠre boucle FOR...NEXT de TriEnPile a ‚t‚
' ex‚cut‚e, le plus grand ‚l‚ment se trouve dans TableauTri(1).
'
' La deuxiŠme boucle FOR...NEXT de TriEnPile permute l'‚l‚ment contenu
' dans TableauTri(1) et l'‚l‚ment contenu dans LigneMax, reconstitue la
' pile (avec PassageBas) pour LigneMax - 1, puis permute l'‚l‚ment
' contenu dans TableauTri(1) et l'‚l‚ment contenu dans LigneMax - 1,
' reconstitue enfin la pile pour LigneMax - 2, et poursuit ainsi jusqu'…
' ce que le tableau soit tri‚.
' ============================================================================
'
SUB TriEnPile STATIC
FOR I = 2 TO LigneMax
PassageHaut I
NEXT I
FOR I = LigneMax TO 2 STEP -1
SWAP TableauTri(1), TableauTri(I)
PermuteBatonnets 1, I
PassageBas I - 1
NEXT I
END SUB
' ============================= TriInsertion =================================
' La proc‚dure TriInsertion compare la longueur de chaque ‚l‚ment successif
' de TableauTri aux longueurs de tous les ‚l‚ments pr‚c‚dents. Quand la
' proc‚dure d‚couvre la place qui convient au nouvel ‚l‚ment, elle l'y
' insŠre et repousse tous les autres ‚l‚ments d'une place vers le bas.
' ============================================================================
'
SUB TriInsertion STATIC
DIM ValTemp AS TypeTri
FOR Ligne = 2 TO LigneMax
ValTemp = TableauTri(Ligne)
LongueurTemp = ValTemp.longueur
FOR J = Ligne TO 2 STEP -1
' Aussi longtemps que la longueur de l'‚l‚ment J-1 est sup‚rieure …
' la longueur de l'‚l‚ment initial contenu dans TableauTri(Ligne),
' continuer … d‚caler les ‚l‚ments du tableau vers le bas :
IF TableauTri(J - 1).longueur > LongueurTemp THEN
TableauTri(J) = TableauTri(J - 1)
AfficheUnBatonnet J ' Afficher le nouveau bƒtonnet.
TempsEcoule J ' Afficher le temps ‚coul‚.
' Sinon, quitter la boucle FOR...NEXT :
ELSE
EXIT FOR
END IF
NEXT J
' Ins‚rer la valeur initiale de TableauTri(Ligne) dans TableauTri(J):
TableauTri(J) = ValTemp
AfficheUnBatonnet J
TempsEcoule J
NEXT Ligne
END SUB
' ============================== TriRapide ===================================
' TriRapide prend un ‚l‚ment "pivot" al‚atoire dans TableauTri, puis
' place d'un c“t‚ du pivot tous les ‚l‚ments qui lui sont sup‚rieurs, et
' de l'autre tous ceux qui lui sont inf‚rieurs. TriRapide est ensuite
' appel‚ de maniŠre r‚cursive avec les deux subdivisions cr‚‚es par le
' pivot. Quand le nombre d'‚l‚ments d'une subdivision est ‚gal … deux,
' les appels r‚cursifs cessent et le tableau est tri‚.
' ============================================================================
'
SUB TriRapide (Bas, Haut)
IF Bas < Haut THEN
' Seulement deux ‚l‚ments dans cette subdivision; les permuter s'ils
' ne sont pas class‚s dans le bon ordre, puis mettre fin aux appels
' r‚cursifs :
IF Haut - Bas = 1 THEN
IF TableauTri(Bas).longueur > TableauTri(Haut).longueur THEN
SWAP TableauTri(Bas), TableauTri(Haut)
PermuteBatonnets Bas, Haut
END IF
ELSE
' S‚lectionne un ‚l‚ment de pivot, de maniŠre al‚atoire, puis le
' d‚place jusqu'… la fin :
IndexAleat = EntierAleat(Bas, Haut)
SWAP TableauTri(Haut), TableauTri(IndexAleat)
PermuteBatonnets Haut, IndexAleat
Partition = TableauTri(Haut).longueur
DO
' Ramener des c“t‚s vers l'‚l‚ment pivot :
I = Bas: J = Haut
DO WHILE (I < J) AND (TableauTri(I).longueur <= Partition)
I = I + 1
LOOP
DO WHILE (J > I) AND (TableauTri(J).longueur >= Partition)
J = J - 1
LOOP
' Si l'‚l‚ment pivot n'a pas ‚t‚ atteint, cela signifie que deux
' ‚l‚ments situ‚s de part et d'autre de l'‚l‚ment pivot sont mal
' class‚s. Il faut alors les permuter :
IF I < J THEN
SWAP TableauTri(I), TableauTri(J)
PermuteBatonnets I, J
END IF
LOOP WHILE I < J
' Remettre l'‚l‚ment pivot … sa place correcte dans le tableau :
SWAP TableauTri(I), TableauTri(Haut)
PermuteBatonnets I, Haut
' Appeler de maniŠre r‚cursive la proc‚dure TriRapide (passer
' d'abord la plus petite subdivision afin d'‚conomiser l'espace
' dans la pile) :
IF (I - Bas) < (Haut - I) THEN
TriRapide Bas, I - 1
TriRapide I + 1, Haut
ELSE
TriRapide I + 1, Haut
TriRapide Bas, I - 1
END IF
END IF
END IF
END SUB
' =============================== TriShell ==================================
' La proc‚dure TriShell est semblable … la proc‚dure TriCles . Toutefois,
' TriShell commence par comparer les ‚l‚ments ‚loign‚s (ceux qui sont
' s‚par‚s par la valeur de la variable Decalage, qui correspond initialement
' … la moiti‚ de la distance s‚parant le premier ‚l‚ment du dernier), avant
' de comparer les ‚l‚ments les plus rapproch‚s (quand Decalage est ‚gale …
' un, la derniŠre it‚ration de cette proc‚dure n'est plus tout simplement
' qu'un tri par ‚change de paires de cl‚s).
' ============================================================================
'
SUB TriShell STATIC
' D‚finir la valeur du d‚calage … la moiti‚ du nombre d'enregistrements
' contenus dans TableauTri :
Decalage = LigneMax \\ 2
DO WHILE Decalage > 0 ' It‚rer jusqu'… ce que le d‚calage
' soit ‚gal … z‚ro.
Limite = LigneMax - Decalage
DO
Interversion = FAUX ' Pr‚sumer qu'il n'y a aucune
' interversion pour ce d‚calage.
' Comparer les ‚l‚ments et intervertir ceux qui ne sont pas class‚s
' dans le bon ordre :
FOR Ligne = 1 TO Limite
IF TableauTri(Ligne).longueur > TableauTri(Ligne + Decalage).longueur THEN
SWAP TableauTri(Ligne), TableauTri(Ligne + Decalage)
PermuteBatonnets Ligne, Ligne + Decalage
Interversion = Ligne
END IF
NEXT Ligne
' Lors du passage suivant, ne pas trier au-del… de la derniŠre
' interversion :
Limite = Interversion - Decalage
LOOP WHILE Interversion
' Si pas d'interversion au dernier d‚calage, essayer un autre, plus
' petit de moiti‚ :
Decalage = Decalage \\ 2
LOOP
END SUB
' ============================== VerifEcran ==================================
' V‚rifie le type de moniteur (VGA, EGA, CGA, ou monochrome) et le
' nombre initial de lignes d'‚cran (50, 43 ou 25).
' ============================================================================
'
SUB VerifEcran STATIC
' Tenter de localiser la 50Šme ligne, sinon essayer la 43Šme ligne. Si
' cette deuxiŠme tentative ‚choue elle aussi, l'utilisateur est en
' mode 25 lignes :
LigneInit = 50
ON ERROR GOTO CherchLigne
LOCATE LigneInit, 1
' Essayer une instruction SCREEN 1 pour voir si la carte courante est en
' mesure d'afficher des graphiques en couleurs. Si cette tentative
' entraŒne une erreur, ramener MaxCouleurs … 2 :
MaxCouleurs = 15
ON ERROR GOTO IntercepteMono
SCREEN 1
SCREEN 0
' V‚rifier si le mode 43 lignes est accept‚. Si ce n'est pas le cas,
' ex‚cuter ce programme en mode 25 lignes :
LigneMax = 43
ON ERROR GOTO IntercepteLigne
WIDTH 80, LigneMax
ON ERROR GOTO 0 ' D‚sactiver l'interception d'erreurs.
END SUB
