Programme REXX pour les graphes

Copyright (gH)

/* Litgraph.Rex */
/* # 1. Gestion du paramètre nom du fichier*/
arg fn .
call ouvrirfichier fn
cls ; say "Graphe associé au fichier " fn ; say
/* # 2. Lecture des sommets, gestion des structures */
arc  = 0  ; som  = 0 ;
A.   = 0  ; C.   = 0 ; tet. = 0  ; keu. = 0 ; suivant. =
0
do while lines(fn)
   ligne = linein(fn) ; arc = arc + 1
   x = word(ligne,1)  ; y = word(ligne,2)
   /* recherche du sommet de plus grand numéro */
   som = max(som,x,y)
   msg = "Arc" format(arc,2) ":le sommet " format(x,2)
   msg = msg " est relié au sommet " format(y,2) ; say
msg
   /* gestion de la matrice A d'adjacence */
   A.arc.x = 1 ; A.arc.y = 1
   /* gestion de la matrice C de connectivité */
   C.x.y   = 1 ; C.y.x   = 1
   /* gestion des listes de connectivités */
   call ajoute y x ; call ajoute x y
end /* do while lines(fn) */

nbarc = arc ; nbsom = som
say ; say "Il y a " nbarc "arcs et " nbsom " sommets "
/* # 3. Affichages des différentes structures */
call afstgraf
/* # 4. Parcours DFS  récursif */
say ; say " Parcours DFS  récursif  " ; say
cv = 0 ; numord. = 0
do is = 1 to nbsom
   if numord.is = 0 then do
        call visiteDFS is
   end /* if numord.is = 0 */
end /* do is = 1 to nbsom */
say
/* # 5. Parcours BFS  itératif */
say ; say " Parcours BFS  itératif  " ; say
cv = 0 ; numord. = -1
do is = 1 to nbsom
   if numord.is = -1 then do
      call visiteBFS is
      do while queued() > 0
         pull ind
         call visiteBFS ind
      end /* do while nonvide(f) */
   end /* if numord.is = -1 */
end /* do is = 1 to nbsom */

/* # 6. Fin du programme */
exit
Les procédures appelées sont les suivantes :
ouvrirfichier: procedure
arg nomfichier
if nomfichier = "" then nomfichier = "!!!%??!"
if dosdir(nomfichier) = '' then do
  say "  Fichier " nomfichier " non vu - abandon
  exit
end /* if dosdir(nomfichier) = '' */
return /* fin de ouvrirfichier */

ajoute: procedure expose tet. keu. suivant.
 /* ajoute a à la liste de connectivité de b */
 arg a b .
 if tet.b = 0
    then tet.b = a
    else do
             fin = keu.b
             suivant.b.fin = a
         end
  /* fin de si */
  suivant.b.a = 0
  keu.b = a
return /* fin de ajoute */



afstgraf:
  procedure expose a. c. tet. keu. suivant. nbsom nbarc

/*  Matrice d'adjacence */
say " Matrice d'adjacence " ; say
call charout , copies(" ",12)
do j = 1 to nbsom
   call charout , d2c(64+j) " "
end /* do j = 1 to nbsom */
say
call charout , copies(" ",8) "_"
do j = 1 to nbsom
   call charout , "---"
end /* do j = 1 to nbsom */
say "-_"
do i = 1 to nbarc
   call charout , "Arc " format(i,2) " ¦"
   do j = 1 to nbsom
      call charout , " " A.i.j
   end /* do j = 1 to nbsom */
   say " ¦"
end /* do i = 1 to nbarc */
call charout , copies(" ",8) "_"
do j = 1 to nbsom
   call charout , "---"
end /* do j = 1 to nbsom */
say "-_"

/* Matrice de connectivité "  */
say ; say " Matrice de connectivité "  ; say
call charout , copies(" ",5)
do j = 1 to nbsom
   call charout , d2c(64+j) " "
end /* do j = 1 to nbsom */
say
call charout , "  _"
do j = 1 to nbsom
   call charout , "---"
end /* do j = 1 to nbsom */
say "-_"
do i = 1 to nbsom
   call charout , d2c(64+i) "¦"
   do j = 1 to nbsom
      call charout , " " C.i.j
   end /* do j = 1 to nbsom */
   say " ¦"
end /* do i = 1 to nbsom */
call charout , "  _"
do j = 1 to nbsom
   call charout , "---"
end /* do j = 1 to nbsom */
say "-_"


/* Listes de connectivité */
say ; say "  Listes de connectivité " ; say
do x = 1 to nbsom
   call charout , " Sommets connectés à " d2c(64+x) " : "
   k = tet.x
   do while k > 0
      call charout , d2c(64+k) " "
      k = suivant.x.k
   end /* do while k >= 0 */
   say
end /* do x = 1 to nbsom */
return /* fin de afstgraf */
visiteDFS: procedure expose cv c. numord. nbsom

   arg x ; cv = cv + 1 ; numord.x = cv
   call charout , " " d2c(64+x)
   do as = 1 to nbsom
      if C.x.as = 1 & numord.as = 0 then do
         call visiteDFS as
      end /* if C.x.as = 1 & numord.as = 0 */
   end /* do as = 1 to nbsom */

return /* fin de visiteDFS */

visiteBFS:
  procedure expose cv numord. suivant. tet. f.
  arg as
  cv = cv + 1
  call charout , " " d2c(64+as)
  numord.as = cv
  suit = tet.as
  do while suit > 0
     if numord.suit = -1 then do
        queue suit
        numord.suit = 0
     end /* if numord.suit = -1 then do */
     apres = suivant.as.suit
     suit  = apres
  end /* do while suite > 0 */
return /* fin de visiteBFS */