Programme REXX pour les graphes

Copyright (gH)

/* Grundys.Rex : Hunault, Angers 93 (Heuristique, Licence Maths) */

/* # 1. Initialisations et lecture du fichier des arcs */

   NbNiv      = 0 /* Niveau courant puis nombre de niveaux */
   NbArc      = 0 /* Arc    courant puis nombre d' arcs    */
   NbSom      = 0 /* Sommet courant puis nombre de sommets */
   NbSrestant = 0 /* nombre de sommets actuellement sans niveaux */

   FichA   = 'Grundys.Arc' /* Fichier des Arcs */
   LigneT. = ''  /* Ligne des Totaux */
   Connec. = '' /* Matrice de connecticit_ */
   Niveau. = '' /* Listes liées des éléments par niveaux */
   NumS.   = 0  /* Numéro des sommets */

   call ConstruireMatC
        /* la matrice de connectivité à partir du fichier des arcs */
   call TotalColonne
        /* initialise la Ligne des Totaux et nbrestant */

/* # 2. Détermination des niveaux par la méthode de Moucron */

 do while nbSrestant > 0 /* nombre de Sommets restant */
      call SupprimeSetCreeN
      /* supprime les sommets isolés et crée les niveaux */
 end /* fintant que nbSrestant > 0 */

/* # 3. Affichages des résultats */

say " Graphe orienté associé au fichier Grundy.Arc "
say " avec : " nbsom "    sommet(s) " nbarc " arc(s) " nbniv " niveau(x) "
call affMconnec

exit



/* ## Sous Programmes */

ConstruireMatC: procedure expose ficha nbarc nbsom connec. nums.

 if dosdir(ficha) = '' then do
    say " le fichier " ficha " n'est pas vu..."
    say " abandon du programme."
 end
 nomsom = ""
 do while lines(ficha)
    lignarc = linein(ficha)
    parse var lignarc orig dest
    nbarc   = nbarc + 1
    if pos(orig,nomsom) = 0 then do
       nbsom  = nbsom + 1
       nomsom = nomsom orig
       nums.nbsom = orig
    end
    if pos(dest,nomsom) = 0 then do
       nbsom  = nbsom + 1
       nomsom = nomsom dest
       nums.nbsom = dest
    end
    norig = wordpos(orig,nomsom)
    ndest = wordpos(dest,nomsom)
    connec.norig.ndest = 1
 end
return

TotalColonne: procedure expose nbsom connec. nums. lignet. nbSrestant nbniv
 if nbniv = 0 then nbSrestant = nbsom
 do so=1 to nbsom
    somcol = 0
    do sd=1 to nbsom
       if connec.sd.so = 1 then somcol = somcol + connec.sd.so
    end
    lignet.so = somcol
 end
return

SupprimeSetCreeN: procedure expose nbsom lignet. nbSrestant nbniv nums.
connec. niveau.
  nbniv = nbniv + 1
  niveau.nbniv = ""
  totc. = 0
  do s=1 to nbsom
     if lignet.s = 0 then do
        niveau.nbniv = niveau.nbniv nums.s
        do sc=1 to nbsom
           if connec.s.sc = 1 then do
              totc.sc = totc.sc + 1
           end
        end
        nbSrestant = nbSrestant - 1
        lignet.s = -1
     end
  end
  do s=1 to nbsom
     lignet.s = lignet.s - totc.s
  end
  call affLignet
return



affMconnec: procedure expose connec. nums. nbsom nbniv niveau.
 call charout , "   "
 do s=1 to nbsom
    call charout , " "nums.s" "
 end
 say "      Niveaux "
 do so=1 to nbsom
    nso = nums.so
    call charout , nso " "
    do sd=1 to nbsom
       if connec.so.sd = 1
          then call charout , " 1 "
          else call charout , "   "
    end
    if so <= nbniv
       then say "     " format(so,3) " : " niveau.so
       else say
 end
return

affLignet: procedure expose nbniv lignet. nbsom
 call charout , " niveau " nbniv " : "
 do s=1 to nbsom
    call charout , format(lignet.s,3)
 end
 pull .
return